{-# 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 CInt
res <- CString -> Ptr (Ptr CSqlite3) -> IO CInt
sqlite3_open CString
cs Ptr (Ptr CSqlite3)
p
                 Ptr CSqlite3
o <- Ptr (Ptr CSqlite3) -> IO (Ptr CSqlite3)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CSqlite3)
p
                 ForeignPtr CSqlite3
fptr <- FinalizerPtr CSqlite3 -> Ptr CSqlite3 -> IO (ForeignPtr CSqlite3)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr CSqlite3
sqlite3_closeptr Ptr CSqlite3
o
                 Connection
newconn <- String -> ForeignPtr CSqlite3 -> IO Connection
mkConn String
fp ForeignPtr CSqlite3
fptr
                 String -> ForeignPtr CSqlite3 -> CInt -> IO ()
checkError (String
"connectSqlite3 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fp) ForeignPtr CSqlite3
fptr CInt
res
                 Connection -> IO Connection
forall (m :: * -> *) a. Monad m => a -> m a
return Connection
newconn
         )
        )

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

fgettables :: ForeignPtr CSqlite3 -> MVar [Weak Statement] -> IO [a]
fgettables ForeignPtr CSqlite3
o MVar [Weak Statement]
mchildren =
    do Statement
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"
       Statement -> [SqlValue] -> IO Integer
execute Statement
sth []
       [[SqlValue]]
res1 <- Statement -> IO [[SqlValue]]
fetchAllRows' Statement
sth
       let res :: [a]
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
       [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> IO [a]) -> [a] -> IO [a]
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [a]
seq ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
res) [a]
res

fdescribeTable :: ForeignPtr CSqlite3
-> MVar [Weak Statement] -> String -> IO [(a, SqlColDesc)]
fdescribeTable ForeignPtr CSqlite3
o MVar [Weak Statement]
mchildren String
name =  do
    Statement
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
")"
    Statement -> [SqlValue] -> IO Integer
execute Statement
sth []
    [[SqlValue]]
res1 <- Statement -> IO [[SqlValue]]
fetchAllRows' Statement
sth
    [(a, SqlColDesc)] -> IO [(a, SqlColDesc)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, SqlColDesc)] -> IO [(a, SqlColDesc)])
-> [(a, SqlColDesc)] -> IO [(a, SqlColDesc)]
forall a b. (a -> b) -> a -> b
$ ([SqlValue] -> (a, SqlColDesc))
-> [[SqlValue]] -> [(a, SqlColDesc)]
forall a b. (a -> b) -> [a] -> [b]
map [SqlValue] -> (a, SqlColDesc)
forall {a}. Convertible SqlValue a => [SqlValue] -> (a, SqlColDesc)
describeCol [[SqlValue]]
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
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 Statement
sth <- ForeignPtr CSqlite3
-> MVar [Weak Statement] -> Bool -> String -> IO Statement
newSth ForeignPtr CSqlite3
o MVar [Weak Statement]
mchildren Bool
False String
query
       Integer
res <- Statement -> [SqlValue] -> IO Integer
execute Statement
sth [SqlValue]
args
       Statement -> IO ()
finish Statement
sth
       Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
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 Statement
sth <- ForeignPtr CSqlite3
-> MVar [Weak Statement] -> Bool -> String -> IO Statement
newSth ForeignPtr CSqlite3
o MVar [Weak Statement]
mchildren Bool
False String
query
       Statement -> IO ()
executeRaw Statement
sth
       Statement -> IO ()
finish Statement
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
       CInt
r <- Ptr CSqlite3 -> IO CInt
sqlite3_close Ptr CSqlite3
p
       String -> ForeignPtr CSqlite3 -> CInt -> IO ()
checkError String
"disconnect" ForeignPtr CSqlite3
o CInt
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