{-# LINE 1 "Database/HDBC/Sqlite3/Statement.hsc" #-}
{-# CFILES hdbc-sqlite3-helper.c #-}
module Database.HDBC.Sqlite3.Statement where
import Database.HDBC.Types
import Database.HDBC
import Database.HDBC.Sqlite3.Types
import Database.HDBC.Sqlite3.Utils
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Ptr
import Control.Concurrent.MVar
import Foreign.C.String
import Foreign.Marshal
import Foreign.Storable
import Control.Monad
import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as BUTF8
import Data.List
import Control.Exception
import Database.HDBC.DriverUtils
data StoState = Empty
| Prepared Stmt
| Executed Stmt
| Exhausted Stmt
instance Show StoState where
show :: StoState -> String
show StoState
Empty = String
"Empty"
show (Prepared Stmt
_) = String
"Prepared"
show (Executed Stmt
_) = String
"Executed"
show (Exhausted Stmt
_) = String
"Exhausted"
data SState = SState {SState -> Sqlite3
dbo :: Sqlite3,
SState -> MVar StoState
stomv :: MVar StoState,
SState -> String
querys :: String,
SState -> MVar [String]
colnamesmv :: MVar [String],
SState -> Bool
autoFinish :: Bool}
newSth :: Sqlite3 -> ChildList -> Bool -> String -> IO Statement
newSth :: Sqlite3 -> ChildList -> Bool -> String -> IO Statement
newSth Sqlite3
indbo ChildList
mchildren Bool
autoFinish String
str =
do MVar StoState
newstomv <- StoState -> IO (MVar StoState)
forall a. a -> IO (MVar a)
newMVar StoState
Empty
MVar [String]
newcolnamesmv <- [String] -> IO (MVar [String])
forall a. a -> IO (MVar a)
newMVar []
let sstate :: SState
sstate = SState{dbo :: Sqlite3
dbo = Sqlite3
indbo,
stomv :: MVar StoState
stomv = MVar StoState
newstomv,
querys :: String
querys = String
str,
colnamesmv :: MVar [String]
colnamesmv = MVar [String]
newcolnamesmv,
autoFinish :: Bool
autoFinish = Bool
autoFinish}
MVar StoState -> (StoState -> IO StoState) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (SState -> MVar StoState
stomv SState
sstate) (\StoState
_ -> (SState -> IO Stmt
fprepare SState
sstate IO Stmt -> (Stmt -> IO StoState) -> IO StoState
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StoState -> IO StoState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (StoState -> IO StoState)
-> (Stmt -> StoState) -> Stmt -> IO StoState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stmt -> StoState
Prepared))
let retval :: Statement
retval =
Statement {execute :: [SqlValue] -> IO Integer
execute = SState -> [SqlValue] -> IO Integer
forall {b}. Num b => SState -> [SqlValue] -> IO b
fexecute SState
sstate,
executeRaw :: IO ()
executeRaw = Sqlite3 -> String -> IO ()
fexecuteRaw Sqlite3
indbo String
str,
executeMany :: [[SqlValue]] -> IO ()
executeMany = SState -> [[SqlValue]] -> IO ()
fexecutemany SState
sstate,
finish :: IO ()
finish = SState -> IO ()
public_ffinish SState
sstate,
fetchRow :: IO (Maybe [SqlValue])
fetchRow = SState -> IO (Maybe [SqlValue])
ffetchrow SState
sstate,
originalQuery :: String
originalQuery = String
str,
getColumnNames :: IO [String]
getColumnNames = MVar [String] -> IO [String]
forall a. MVar a -> IO a
readMVar (SState -> MVar [String]
colnamesmv SState
sstate),
describeResult :: IO [(String, SqlColDesc)]
describeResult = String -> IO [(String, SqlColDesc)]
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Sqlite3 backend does not support describeResult"}
ChildList -> Statement -> IO ()
addChild ChildList
mchildren Statement
retval
Statement -> IO Statement
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Statement
retval
fprepare :: SState -> IO Stmt
fprepare :: SState -> IO Stmt
fprepare SState
sstate = Sqlite3 -> (Ptr CSqlite3 -> IO Stmt) -> IO Stmt
forall b. Sqlite3 -> (Ptr CSqlite3 -> IO b) -> IO b
withRawSqlite3 (SState -> Sqlite3
dbo SState
sstate)
(\Ptr CSqlite3
p -> ByteString -> (CStringLen -> IO Stmt) -> IO Stmt
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.useAsCStringLen (String -> ByteString
BUTF8.fromString ((SState -> String
querys SState
sstate) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\0"))
(\(Ptr CChar
cs, Int
cslen) -> (Ptr (Ptr CStmt) -> IO Stmt) -> IO Stmt
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\(Ptr (Ptr CStmt)
newp::Ptr (Ptr CStmt)) ->
(do CInt
res <- Ptr CSqlite3
-> Ptr CChar
-> CInt
-> Ptr (Ptr CStmt)
-> Ptr (Ptr (Ptr CChar))
-> IO CInt
sqlite3_prepare Ptr CSqlite3
p Ptr CChar
cs (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cslen) Ptr (Ptr CStmt)
newp Ptr (Ptr (Ptr CChar))
forall a. Ptr a
nullPtr
String -> Sqlite3 -> CInt -> IO ()
checkError (String
"prepare " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show Int
cslen) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SState -> String
querys SState
sstate))
(SState -> Sqlite3
dbo SState
sstate) CInt
res
Ptr CStmt
newo <- Ptr (Ptr CStmt) -> IO (Ptr CStmt)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CStmt)
newp
FinalizerPtr CStmt -> Ptr CStmt -> IO Stmt
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr CStmt
sqlite3_finalizeptr Ptr CStmt
newo
)
)
)
)
ffetchrow :: SState -> IO (Maybe [SqlValue])
ffetchrow :: SState -> IO (Maybe [SqlValue])
ffetchrow SState
sstate = MVar StoState
-> (StoState -> IO (StoState, Maybe [SqlValue]))
-> IO (Maybe [SqlValue])
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (SState -> MVar StoState
stomv SState
sstate) StoState -> IO (StoState, Maybe [SqlValue])
dofetchrow
where dofetchrow :: StoState -> IO (StoState, Maybe [SqlValue])
dofetchrow StoState
Empty = (StoState, Maybe [SqlValue]) -> IO (StoState, Maybe [SqlValue])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (StoState
Empty, Maybe [SqlValue]
forall a. Maybe a
Nothing)
dofetchrow (Prepared Stmt
_) =
SqlError -> IO (StoState, Maybe [SqlValue])
forall a. SqlError -> IO a
throwSqlError (SqlError -> IO (StoState, Maybe [SqlValue]))
-> SqlError -> IO (StoState, Maybe [SqlValue])
forall a b. (a -> b) -> a -> b
$ SqlError {seState :: String
seState = String
"HDBC Sqlite3 fetchrow",
seNativeError :: Int
seNativeError = (-Int
1),
seErrorMsg :: String
seErrorMsg = String
"Attempt to fetch row from Statement that has not been executed. Query was: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SState -> String
querys SState
sstate)}
dofetchrow (Executed Stmt
sto) = Stmt
-> (Ptr CStmt -> IO (StoState, Maybe [SqlValue]))
-> IO (StoState, Maybe [SqlValue])
forall b. Stmt -> (Ptr CStmt -> IO b) -> IO b
withStmt Stmt
sto (\Ptr CStmt
p ->
do CInt
ccount <- Ptr CStmt -> IO CInt
sqlite3_column_count Ptr CStmt
p
[SqlValue]
res <- (CInt -> IO SqlValue) -> [CInt] -> IO [SqlValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Ptr CStmt -> CInt -> IO SqlValue
getCol Ptr CStmt
p) [CInt
0..(CInt
ccount CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1)]
Bool
r <- Sqlite3 -> Ptr CStmt -> IO Bool
fstep (SState -> Sqlite3
dbo SState
sstate) Ptr CStmt
p
if Bool
r
then (StoState, Maybe [SqlValue]) -> IO (StoState, Maybe [SqlValue])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Stmt -> StoState
Executed Stmt
sto, [SqlValue] -> Maybe [SqlValue]
forall a. a -> Maybe a
Just [SqlValue]
res)
else if (SState -> Bool
autoFinish SState
sstate)
then do Sqlite3 -> Stmt -> IO ()
ffinish (SState -> Sqlite3
dbo SState
sstate) Stmt
sto
(StoState, Maybe [SqlValue]) -> IO (StoState, Maybe [SqlValue])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (StoState
Empty, [SqlValue] -> Maybe [SqlValue]
forall a. a -> Maybe a
Just [SqlValue]
res)
else (StoState, Maybe [SqlValue]) -> IO (StoState, Maybe [SqlValue])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Stmt -> StoState
Exhausted Stmt
sto, [SqlValue] -> Maybe [SqlValue]
forall a. a -> Maybe a
Just [SqlValue]
res)
)
dofetchrow (Exhausted Stmt
sto) = (StoState, Maybe [SqlValue]) -> IO (StoState, Maybe [SqlValue])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Stmt -> StoState
Exhausted Stmt
sto, Maybe [SqlValue]
forall a. Maybe a
Nothing)
getCol :: Ptr CStmt -> CInt -> IO SqlValue
getCol Ptr CStmt
p CInt
icol =
do CInt
t <- Ptr CStmt -> CInt -> IO CInt
sqlite3_column_type Ptr CStmt
p CInt
icol
if CInt
t CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
5
{-# LINE 121 "Database/HDBC/Sqlite3/Statement.hsc" #-}
then SqlValue -> IO SqlValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SqlValue
SqlNull
else do Ptr CChar
text <- Ptr CStmt -> CInt -> IO (Ptr CChar)
sqlite3_column_text Ptr CStmt
p CInt
icol
CInt
len <- Ptr CStmt -> CInt -> IO CInt
sqlite3_column_bytes Ptr CStmt
p CInt
icol
ByteString
s <- CStringLen -> IO ByteString
B.packCStringLen (Ptr CChar
text, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
len)
case CInt
t of
CInt
1 -> SqlValue -> IO SqlValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlValue -> IO SqlValue) -> SqlValue -> IO SqlValue
forall a b. (a -> b) -> a -> b
$ Int64 -> SqlValue
SqlInt64 (String -> Int64
forall a. Read a => String -> a
read (String -> Int64) -> String -> Int64
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BUTF8.toString ByteString
s)
{-# LINE 127 "Database/HDBC/Sqlite3/Statement.hsc" #-}
CInt
2 -> SqlValue -> IO SqlValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlValue -> IO SqlValue) -> SqlValue -> IO SqlValue
forall a b. (a -> b) -> a -> b
$ Double -> SqlValue
SqlDouble (String -> Double
forall a. Read a => String -> a
read (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BUTF8.toString ByteString
s)
{-# LINE 128 "Database/HDBC/Sqlite3/Statement.hsc" #-}
CInt
4 -> SqlValue -> IO SqlValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlValue -> IO SqlValue) -> SqlValue -> IO SqlValue
forall a b. (a -> b) -> a -> b
$ ByteString -> SqlValue
SqlByteString ByteString
s
{-# LINE 129 "Database/HDBC/Sqlite3/Statement.hsc" #-}
CInt
3 -> SqlValue -> IO SqlValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlValue -> IO SqlValue) -> SqlValue -> IO SqlValue
forall a b. (a -> b) -> a -> b
$ ByteString -> SqlValue
SqlByteString ByteString
s
{-# LINE 130 "Database/HDBC/Sqlite3/Statement.hsc" #-}
CInt
_ -> SqlValue -> IO SqlValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlValue -> IO SqlValue) -> SqlValue -> IO SqlValue
forall a b. (a -> b) -> a -> b
$ ByteString -> SqlValue
SqlByteString ByteString
s
fstep :: Sqlite3 -> Ptr CStmt -> IO Bool
fstep :: Sqlite3 -> Ptr CStmt -> IO Bool
fstep Sqlite3
dbo Ptr CStmt
p =
do CInt
r <- Ptr CStmt -> IO CInt
sqlite3_step Ptr CStmt
p
case CInt
r of
CInt
100 -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
{-# LINE 137 "Database/HDBC/Sqlite3/Statement.hsc" #-}
CInt
101 -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
{-# LINE 138 "Database/HDBC/Sqlite3/Statement.hsc" #-}
CInt
1 -> String -> Sqlite3 -> CInt -> IO ()
checkError String
"step" Sqlite3
dbo CInt
1
{-# LINE 139 "Database/HDBC/Sqlite3/Statement.hsc" #-}
IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (SqlError -> IO Bool
forall a. SqlError -> IO a
throwSqlError (SqlError -> IO Bool) -> SqlError -> IO Bool
forall a b. (a -> b) -> a -> b
$ SqlError
{seState :: String
seState = String
"",
seNativeError :: Int
seNativeError = Int
0,
seErrorMsg :: String
seErrorMsg = String
"In HDBC step, internal processing error (got SQLITE_ERROR with no error)"})
CInt
x -> String -> Sqlite3 -> CInt -> IO ()
checkError String
"step" Sqlite3
dbo CInt
x
IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (SqlError -> IO Bool
forall a. SqlError -> IO a
throwSqlError (SqlError -> IO Bool) -> SqlError -> IO Bool
forall a b. (a -> b) -> a -> b
$ SqlError
{seState :: String
seState = String
"",
seNativeError :: Int
seNativeError = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
x,
seErrorMsg :: String
seErrorMsg = String
"In HDBC step, internal processing error (got error code with no error)"})
fexecute :: SState -> [SqlValue] -> IO b
fexecute SState
sstate [SqlValue]
args = MVar StoState -> (StoState -> IO (StoState, b)) -> IO b
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (SState -> MVar StoState
stomv SState
sstate) StoState -> IO (StoState, b)
forall {b}. Num b => StoState -> IO (StoState, b)
doexecute
where doexecute :: StoState -> IO (StoState, b)
doexecute (Executed Stmt
sto) = StoState -> IO (StoState, b)
doexecute (Stmt -> StoState
Prepared Stmt
sto)
doexecute (Exhausted Stmt
sto) = StoState -> IO (StoState, b)
doexecute (Stmt -> StoState
Prepared Stmt
sto)
doexecute StoState
Empty =
do Stmt
sto <- SState -> IO Stmt
fprepare SState
sstate
StoState -> IO (StoState, b)
doexecute (Stmt -> StoState
Prepared Stmt
sto)
doexecute (Prepared Stmt
sto) = Stmt -> (Ptr CStmt -> IO (StoState, b)) -> IO (StoState, b)
forall b. Stmt -> (Ptr CStmt -> IO b) -> IO b
withStmt Stmt
sto (\Ptr CStmt
p ->
do CInt
c <- Ptr CStmt -> IO CInt
sqlite3_bind_parameter_count Ptr CStmt
p
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
c CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= [SqlValue] -> CInt
forall i a. Num i => [a] -> i
genericLength [SqlValue]
args)
(SqlError -> IO ()
forall a. SqlError -> IO a
throwSqlError (SqlError -> IO ()) -> SqlError -> IO ()
forall a b. (a -> b) -> a -> b
$ SqlError {seState :: String
seState = String
"",
seNativeError :: Int
seNativeError = (-Int
1),
seErrorMsg :: String
seErrorMsg = String
"In HDBC execute, received " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([SqlValue] -> String
forall a. Show a => a -> String
show [SqlValue]
args) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" but expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (CInt -> String
forall a. Show a => a -> String
show CInt
c) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" args."})
Ptr CStmt -> IO CInt
sqlite3_reset Ptr CStmt
p IO CInt -> (CInt -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Sqlite3 -> CInt -> IO ()
checkError String
"execute (reset)" (SState -> Sqlite3
dbo SState
sstate)
(CInt -> SqlValue -> IO ()) -> [CInt] -> [SqlValue] -> IO ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (Ptr CStmt -> CInt -> SqlValue -> IO ()
bindArgs Ptr CStmt
p) [CInt
1..CInt
c] [SqlValue]
args
CInt
origtc <- Sqlite3 -> (Ptr CSqlite3 -> IO CInt) -> IO CInt
forall b. Sqlite3 -> (Ptr CSqlite3 -> IO b) -> IO b
withSqlite3 (SState -> Sqlite3
dbo SState
sstate) Ptr CSqlite3 -> IO CInt
sqlite3_total_changes
Bool
r <- Sqlite3 -> Ptr CStmt -> IO Bool
fstep (SState -> Sqlite3
dbo SState
sstate) Ptr CStmt
p
CInt
newtc <- Sqlite3 -> (Ptr CSqlite3 -> IO CInt) -> IO CInt
forall b. Sqlite3 -> (Ptr CSqlite3 -> IO b) -> IO b
withSqlite3 (SState -> Sqlite3
dbo SState
sstate) Ptr CSqlite3 -> IO CInt
sqlite3_total_changes
CInt
changes <- if CInt
origtc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
newtc
then CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
0
else Sqlite3 -> (Ptr CSqlite3 -> IO CInt) -> IO CInt
forall b. Sqlite3 -> (Ptr CSqlite3 -> IO b) -> IO b
withSqlite3 (SState -> Sqlite3
dbo SState
sstate) Ptr CSqlite3 -> IO CInt
sqlite3_changes
Ptr CStmt -> IO [String]
fgetcolnames Ptr CStmt
p IO [String] -> ([String] -> IO [String]) -> IO [String]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MVar [String] -> [String] -> IO [String]
forall a. MVar a -> a -> IO a
swapMVar (SState -> MVar [String]
colnamesmv SState
sstate)
if Bool
r
then (StoState, b) -> IO (StoState, b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Stmt -> StoState
Executed Stmt
sto, CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
changes)
else if (SState -> Bool
autoFinish SState
sstate)
then do Sqlite3 -> Stmt -> IO ()
ffinish (SState -> Sqlite3
dbo SState
sstate) Stmt
sto
(StoState, b) -> IO (StoState, b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (StoState
Empty, CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
changes)
else (StoState, b) -> IO (StoState, b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Stmt -> StoState
Exhausted Stmt
sto, CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
changes)
)
bindArgs :: Ptr CStmt -> CInt -> SqlValue -> IO ()
bindArgs Ptr CStmt
p CInt
i SqlValue
SqlNull =
Ptr CStmt -> CInt -> IO CInt
sqlite3_bind_null Ptr CStmt
p CInt
i IO CInt -> (CInt -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
String -> Sqlite3 -> CInt -> IO ()
checkError (String
"execute (binding NULL column " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (CInt -> String
forall a. Show a => a -> String
show CInt
i) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")")
(SState -> Sqlite3
dbo SState
sstate)
bindArgs Ptr CStmt
p CInt
i (SqlByteString ByteString
bs) =
ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.useAsCStringLen ByteString
bs (Ptr CStmt -> CInt -> CStringLen -> IO ()
forall {a}.
Integral a =>
Ptr CStmt -> CInt -> (Ptr CChar, a) -> IO ()
bindCStringArgs Ptr CStmt
p CInt
i)
bindArgs Ptr CStmt
p CInt
i SqlValue
arg = Ptr CStmt -> CInt -> SqlValue -> IO ()
bindArgs Ptr CStmt
p CInt
i (ByteString -> SqlValue
SqlByteString (SqlValue -> ByteString
forall a. Convertible SqlValue a => SqlValue -> a
fromSql SqlValue
arg))
bindCStringArgs :: Ptr CStmt -> CInt -> (Ptr CChar, a) -> IO ()
bindCStringArgs Ptr CStmt
p CInt
i (Ptr CChar
cs, a
len) =
do CInt
r <- Ptr CStmt -> CInt -> Ptr CChar -> CInt -> IO CInt
sqlite3_bind_text2 Ptr CStmt
p CInt
i Ptr CChar
cs (a -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
len)
String -> Sqlite3 -> CInt -> IO ()
checkError (String
"execute (binding column " String -> ShowS
forall a. [a] -> [a] -> [a]
++
(CInt -> String
forall a. Show a => a -> String
show CInt
i) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")") (SState -> Sqlite3
dbo SState
sstate) CInt
r
fexecuteRaw :: Sqlite3 -> String -> IO ()
fexecuteRaw :: Sqlite3 -> String -> IO ()
fexecuteRaw Sqlite3
dbo String
query =
Sqlite3 -> (Ptr CSqlite3 -> IO ()) -> IO ()
forall b. Sqlite3 -> (Ptr CSqlite3 -> IO b) -> IO b
withSqlite3 Sqlite3
dbo
(\Ptr CSqlite3
p -> ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.useAsCStringLen (String -> ByteString
BUTF8.fromString (String
query String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\0"))
(\(Ptr CChar
cs, Int
cslen) -> do
CInt
result <- Ptr CSqlite3
-> Ptr CChar
-> FunPtr (Ptr () -> CInt -> Ptr (Ptr CChar) -> Ptr (Ptr CChar))
-> Ptr ()
-> Ptr (Ptr CChar)
-> IO CInt
sqlite3_exec Ptr CSqlite3
p Ptr CChar
cs FunPtr (Ptr () -> CInt -> Ptr (Ptr CChar) -> Ptr (Ptr CChar))
forall a. FunPtr a
nullFunPtr Ptr ()
forall a. Ptr a
nullPtr Ptr (Ptr CChar)
forall a. Ptr a
nullPtr
case CInt
result of
CInt
0 -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# LINE 207 "Database/HDBC/Sqlite3/Statement.hsc" #-}
CInt
s -> do
String -> Sqlite3 -> CInt -> IO ()
checkError String
"exec" Sqlite3
dbo CInt
s
SqlError -> IO ()
forall a. SqlError -> IO a
throwSqlError (SqlError -> IO ()) -> SqlError -> IO ()
forall a b. (a -> b) -> a -> b
$ SqlError
{seState :: String
seState = String
"",
seNativeError :: Int
seNativeError = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
s,
seErrorMsg :: String
seErrorMsg = String
"In sqlite3_exec, internal error"}
)
)
fgetcolnames :: Ptr CStmt -> IO [String]
fgetcolnames Ptr CStmt
csth =
do CInt
count <- Ptr CStmt -> IO CInt
sqlite3_column_count Ptr CStmt
csth
(CInt -> IO String) -> [CInt] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Ptr CStmt -> CInt -> IO String
getCol Ptr CStmt
csth) [CInt
0..(CInt
count CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
-CInt
1)]
where getCol :: Ptr CStmt -> CInt -> IO String
getCol Ptr CStmt
csth CInt
i =
do Ptr CChar
cstr <- Ptr CStmt -> CInt -> IO (Ptr CChar)
sqlite3_column_name Ptr CStmt
csth CInt
i
ByteString
bs <- Ptr CChar -> IO ByteString
B.packCString Ptr CChar
cstr
String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> String
BUTF8.toString ByteString
bs)
fexecutemany :: SState -> [[SqlValue]] -> IO ()
fexecutemany SState
_ [] = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
fexecutemany SState
sstate ([SqlValue]
args:[]) =
do SState -> [SqlValue] -> IO Integer
forall {b}. Num b => SState -> [SqlValue] -> IO b
fexecute SState
sstate [SqlValue]
args
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
fexecutemany SState
sstate ([SqlValue]
args:[[SqlValue]]
arglist) =
do SState -> [SqlValue] -> IO Integer
forall {b}. Num b => SState -> [SqlValue] -> IO b
fexecute (SState
sstate { autoFinish :: Bool
autoFinish = Bool
False }) [SqlValue]
args
SState -> [[SqlValue]] -> IO ()
fexecutemany SState
sstate [[SqlValue]]
arglist
public_ffinish :: SState -> IO ()
public_ffinish SState
sstate = MVar StoState -> (StoState -> IO StoState) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (SState -> MVar StoState
stomv SState
sstate) StoState -> IO StoState
worker
where worker :: StoState -> IO StoState
worker (StoState
Empty) = StoState -> IO StoState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return StoState
Empty
worker (Prepared Stmt
sto) = Sqlite3 -> Stmt -> IO ()
ffinish (SState -> Sqlite3
dbo SState
sstate) Stmt
sto IO () -> IO StoState -> IO StoState
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StoState -> IO StoState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return StoState
Empty
worker (Executed Stmt
sto) = Sqlite3 -> Stmt -> IO ()
ffinish (SState -> Sqlite3
dbo SState
sstate) Stmt
sto IO () -> IO StoState -> IO StoState
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StoState -> IO StoState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return StoState
Empty
worker (Exhausted Stmt
sto) = Sqlite3 -> Stmt -> IO ()
ffinish (SState -> Sqlite3
dbo SState
sstate) Stmt
sto IO () -> IO StoState -> IO StoState
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StoState -> IO StoState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return StoState
Empty
ffinish :: Sqlite3 -> Stmt -> IO ()
ffinish Sqlite3
dbo Stmt
o = Stmt -> (Ptr CStmt -> IO ()) -> IO ()
forall b. Stmt -> (Ptr CStmt -> IO b) -> IO b
withRawStmt Stmt
o (\Ptr CStmt
p -> do CInt
r <- Ptr CStmt -> IO CInt
sqlite3_finalize Ptr CStmt
p
String -> Sqlite3 -> CInt -> IO ()
checkError String
"finish" Sqlite3
dbo CInt
r)
foreign import ccall unsafe "hdbc-sqlite3-helper.h &sqlite3_finalize_finalizer"
sqlite3_finalizeptr :: FunPtr ((Ptr CStmt) -> IO ())
foreign import ccall unsafe "hdbc-sqlite3-helper.h sqlite3_finalize_app"
sqlite3_finalize :: (Ptr CStmt) -> IO CInt
foreign import ccall unsafe "hdbc-sqlite3-helper.h sqlite3_prepare2"
sqlite3_prepare :: (Ptr CSqlite3) -> CString -> CInt -> Ptr (Ptr CStmt) -> Ptr (Ptr CString) -> IO CInt
foreign import ccall unsafe "sqlite3.h sqlite3_bind_parameter_count"
sqlite3_bind_parameter_count :: (Ptr CStmt) -> IO CInt
foreign import ccall unsafe "sqlite3.h sqlite3_step"
sqlite3_step :: (Ptr CStmt) -> IO CInt
foreign import ccall unsafe "sqlite3.h sqlite3_exec"
sqlite3_exec :: (Ptr CSqlite3)
-> CString
-> FunPtr (Ptr () -> CInt -> Ptr CString -> Ptr CString)
-> Ptr ()
-> Ptr CString
-> IO CInt
foreign import ccall unsafe "sqlite3.h sqlite3_reset"
sqlite3_reset :: (Ptr CStmt) -> IO CInt
foreign import ccall unsafe "sqlite3.h sqlite3_column_count"
sqlite3_column_count :: (Ptr CStmt) -> IO CInt
foreign import ccall unsafe "sqlite3.h sqlite3_column_name"
sqlite3_column_name :: Ptr CStmt -> CInt -> IO CString
foreign import ccall unsafe "sqlite3.h sqlite3_column_type"
sqlite3_column_type :: (Ptr CStmt) -> CInt -> IO CInt
foreign import ccall unsafe "sqlite3.h sqlite3_column_text"
sqlite3_column_text :: (Ptr CStmt) -> CInt -> IO CString
foreign import ccall unsafe "sqlite3.h sqlite3_column_bytes"
sqlite3_column_bytes :: (Ptr CStmt) -> CInt -> IO CInt
foreign import ccall unsafe "hdbc-sqlite3-helper.h sqlite3_bind_text2"
sqlite3_bind_text2 :: (Ptr CStmt) -> CInt -> CString -> CInt -> IO CInt
foreign import ccall unsafe "sqlite3.h sqlite3_bind_null"
sqlite3_bind_null :: (Ptr CStmt) -> CInt -> IO CInt
foreign import ccall unsafe "sqlite3.h sqlite3_changes"
sqlite3_changes :: Ptr CSqlite3 -> IO CInt
foreign import ccall unsafe "sqlite3.h sqlite3_total_changes"
sqlite3_total_changes :: Ptr CSqlite3 -> IO CInt