{-# 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 :: FilePath -> IO Connection
connectSqlite3 =
(FilePath -> (CString -> IO Connection) -> IO Connection)
-> FilePath -> 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)
-> (FilePath -> ByteString)
-> FilePath
-> (CString -> IO Connection)
-> IO Connection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
BUTF8.fromString)
connectSqlite3Raw :: FilePath -> IO Impl.Connection
connectSqlite3Raw :: FilePath -> IO Connection
connectSqlite3Raw = (FilePath -> (CString -> IO Connection) -> IO Connection)
-> FilePath -> IO Connection
genericConnect FilePath -> (CString -> IO Connection) -> IO Connection
forall a. FilePath -> (CString -> IO a) -> IO a
withCString
genericConnect :: (String -> (CString -> IO Impl.Connection) -> IO Impl.Connection)
-> FilePath
-> IO Impl.Connection
genericConnect :: (FilePath -> (CString -> IO Connection) -> IO Connection)
-> FilePath -> IO Connection
genericConnect strAsCStrFunc :: FilePath -> (CString -> IO Connection) -> IO Connection
strAsCStrFunc fp :: FilePath
fp =
FilePath -> (CString -> IO Connection) -> IO Connection
strAsCStrFunc FilePath
fp
(\cs :: 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 <- FilePath -> ForeignPtr CSqlite3 -> IO Connection
mkConn FilePath
fp ForeignPtr CSqlite3
fptr
FilePath -> ForeignPtr CSqlite3 -> CInt -> IO ()
checkError ("connectSqlite3 " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
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 :: FilePath -> ForeignPtr CSqlite3 -> IO Connection
mkConn fp :: FilePath
fp obj :: 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
FilePath
ver <- (IO CString
sqlite3_libversion IO CString -> (CString -> IO FilePath) -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO FilePath
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 ()
-> (FilePath -> [SqlValue] -> IO Integer)
-> (FilePath -> IO ())
-> (FilePath -> IO Statement)
-> IO Connection
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> Bool
-> IO [FilePath]
-> (FilePath -> IO [(FilePath, 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 :: FilePath -> [SqlValue] -> IO Integer
Impl.run = ForeignPtr CSqlite3
-> MVar [Weak Statement] -> FilePath -> [SqlValue] -> IO Integer
frun ForeignPtr CSqlite3
obj MVar [Weak Statement]
children,
runRaw :: FilePath -> IO ()
Impl.runRaw = ForeignPtr CSqlite3 -> MVar [Weak Statement] -> FilePath -> IO ()
frunRaw ForeignPtr CSqlite3
obj MVar [Weak Statement]
children,
prepare :: FilePath -> IO Statement
Impl.prepare = ForeignPtr CSqlite3
-> MVar [Weak Statement] -> Bool -> FilePath -> IO Statement
newSth ForeignPtr CSqlite3
obj MVar [Weak Statement]
children Bool
True,
clone :: IO Connection
Impl.clone = FilePath -> IO Connection
connectSqlite3 FilePath
fp,
hdbcDriverName :: FilePath
Impl.hdbcDriverName = "sqlite3",
hdbcClientVer :: FilePath
Impl.hdbcClientVer = FilePath
ver,
proxiedClientName :: FilePath
Impl.proxiedClientName = "sqlite3",
proxiedClientVer :: FilePath
Impl.proxiedClientVer = FilePath
ver,
dbTransactionSupport :: Bool
Impl.dbTransactionSupport = Bool
True,
dbServerVer :: FilePath
Impl.dbServerVer = FilePath
ver,
getTables :: IO [FilePath]
Impl.getTables = ForeignPtr CSqlite3 -> MVar [Weak Statement] -> IO [FilePath]
forall a.
Convertible SqlValue a =>
ForeignPtr CSqlite3 -> MVar [Weak Statement] -> IO [a]
fgettables ForeignPtr CSqlite3
obj MVar [Weak Statement]
children,
describeTable :: FilePath -> IO [(FilePath, SqlColDesc)]
Impl.describeTable = ForeignPtr CSqlite3
-> MVar [Weak Statement] -> FilePath -> IO [(FilePath, SqlColDesc)]
forall a.
Convertible SqlValue a =>
ForeignPtr CSqlite3
-> MVar [Weak Statement] -> FilePath -> 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 o :: ForeignPtr CSqlite3
o mchildren :: MVar [Weak Statement]
mchildren =
do Statement
sth <- ForeignPtr CSqlite3
-> MVar [Weak Statement] -> Bool -> FilePath -> IO Statement
newSth ForeignPtr CSqlite3
o MVar [Weak Statement]
mchildren Bool
True "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]
forall a b. a -> b -> b
seq ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
res) [a]
res
fdescribeTable :: ForeignPtr CSqlite3
-> MVar [Weak Statement] -> FilePath -> IO [(a, SqlColDesc)]
fdescribeTable o :: ForeignPtr CSqlite3
o mchildren :: MVar [Weak Statement]
mchildren name :: FilePath
name = do
Statement
sth <- ForeignPtr CSqlite3
-> MVar [Weak Statement] -> Bool -> FilePath -> IO Statement
newSth ForeignPtr CSqlite3
o MVar [Weak Statement]
mchildren Bool
True (FilePath -> IO Statement) -> FilePath -> IO Statement
forall a b. (a -> b) -> a -> b
$ "PRAGMA table_info(" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ")"
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 (_:name :: SqlValue
name:typ :: SqlValue
typ:notnull :: SqlValue
notnull:df :: SqlValue
df:pk :: SqlValue
pk:_) =
(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 name :: SqlValue
name notnull :: SqlValue
notnull df :: p
df pk :: 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 SqlNull = Maybe Bool
forall a. Maybe a
Nothing
nullable (SqlString "0") = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
nullable (SqlString "1") = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
nullable (SqlByteString x :: ByteString
x)
| ByteString -> FilePath
BUTF8.toString ByteString
x FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== "0" = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
| ByteString -> FilePath
BUTF8.toString ByteString
x FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== "1" = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
nullable _ = Maybe Bool
forall a. Maybe a
Nothing
typeId :: SqlValue -> SqlTypeId
typeId SqlNull = FilePath -> SqlTypeId
SqlUnknownT "Any"
typeId (SqlString t :: FilePath
t) = FilePath -> SqlTypeId
typeId' FilePath
t
typeId (SqlByteString t :: ByteString
t) = FilePath -> SqlTypeId
typeId' (FilePath -> SqlTypeId) -> FilePath -> SqlTypeId
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
BUTF8.toString ByteString
t
typeId _ = FilePath -> SqlTypeId
SqlUnknownT "Unknown"
typeId' :: FilePath -> SqlTypeId
typeId' t :: FilePath
t = case (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
Data.Char.toLower FilePath
t of
('i':'n':'t':_) -> SqlTypeId
SqlIntegerT
"text" -> SqlTypeId
SqlVarCharT
"real" -> SqlTypeId
SqlRealT
"blob" -> SqlTypeId
SqlVarBinaryT
"" -> FilePath -> SqlTypeId
SqlUnknownT "Any"
other :: FilePath
other -> FilePath -> SqlTypeId
SqlUnknownT FilePath
other
fsetbusy :: ForeignPtr CSqlite3 -> CInt -> IO ()
fsetbusy o :: ForeignPtr CSqlite3
o ms :: 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
$ \ppdb :: 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 o :: ForeignPtr CSqlite3
o children :: MVar [Weak Statement]
children = ForeignPtr CSqlite3
-> MVar [Weak Statement] -> FilePath -> [SqlValue] -> IO Integer
frun ForeignPtr CSqlite3
o MVar [Weak Statement]
children "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] -> FilePath -> [SqlValue] -> IO Integer
frun o :: ForeignPtr CSqlite3
o mchildren :: MVar [Weak Statement]
mchildren query :: FilePath
query args :: [SqlValue]
args =
do Statement
sth <- ForeignPtr CSqlite3
-> MVar [Weak Statement] -> Bool -> FilePath -> IO Statement
newSth ForeignPtr CSqlite3
o MVar [Weak Statement]
mchildren Bool
False FilePath
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] -> FilePath -> IO ()
frunRaw o :: ForeignPtr CSqlite3
o mchildren :: MVar [Weak Statement]
mchildren query :: FilePath
query =
do Statement
sth <- ForeignPtr CSqlite3
-> MVar [Weak Statement] -> Bool -> FilePath -> IO Statement
newSth ForeignPtr CSqlite3
o MVar [Weak Statement]
mchildren Bool
False FilePath
query
Statement -> IO ()
executeRaw Statement
sth
Statement -> IO ()
finish Statement
sth
fcommit :: ForeignPtr CSqlite3 -> MVar [Weak Statement] -> IO ()
fcommit o :: ForeignPtr CSqlite3
o children :: MVar [Weak Statement]
children = do ForeignPtr CSqlite3
-> MVar [Weak Statement] -> FilePath -> [SqlValue] -> IO Integer
frun ForeignPtr CSqlite3
o MVar [Weak Statement]
children "COMMIT" []
ForeignPtr CSqlite3 -> MVar [Weak Statement] -> IO ()
begin_transaction ForeignPtr CSqlite3
o MVar [Weak Statement]
children
frollback :: ForeignPtr CSqlite3 -> MVar [Weak Statement] -> IO ()
frollback o :: ForeignPtr CSqlite3
o children :: MVar [Weak Statement]
children = do ForeignPtr CSqlite3
-> MVar [Weak Statement] -> FilePath -> [SqlValue] -> IO Integer
frun ForeignPtr CSqlite3
o MVar [Weak Statement]
children "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 o :: ForeignPtr CSqlite3
o mchildren :: 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
$ \p :: Ptr CSqlite3
p ->
do MVar [Weak Statement] -> IO ()
closeAllChildren MVar [Weak Statement]
mchildren
CInt
r <- Ptr CSqlite3 -> IO CInt
sqlite3_close Ptr CSqlite3
p
FilePath -> ForeignPtr CSqlite3 -> CInt -> IO ()
checkError "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