{-# 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