{-# LANGUAGE FlexibleContexts #-}
{-# CFILES hdbc-sqlite3-helper.c #-}
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
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)
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
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