    {-# LANGUAGE FlexibleContexts #-}
    {-# CFILES hdbc-sqlite3-helper.c #-}
    -- above line for hugs

    module Database.HDBC.Sqlite3.Connection
      (connectSqlite3, connectSqlite3Raw, Impl.Connection())
      where

    import Database.HDBC.Types
    import Database.HDBC
    import Database.HDBC.DriverUtils
    import qualified Database.HDBC.Sqlite3.ConnectionImpl as Impl
    import Database.HDBC.Sqlite3.Types
    import Database.HDBC.Sqlite3.Statement
    import Foreign.C.Types
    import Foreign.C.String
    import Foreign.Marshal
    import Foreign.Storable
    import Database.HDBC.Sqlite3.Utils
    import Foreign.ForeignPtr
    import Foreign.Ptr
    import Control.Concurrent.MVar
    import qualified Data.ByteString as B
    import qualified Data.ByteString.UTF8 as BUTF8
    import qualified Data.Char

    {- | Connect to an Sqlite version 3 database.  The only parameter needed is
    the filename of the database to connect to.

    All database accessor functions are provided in the main HDBC module. -}
    connectSqlite3 :: FilePath -> IO Impl.Connection
    connectSqlite3 :: String -> IO Connection
    connectSqlite3 =
        (String -> (CString -> IO Connection) -> IO Connection)
    -> String -> IO Connection
    genericConnect (ByteString -> (CString -> IO Connection) -> IO Connection
    forall a. ByteString -> (CString -> IO a) -> IO a
    B.useAsCString (ByteString -> (CString -> IO Connection) -> IO Connection)
    -> (String -> ByteString)
    -> String
    -> (CString -> IO Connection)
    -> IO Connection
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ByteString
    BUTF8.fromString)

    {- | Connects to a Sqlite v3 database as with 'connectSqlite3', but
    instead of converting the supplied 'FilePath' to a C String by performing
    a conversion to Unicode, instead converts it by simply dropping all bits past
    the eighth.  This may be useful in rare situations
    if your application or filesystemare not running in Unicode space. -}
    connectSqlite3Raw :: FilePath -> IO Impl.Connection
    connectSqlite3Raw :: String -> IO Connection
    connectSqlite3Raw = (String -> (CString -> IO Connection) -> IO Connection)
    -> String -> IO Connection
    genericConnect String -> (CString -> IO Connection) -> IO Connection
    forall a. String -> (CString -> IO a) -> IO a
    withCString

    genericConnect :: (String -> (CString -> IO Impl.Connection) -> IO Impl.Connection)
                   -> FilePath
                   -> IO Impl.Connection
    genericConnect :: (String -> (CString -> IO Connection) -> IO Connection)
    -> String -> IO Connection
    genericConnect String -> (CString -> IO Connection) -> IO Connection
    strAsCStrFunc String
    fp =
        String -> (CString -> IO Connection) -> IO Connection
    strAsCStrFunc String
    fp
            (\CString
    cs -> (Ptr (Ptr CSqlite3) -> IO Connection) -> IO Connection
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca
             (\(Ptr (Ptr CSqlite3)
    p::Ptr (Ptr CSqlite3)) ->
                  do res <- CString -> Ptr (Ptr CSqlite3) -> IO CInt
    sqlite3_open CString
    cs Ptr (Ptr CSqlite3)
    p
                     o <- peek p
                     fptr <- newForeignPtr sqlite3_closeptr o
                     newconn <- mkConn fp fptr
                     checkError ("connectSqlite3 " ++ fp) fptr res
                     return newconn
             )
            )

    mkConn :: FilePath -> Sqlite3 -> IO Impl.Connection
    mkConn :: String -> ForeignPtr CSqlite3 -> IO Connection
    mkConn String
    fp ForeignPtr CSqlite3
    obj =
        do children <- [Weak Statement] -> IO (MVar [Weak Statement])
    forall a. a -> IO (MVar a)
    newMVar []
           begin_transaction obj children
           ver <- (sqlite3_libversion >>= peekCString)
           return $ Impl.Connection {
                                Impl.disconnect = fdisconnect obj children,
                                Impl.commit = fcommit obj children,
                                Impl.rollback = frollback obj children,
                                Impl.run = frun obj children,
                                Impl.runRaw = frunRaw obj children,
                                Impl.prepare = newSth obj children True,
                                Impl.clone = connectSqlite3 fp,
                                Impl.hdbcDriverName = "sqlite3",
                                Impl.hdbcClientVer = ver,
                                Impl.proxiedClientName = "sqlite3",
                                Impl.proxiedClientVer = ver,
                                Impl.dbTransactionSupport = True,
                                Impl.dbServerVer = ver,
                                Impl.getTables = fgettables obj children,
                                Impl.describeTable = fdescribeTable obj children,
                                Impl.setBusyTimeout = fsetbusy obj}

    fgettables :: ForeignPtr CSqlite3 -> MVar [Weak Statement] -> IO [a]
    fgettables ForeignPtr CSqlite3
    o MVar [Weak Statement]
    mchildren =
        do sth <- ForeignPtr CSqlite3
    -> MVar [Weak Statement] -> Bool -> String -> IO Statement
    newSth ForeignPtr CSqlite3
    o MVar [Weak Statement]
    mchildren Bool
    True String
    "SELECT name FROM sqlite_master WHERE type='table' ORDER BY name"
           execute sth []
           res1 <- fetchAllRows' sth
           let res = (SqlValue -> a) -> [SqlValue] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map SqlValue -> a
    forall a. Convertible SqlValue a => SqlValue -> a
    fromSql ([SqlValue] -> [a]) -> [SqlValue] -> [a]
    forall a b. (a -> b) -> a -> b
    $ [[SqlValue]] -> [SqlValue]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[SqlValue]]
    res1
           return $ seq (length res) res

    fdescribeTable :: ForeignPtr CSqlite3
    -> MVar [Weak Statement] -> String -> IO [(a, SqlColDesc)]
    fdescribeTable ForeignPtr CSqlite3
    o MVar [Weak Statement]
    mchildren String
    name =  do
        sth <- ForeignPtr CSqlite3
    -> MVar [Weak Statement] -> Bool -> String -> IO Statement
    newSth ForeignPtr CSqlite3
    o MVar [Weak Statement]
    mchildren Bool
    True (String -> IO Statement) -> String -> IO Statement
    forall a b. (a -> b) -> a -> b
    $ String
    "PRAGMA table_info(" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
        execute sth []
        res1 <- fetchAllRows' sth
        return $ map describeCol res1
      where
         describeCol :: [SqlValue] -> (a, SqlColDesc)
    describeCol (SqlValue
    _:SqlValue
    name:SqlValue
    typ:SqlValue
    notnull:SqlValue
    df:SqlValue
    pk:[SqlValue]
    _) =
            (SqlValue -> a
    forall a. Convertible SqlValue a => SqlValue -> a
    fromSql SqlValue
    name, SqlValue -> SqlValue -> SqlValue -> SqlValue -> SqlColDesc
    forall {p} {p}. SqlValue -> SqlValue -> p -> p -> SqlColDesc
    describeType SqlValue
    typ SqlValue
    notnull SqlValue
    df SqlValue
    pk)

         describeType :: SqlValue -> SqlValue -> p -> p -> SqlColDesc
    describeType SqlValue
    name SqlValue
    notnull p
    df p
    pk =
             SqlTypeId
    -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Bool -> SqlColDesc
    SqlColDesc (SqlValue -> SqlTypeId
    typeId SqlValue
    name) Maybe Int
    forall a. Maybe a
    Nothing Maybe Int
    forall a. Maybe a
    Nothing Maybe Int
    forall a. Maybe a
    Nothing (SqlValue -> Maybe Bool
    nullable SqlValue
    notnull)

         nullable :: SqlValue -> Maybe Bool
    nullable SqlValue
    SqlNull = Maybe Bool
    forall a. Maybe a
    Nothing
         nullable (SqlString String
    "0") = Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    True
         nullable (SqlString String
    "1") = Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False
         nullable (SqlByteString ByteString
    x)
           | ByteString -> String
    BUTF8.toString ByteString
    x String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "0" = Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    True
           | ByteString -> String
    BUTF8.toString ByteString
    x String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "1" = Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False
         nullable SqlValue
    _ = Maybe Bool
    forall a. Maybe a
    Nothing

         typeId :: SqlValue -> SqlTypeId
    typeId SqlValue
    SqlNull                     = String -> SqlTypeId
    SqlUnknownT String
    "Any"
         typeId (SqlString String
    t)               = String -> SqlTypeId
    typeId' String
    t
         typeId (SqlByteString ByteString
    t)           = String -> SqlTypeId
    typeId' (String -> SqlTypeId) -> String -> SqlTypeId
    forall a b. (a -> b) -> a -> b
    $ ByteString -> String
    BUTF8.toString ByteString
    t
         typeId SqlValue
    _                           = String -> SqlTypeId
    SqlUnknownT String
    "Unknown"

         typeId' :: String -> SqlTypeId
    typeId' String
    t = case (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    Data.Char.toLower String
    t of
           (Char
    'i':Char
    'n':Char
    't':String
    _) -> SqlTypeId
    SqlIntegerT
           String
    "text"          -> SqlTypeId
    SqlVarCharT
           String
    "real"          -> SqlTypeId
    SqlRealT
           String
    "blob"          -> SqlTypeId
    SqlVarBinaryT
           String
    ""              -> String -> SqlTypeId
    SqlUnknownT String
    "Any"
           String
    other           -> String -> SqlTypeId
    SqlUnknownT String
    other

    fsetbusy :: ForeignPtr CSqlite3 -> CInt -> IO ()
    fsetbusy ForeignPtr CSqlite3
    o CInt
    ms = ForeignPtr CSqlite3 -> (Ptr CSqlite3 -> IO ()) -> IO ()
    forall b. ForeignPtr CSqlite3 -> (Ptr CSqlite3 -> IO b) -> IO b
    withRawSqlite3 ForeignPtr CSqlite3
    o ((Ptr CSqlite3 -> IO ()) -> IO ())
    -> (Ptr CSqlite3 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr CSqlite3
    ppdb ->
        Ptr CSqlite3 -> CInt -> IO ()
    sqlite3_busy_timeout Ptr CSqlite3
    ppdb CInt
    ms

    --------------------------------------------------
    -- Guts here
    --------------------------------------------------

    begin_transaction :: Sqlite3 -> ChildList -> IO ()
    begin_transaction :: ForeignPtr CSqlite3 -> MVar [Weak Statement] -> IO ()
    begin_transaction ForeignPtr CSqlite3
    o MVar [Weak Statement]
    children = ForeignPtr CSqlite3
    -> MVar [Weak Statement] -> String -> [SqlValue] -> IO Integer
    frun ForeignPtr CSqlite3
    o MVar [Weak Statement]
    children String
    "BEGIN" [] IO Integer -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    frun :: ForeignPtr CSqlite3
    -> MVar [Weak Statement] -> String -> [SqlValue] -> IO Integer
    frun ForeignPtr CSqlite3
    o MVar [Weak Statement]
    mchildren String
    query [SqlValue]
    args =
        do sth <- ForeignPtr CSqlite3
    -> MVar [Weak Statement] -> Bool -> String -> IO Statement
    newSth ForeignPtr CSqlite3
    o MVar [Weak Statement]
    mchildren Bool
    False String
    query
           res <- execute sth args
           finish sth
           return res

    frunRaw :: Sqlite3 -> ChildList -> String -> IO ()
    frunRaw :: ForeignPtr CSqlite3 -> MVar [Weak Statement] -> String -> IO ()
    frunRaw ForeignPtr CSqlite3
    o MVar [Weak Statement]
    mchildren String
    query =
        do sth <- ForeignPtr CSqlite3
    -> MVar [Weak Statement] -> Bool -> String -> IO Statement
    newSth ForeignPtr CSqlite3
    o MVar [Weak Statement]
    mchildren Bool
    False String
    query
           executeRaw sth
           finish sth

    fcommit :: ForeignPtr CSqlite3 -> MVar [Weak Statement] -> IO ()
    fcommit ForeignPtr CSqlite3
    o MVar [Weak Statement]
    children = do ForeignPtr CSqlite3
    -> MVar [Weak Statement] -> String -> [SqlValue] -> IO Integer
    frun ForeignPtr CSqlite3
    o MVar [Weak Statement]
    children String
    "COMMIT" []
                            ForeignPtr CSqlite3 -> MVar [Weak Statement] -> IO ()
    begin_transaction ForeignPtr CSqlite3
    o MVar [Weak Statement]
    children
    frollback :: ForeignPtr CSqlite3 -> MVar [Weak Statement] -> IO ()
    frollback ForeignPtr CSqlite3
    o MVar [Weak Statement]
    children = do ForeignPtr CSqlite3
    -> MVar [Weak Statement] -> String -> [SqlValue] -> IO Integer
    frun ForeignPtr CSqlite3
    o MVar [Weak Statement]
    children String
    "ROLLBACK" []
                              ForeignPtr CSqlite3 -> MVar [Weak Statement] -> IO ()
    begin_transaction ForeignPtr CSqlite3
    o MVar [Weak Statement]
    children

    fdisconnect :: Sqlite3 -> ChildList -> IO ()
    fdisconnect :: ForeignPtr CSqlite3 -> MVar [Weak Statement] -> IO ()
    fdisconnect ForeignPtr CSqlite3
    o MVar [Weak Statement]
    mchildren = ForeignPtr CSqlite3 -> (Ptr CSqlite3 -> IO ()) -> IO ()
    forall b. ForeignPtr CSqlite3 -> (Ptr CSqlite3 -> IO b) -> IO b
    withRawSqlite3 ForeignPtr CSqlite3
    o ((Ptr CSqlite3 -> IO ()) -> IO ())
    -> (Ptr CSqlite3 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr CSqlite3
    p ->
        do MVar [Weak Statement] -> IO ()
    closeAllChildren MVar [Weak Statement]
    mchildren
           r <- Ptr CSqlite3 -> IO CInt
    sqlite3_close Ptr CSqlite3
    p
           checkError "disconnect" o r

    foreign import ccall unsafe "hdbc-sqlite3-helper.h sqlite3_open2"
      sqlite3_open :: CString -> (Ptr (Ptr CSqlite3)) -> IO CInt

    foreign import ccall unsafe "hdbc-sqlite3-helper.h &sqlite3_close_finalizer"
      sqlite3_closeptr :: FunPtr ((Ptr CSqlite3) -> IO ())

    foreign import ccall unsafe "hdbc-sqlite3-helper.h sqlite3_close_app"
      sqlite3_close :: Ptr CSqlite3 -> IO CInt

    foreign import ccall unsafe "hdbc-sqlite3-helper.h sqlite3_busy_timeout2"
      sqlite3_busy_timeout :: Ptr CSqlite3 -> CInt -> IO ()

    foreign import ccall unsafe "sqlite3.h sqlite3_libversion"
      sqlite3_libversion :: IO CString