{-# LINE 1 "Database/HDBC/Sqlite3/Statement.hsc" #-}
-- -*- mode: haskell; -*-
{-# CFILES hdbc-sqlite3-helper.c #-}
-- Above line for Hugs
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



{- One annoying thing about Sqlite is that a disconnect operation will actually
fail if there are any active statements.  This is highly annoying, and makes
for some somewhat complex algorithms. -}

data StoState = Empty           -- ^ Not initialized or last execute\/fetchrow had no results
              | Prepared Stmt   -- ^ Prepared but not executed
              | Executed Stmt   -- ^ Executed and more rows are expected
              | Exhausted Stmt  -- ^ Executed and at end of rows

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

{- The deal with adding the \0 below is in response to an apparent bug in
sqlite3.  See debian bug #343736. 

This function assumes that any existing query in the state has already
been terminated.  (FIXME: should check this at runtime.... never run fprepare
unless state is Empty)
-}
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
     )
     )
   )
   )
                 

{- General algorithm: find out how many columns we have, check the type
of each to see if it's NULL.  If it's not, fetch it as text and return that.

Note that execute() will have already loaded up the first row -- and we
do that each time.  so this function returns the row that is already in sqlite,
then loads the next row. -}
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
                 -- fetch the data
                 [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 =     -- already cleaned up from last time
              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

                 {- Logic for handling counts of changes: look at the total
                    changes before and after the query.  If they differ,
                    then look at the local changes.  (The local change counter
                    appears to not be updated unless really running a query
                    that makes a change, according to the docs.)

                    This is OK thread-wise because SQLite doesn't support
                    using a given dbh in more than one thread anyway. -}
                 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

--ffinish o = withForeignPtr o (\p -> sqlite3_finalize p >>= checkError "finish")
-- Finish and change state
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