    {-# LINE 1 "Database/HDBC/PostgreSQL/Utils.hsc" #-}
    module Database.HDBC.PostgreSQL.Utils where

    import Foreign.C.String
    import Foreign.ForeignPtr
    import Foreign.Ptr
    import Database.HDBC(throwSqlError)
    import Database.HDBC.Types
    import Database.HDBC.PostgreSQL.Types
    import Control.Concurrent.MVar
    import Foreign.C.Types
    import Control.Exception
    import Foreign.Storable
    import Foreign.Marshal.Array
    import Foreign.Marshal.Alloc
    import Foreign.Marshal.Utils
    import Data.Word
    import qualified Data.ByteString.UTF8 as BUTF8
    import qualified Data.ByteString as B
    import qualified Data.ByteString.Char8 as BCHAR8

    {-# LINE 21 "Database/HDBC/PostgreSQL/Utils.hsc" #-}
    -- Hugs includes this in Data.ByteString
    import qualified Data.ByteString.Unsafe as B

    {-# LINE 24 "Database/HDBC/PostgreSQL/Utils.hsc" #-}

    raiseError :: String -> Word32 -> (Ptr CConn) -> IO a
    raiseError :: forall a. String -> Word32 -> Ptr CConn -> IO a
    raiseError String
    msg Word32
    code Ptr CConn
    cconn =
        do rc <- Ptr CConn -> IO CString
    pqerrorMessage Ptr CConn
    cconn
           bs <- B.packCString rc
           let str = ByteString -> String
    BUTF8.toString ByteString
    bs
           throwSqlError $ SqlError {seState = "",
                                     seNativeError = fromIntegral code,
                                     seErrorMsg = msg ++ ": " ++ str}

    {- This is a little hairy.

    We have a Conn object that is actually a finalizeonce wrapper around
    the real object.  We use withConn to dereference the foreign pointer,
    and then extract the pointer to the real object from the finalizeonce struct.

    But, when we close the connection, we need the finalizeonce struct, so that's
    done by withRawConn.

    Ditto for statements. -}

    withConn :: Conn -> (Ptr CConn -> IO b) -> IO b
    withConn :: forall b. Conn -> (Ptr CConn -> IO b) -> IO b
    withConn (ConnLock
    _lock,ForeignPtr CConn
    conn) = ForeignPtr CConn -> (Ptr CConn -> IO b) -> IO b
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr ForeignPtr CConn
    conn

    -- Perform the associated action with the connection lock held.
    -- Care must be taken with the use of this as it is *not* re-entrant.  Calling it
    -- a second time in the same thread will cause dead-lock.
    -- (A better approach would be to use RLock from concurrent-extra)
    withConnLocked :: Conn -> (Ptr CConn -> IO b) -> IO b
    withConnLocked :: forall b. Conn -> (Ptr CConn -> IO b) -> IO b
    withConnLocked c :: Conn
    c@(ConnLock
    lock,ForeignPtr CConn
    _) Ptr CConn -> IO b
    a = Conn -> (Ptr CConn -> IO b) -> IO b
    forall b. Conn -> (Ptr CConn -> IO b) -> IO b
    withConn Conn
    c (\Ptr CConn
    cconn -> ConnLock -> (() -> IO b) -> IO b
    forall a b. MVar a -> (a -> IO b) -> IO b
    withMVar ConnLock
    lock (\()
    _ -> Ptr CConn -> IO b
    a Ptr CConn
    cconn))

    withRawConn :: Conn -> (Ptr CConn -> IO b) -> IO b
    withRawConn :: forall b. Conn -> (Ptr CConn -> IO b) -> IO b
    withRawConn (ConnLock
    _lock,ForeignPtr CConn
    conn) = ForeignPtr CConn -> (Ptr CConn -> IO b) -> IO b
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr ForeignPtr CConn
    conn

    withStmt :: Stmt -> (Ptr CStmt -> IO b) -> IO b
    withStmt :: forall b. Stmt -> (Ptr CStmt -> IO b) -> IO b
    withStmt = Stmt -> (Ptr CStmt -> IO b) -> IO b
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr

    withRawStmt :: Stmt -> (Ptr CStmt -> IO b) -> IO b
    withRawStmt :: forall b. Stmt -> (Ptr CStmt -> IO b) -> IO b
    withRawStmt = Stmt -> (Ptr CStmt -> IO b) -> IO b
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr

    withCStringArr0 :: [SqlValue] -> (Ptr CString -> IO a) -> IO a
    withCStringArr0 :: forall a. [SqlValue] -> (Ptr CString -> IO a) -> IO a
    withCStringArr0 [SqlValue]
    inp Ptr CString -> IO a
    action = (SqlValue -> IO CString)
    -> (CString -> IO ())
    -> [SqlValue]
    -> (Ptr CString -> IO a)
    -> IO a
    forall a b c.
    (a -> IO (Ptr b))
    -> (Ptr b -> IO ()) -> [a] -> (Ptr (Ptr b) -> IO c) -> IO c
    withAnyArr0 SqlValue -> IO CString
    convfunc CString -> IO ()
    forall {a}. Ptr a -> IO ()
    freefunc [SqlValue]
    inp Ptr CString -> IO a
    action
        where convfunc :: SqlValue -> IO CString
    convfunc SqlValue
    SqlNull = CString -> IO CString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CString
    forall a. Ptr a
    nullPtr
    {-
              convfunc y@(SqlZonedTime _) = convfunc (SqlString $
                                                    "TIMESTAMP WITH TIME ZONE '" ++
                                                    fromSql y ++ "'")
    -}
              convfunc y :: SqlValue
    y@(SqlUTCTime UTCTime
    _) = SqlValue -> IO CString
    convfunc (ZonedTime -> SqlValue
    SqlZonedTime (SqlValue -> ZonedTime
    forall a. Convertible SqlValue a => SqlValue -> a
    fromSql SqlValue
    y))
              convfunc y :: SqlValue
    y@(SqlEpochTime Integer
    _) = SqlValue -> IO CString
    convfunc (ZonedTime -> SqlValue
    SqlZonedTime (SqlValue -> ZonedTime
    forall a. Convertible SqlValue a => SqlValue -> a
    fromSql SqlValue
    y))
              convfunc (SqlByteString ByteString
    x) = ByteString -> IO CString
    cstrUtf8BString (ByteString -> ByteString
    cleanUpBSNulls ByteString
    x)
              convfunc SqlValue
    x = ByteString -> IO CString
    cstrUtf8BString (SqlValue -> ByteString
    forall a. Convertible SqlValue a => SqlValue -> a
    fromSql SqlValue
    x)
              freefunc :: Ptr a -> IO ()
    freefunc Ptr a
    x =
                  if Ptr a
    x Ptr a -> Ptr a -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ptr a
    forall a. Ptr a
    nullPtr
                     then () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                     else Ptr a -> IO ()
    forall {a}. Ptr a -> IO ()
    free Ptr a
    x

    cleanUpBSNulls :: B.ByteString -> B.ByteString
    cleanUpBSNulls :: ByteString -> ByteString
    cleanUpBSNulls ByteString
    bs | Word8
    0 Word8 -> ByteString -> Bool
    `B.notElem` ByteString
    bs = ByteString
    bs
                      | Bool
    otherwise = (Word8 -> ByteString) -> ByteString -> ByteString
    B.concatMap Word8 -> ByteString
    convfunc ByteString
    bs
      where convfunc :: Word8 -> ByteString
    convfunc Word8
    0 = ByteString
    bsForNull
            convfunc Word8
    x = Word8 -> ByteString
    B.singleton Word8
    x
            bsForNull :: ByteString
    bsForNull = String -> ByteString
    BCHAR8.pack String
    "\\000"

    withAnyArr0 :: (a -> IO (Ptr b)) -- ^ Function that transforms input data into pointer
                -> (Ptr b -> IO ())  -- ^ Function that frees generated data
                -> [a]               -- ^ List of input data
                -> (Ptr (Ptr b) -> IO c) -- ^ Action to run with the C array
                -> IO c             -- ^ Return value
    withAnyArr0 :: forall a b c.
    (a -> IO (Ptr b))
    -> (Ptr b -> IO ()) -> [a] -> (Ptr (Ptr b) -> IO c) -> IO c
    withAnyArr0 a -> IO (Ptr b)
    input2ptract Ptr b -> IO ()
    freeact [a]
    inp Ptr (Ptr b) -> IO c
    action =
        IO [Ptr b] -> ([Ptr b] -> IO ()) -> ([Ptr b] -> IO c) -> IO c
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket ((a -> IO (Ptr b)) -> [a] -> IO [Ptr b]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM a -> IO (Ptr b)
    input2ptract [a]
    inp)
                (\[Ptr b]
    clist -> (Ptr b -> IO ()) -> [Ptr b] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Ptr b -> IO ()
    freeact [Ptr b]
    clist)
                (\[Ptr b]
    clist -> Ptr b -> [Ptr b] -> (Ptr (Ptr b) -> IO c) -> IO c
    forall a b. Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
    withArray0 Ptr b
    forall a. Ptr a
    nullPtr [Ptr b]
    clist Ptr (Ptr b) -> IO c
    action)

    cstrUtf8BString :: B.ByteString -> IO CString
    cstrUtf8BString :: ByteString -> IO CString
    cstrUtf8BString ByteString
    bs = do
        ByteString -> (CStringLen -> IO CString) -> IO CString
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
    B.unsafeUseAsCStringLen ByteString
    bs ((CStringLen -> IO CString) -> IO CString)
    -> (CStringLen -> IO CString) -> IO CString
    forall a b. (a -> b) -> a -> b
    $ \(CString
    s,Int
    len) -> do
            res <- Int -> IO CString
    forall a. Int -> IO (Ptr a)
    mallocBytes (Int
    lenInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)
            -- copy in
            copyBytes res s len
            -- null terminate
            poke (plusPtr res len) (0::CChar)
            -- return ptr
            return res

    foreign import ccall unsafe "libpq-fe.h PQerrorMessage"
      pqerrorMessage :: Ptr CConn -> IO CString