{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE OverloadedStrings #-}
module Squeather.Internal where
import qualified Control.Exception as Exception
import Control.Exception (throwIO)
import Control.Monad (when)
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import Data.Int (Int64)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Encoding
import qualified Foreign
import Foreign.C.Types (CInt(CInt), CChar, CUChar)
import Foreign (Ptr, FunPtr, ForeignPtr)
import Squeather.Internal.Bindings (SQLData(SQLNull, SQLText, SQLFloat, SQLInteger, SQLBlob))
import qualified Squeather.Internal.Bindings as Bindings
import Squeather.Internal.Types (ErrorFlag, StepResult, OpenFlags)
import qualified Squeather.Internal.Types as Types
data C'sqlite3
data C'sqlite3_stmt
data C'void
data Database = Database
{ Database -> ForeignPtr C'sqlite3
dbPointer :: ForeignPtr C'sqlite3
, Database -> Text
dbFilename :: Text
} deriving (Database -> Database -> Bool
(Database -> Database -> Bool)
-> (Database -> Database -> Bool) -> Eq Database
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Database -> Database -> Bool
$c/= :: Database -> Database -> Bool
== :: Database -> Database -> Bool
$c== :: Database -> Database -> Bool
Eq, Eq Database
Eq Database
-> (Database -> Database -> Ordering)
-> (Database -> Database -> Bool)
-> (Database -> Database -> Bool)
-> (Database -> Database -> Bool)
-> (Database -> Database -> Bool)
-> (Database -> Database -> Database)
-> (Database -> Database -> Database)
-> Ord Database
Database -> Database -> Bool
Database -> Database -> Ordering
Database -> Database -> Database
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Database -> Database -> Database
$cmin :: Database -> Database -> Database
max :: Database -> Database -> Database
$cmax :: Database -> Database -> Database
>= :: Database -> Database -> Bool
$c>= :: Database -> Database -> Bool
> :: Database -> Database -> Bool
$c> :: Database -> Database -> Bool
<= :: Database -> Database -> Bool
$c<= :: Database -> Database -> Bool
< :: Database -> Database -> Bool
$c< :: Database -> Database -> Bool
compare :: Database -> Database -> Ordering
$ccompare :: Database -> Database -> Ordering
$cp1Ord :: Eq Database
Ord, Int -> Database -> ShowS
[Database] -> ShowS
Database -> String
(Int -> Database -> ShowS)
-> (Database -> String) -> ([Database] -> ShowS) -> Show Database
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Database] -> ShowS
$cshowList :: [Database] -> ShowS
show :: Database -> String
$cshow :: Database -> String
showsPrec :: Int -> Database -> ShowS
$cshowsPrec :: Int -> Database -> ShowS
Show)
data Statement = Statement
{ Statement -> ForeignPtr C'sqlite3_stmt
stmtPointer :: ForeignPtr C'sqlite3_stmt
, Statement -> Text
stmtSql :: Text
, Statement -> Database
stmtDb :: Database
} deriving (Statement -> Statement -> Bool
(Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool) -> Eq Statement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Statement -> Statement -> Bool
$c/= :: Statement -> Statement -> Bool
== :: Statement -> Statement -> Bool
$c== :: Statement -> Statement -> Bool
Eq, Eq Statement
Eq Statement
-> (Statement -> Statement -> Ordering)
-> (Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool)
-> (Statement -> Statement -> Statement)
-> (Statement -> Statement -> Statement)
-> Ord Statement
Statement -> Statement -> Bool
Statement -> Statement -> Ordering
Statement -> Statement -> Statement
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Statement -> Statement -> Statement
$cmin :: Statement -> Statement -> Statement
max :: Statement -> Statement -> Statement
$cmax :: Statement -> Statement -> Statement
>= :: Statement -> Statement -> Bool
$c>= :: Statement -> Statement -> Bool
> :: Statement -> Statement -> Bool
$c> :: Statement -> Statement -> Bool
<= :: Statement -> Statement -> Bool
$c<= :: Statement -> Statement -> Bool
< :: Statement -> Statement -> Bool
$c< :: Statement -> Statement -> Bool
compare :: Statement -> Statement -> Ordering
$ccompare :: Statement -> Statement -> Ordering
$cp1Ord :: Eq Statement
Ord, Int -> Statement -> ShowS
[Statement] -> ShowS
Statement -> String
(Int -> Statement -> ShowS)
-> (Statement -> String)
-> ([Statement] -> ShowS)
-> Show Statement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Statement] -> ShowS
$cshowList :: [Statement] -> ShowS
show :: Statement -> String
$cshow :: Statement -> String
showsPrec :: Int -> Statement -> ShowS
$cshowsPrec :: Int -> Statement -> ShowS
Show)
data SqueatherErrorFlag
= ParameterNotFound
| ExecFailed
| IntConversion
| UnknownColumnType CInt
| UnknownSqliteError CInt
| IncompleteBackup
| Bug
| ColumnNameNull Int
deriving (SqueatherErrorFlag -> SqueatherErrorFlag -> Bool
(SqueatherErrorFlag -> SqueatherErrorFlag -> Bool)
-> (SqueatherErrorFlag -> SqueatherErrorFlag -> Bool)
-> Eq SqueatherErrorFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SqueatherErrorFlag -> SqueatherErrorFlag -> Bool
$c/= :: SqueatherErrorFlag -> SqueatherErrorFlag -> Bool
== :: SqueatherErrorFlag -> SqueatherErrorFlag -> Bool
$c== :: SqueatherErrorFlag -> SqueatherErrorFlag -> Bool
Eq, Eq SqueatherErrorFlag
Eq SqueatherErrorFlag
-> (SqueatherErrorFlag -> SqueatherErrorFlag -> Ordering)
-> (SqueatherErrorFlag -> SqueatherErrorFlag -> Bool)
-> (SqueatherErrorFlag -> SqueatherErrorFlag -> Bool)
-> (SqueatherErrorFlag -> SqueatherErrorFlag -> Bool)
-> (SqueatherErrorFlag -> SqueatherErrorFlag -> Bool)
-> (SqueatherErrorFlag -> SqueatherErrorFlag -> SqueatherErrorFlag)
-> (SqueatherErrorFlag -> SqueatherErrorFlag -> SqueatherErrorFlag)
-> Ord SqueatherErrorFlag
SqueatherErrorFlag -> SqueatherErrorFlag -> Bool
SqueatherErrorFlag -> SqueatherErrorFlag -> Ordering
SqueatherErrorFlag -> SqueatherErrorFlag -> SqueatherErrorFlag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SqueatherErrorFlag -> SqueatherErrorFlag -> SqueatherErrorFlag
$cmin :: SqueatherErrorFlag -> SqueatherErrorFlag -> SqueatherErrorFlag
max :: SqueatherErrorFlag -> SqueatherErrorFlag -> SqueatherErrorFlag
$cmax :: SqueatherErrorFlag -> SqueatherErrorFlag -> SqueatherErrorFlag
>= :: SqueatherErrorFlag -> SqueatherErrorFlag -> Bool
$c>= :: SqueatherErrorFlag -> SqueatherErrorFlag -> Bool
> :: SqueatherErrorFlag -> SqueatherErrorFlag -> Bool
$c> :: SqueatherErrorFlag -> SqueatherErrorFlag -> Bool
<= :: SqueatherErrorFlag -> SqueatherErrorFlag -> Bool
$c<= :: SqueatherErrorFlag -> SqueatherErrorFlag -> Bool
< :: SqueatherErrorFlag -> SqueatherErrorFlag -> Bool
$c< :: SqueatherErrorFlag -> SqueatherErrorFlag -> Bool
compare :: SqueatherErrorFlag -> SqueatherErrorFlag -> Ordering
$ccompare :: SqueatherErrorFlag -> SqueatherErrorFlag -> Ordering
$cp1Ord :: Eq SqueatherErrorFlag
Ord, Int -> SqueatherErrorFlag -> ShowS
[SqueatherErrorFlag] -> ShowS
SqueatherErrorFlag -> String
(Int -> SqueatherErrorFlag -> ShowS)
-> (SqueatherErrorFlag -> String)
-> ([SqueatherErrorFlag] -> ShowS)
-> Show SqueatherErrorFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SqueatherErrorFlag] -> ShowS
$cshowList :: [SqueatherErrorFlag] -> ShowS
show :: SqueatherErrorFlag -> String
$cshow :: SqueatherErrorFlag -> String
showsPrec :: Int -> SqueatherErrorFlag -> ShowS
$cshowsPrec :: Int -> SqueatherErrorFlag -> ShowS
Show)
data Error = Error
{ Error -> Text
errorContext :: Text
, Error -> Either ErrorFlag SqueatherErrorFlag
errorFlag :: Either ErrorFlag SqueatherErrorFlag
, Error -> Text
errorText :: Text
, Error -> Text
errorFilename :: Text
} deriving (Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq, Eq Error
Eq Error
-> (Error -> Error -> Ordering)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Error)
-> (Error -> Error -> Error)
-> Ord Error
Error -> Error -> Bool
Error -> Error -> Ordering
Error -> Error -> Error
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Error -> Error -> Error
$cmin :: Error -> Error -> Error
max :: Error -> Error -> Error
$cmax :: Error -> Error -> Error
>= :: Error -> Error -> Bool
$c>= :: Error -> Error -> Bool
> :: Error -> Error -> Bool
$c> :: Error -> Error -> Bool
<= :: Error -> Error -> Bool
$c<= :: Error -> Error -> Bool
< :: Error -> Error -> Bool
$c< :: Error -> Error -> Bool
compare :: Error -> Error -> Ordering
$ccompare :: Error -> Error -> Ordering
$cp1Ord :: Eq Error
Ord, Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show)
instance Exception.Exception Error
foreign import ccall unsafe "sqlite3_extended_result_codes" sqlite3_extended_result_codes
:: Ptr C'sqlite3
-> Int
-> IO CInt
foreign import ccall unsafe "sqlite3_open_v2" sqlite3_open_v2
:: Ptr CChar
-> Ptr (Ptr C'sqlite3)
-> CInt
-> Ptr CChar
-> IO CInt
foreign import ccall unsafe "sqlite3_errmsg" sqlite3_errmsg
:: Ptr C'sqlite3
-> IO (Ptr CChar)
readUtf8 :: Ptr CChar -> IO Text
readUtf8 :: Ptr CChar -> IO Text
readUtf8 Ptr CChar
cstr = do
ByteString
bs <- Ptr CChar -> IO ByteString
ByteString.packCString Ptr CChar
cstr
Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> (ByteString -> Text) -> ByteString -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Encoding.decodeUtf8 (ByteString -> IO Text) -> ByteString -> IO Text
forall a b. (a -> b) -> a -> b
$ ByteString
bs
writeUtf8 :: Text -> (Ptr CChar -> IO a) -> IO a
writeUtf8 :: Text -> (Ptr CChar -> IO a) -> IO a
writeUtf8 Text
txt Ptr CChar -> IO a
cback = do
let bs :: ByteString
bs = Text -> ByteString
Encoding.encodeUtf8 Text
txt
ByteString -> (Ptr CChar -> IO a) -> IO a
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
ByteString.useAsCString ByteString
bs Ptr CChar -> IO a
cback
writeUtf8Len :: Text -> ((Ptr CChar, Int) -> IO a) -> IO a
writeUtf8Len :: Text -> ((Ptr CChar, Int) -> IO a) -> IO a
writeUtf8Len Text
txt (Ptr CChar, Int) -> IO a
cback = do
let bs :: ByteString
bs = Text -> ByteString
Encoding.encodeUtf8 Text
txt
ByteString -> ((Ptr CChar, Int) -> IO a) -> IO a
forall a. ByteString -> ((Ptr CChar, Int) -> IO a) -> IO a
ByteString.useAsCStringLen ByteString
bs (Ptr CChar, Int) -> IO a
cback
checkError
:: Database
-> Text
-> CInt
-> IO ()
checkError :: Database -> Text -> CInt -> IO ()
checkError (Database ForeignPtr C'sqlite3
dbFp Text
dbFn) Text
ctx CInt
err = case CInt -> ParseErrorResult
forall a. (Integral a, Show a) => a -> ParseErrorResult
Bindings.parseError CInt
err of
ParseErrorResult
Bindings.ParseErrorOk -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bindings.ParseErrorStep StepResult
_ -> Error -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO (Error -> IO ()) -> Error -> IO ()
forall a b. (a -> b) -> a -> b
$ Error :: Text
-> Either ErrorFlag SqueatherErrorFlag -> Text -> Text -> Error
Error
{ errorContext :: Text
errorContext = Text
ctx
, errorFlag :: Either ErrorFlag SqueatherErrorFlag
errorFlag = SqueatherErrorFlag -> Either ErrorFlag SqueatherErrorFlag
forall a b. b -> Either a b
Right SqueatherErrorFlag
Bug
, errorText :: Text
errorText = Text
"Squeather.checkError: returned StepResult - should never happen"
, errorFilename :: Text
errorFilename = Text
dbFn
}
Bindings.ParseErrorError ErrorFlag
flg -> ForeignPtr C'sqlite3 -> (Ptr C'sqlite3 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr C'sqlite3
dbFp ((Ptr C'sqlite3 -> IO ()) -> IO ())
-> (Ptr C'sqlite3 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr C'sqlite3
db -> do
Ptr CChar
ptrMsg <- Ptr C'sqlite3 -> IO (Ptr CChar)
sqlite3_errmsg Ptr C'sqlite3
db
Text
errMsg <- Ptr CChar -> IO Text
readUtf8 Ptr CChar
ptrMsg
Error -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO (Error -> IO ()) -> Error -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
-> Either ErrorFlag SqueatherErrorFlag -> Text -> Text -> Error
Error Text
ctx (ErrorFlag -> Either ErrorFlag SqueatherErrorFlag
forall a b. a -> Either a b
Left ErrorFlag
flg) Text
errMsg Text
dbFn
ParseErrorResult
Bindings.ParseErrorNotFound -> Error -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO (Error -> IO ()) -> Error -> IO ()
forall a b. (a -> b) -> a -> b
$ Error :: Text
-> Either ErrorFlag SqueatherErrorFlag -> Text -> Text -> Error
Error
{ errorContext :: Text
errorContext = Text
ctx
, errorFlag :: Either ErrorFlag SqueatherErrorFlag
errorFlag = SqueatherErrorFlag -> Either ErrorFlag SqueatherErrorFlag
forall a b. b -> Either a b
Right (SqueatherErrorFlag -> Either ErrorFlag SqueatherErrorFlag)
-> SqueatherErrorFlag -> Either ErrorFlag SqueatherErrorFlag
forall a b. (a -> b) -> a -> b
$ CInt -> SqueatherErrorFlag
UnknownSqliteError CInt
err
, errorText :: Text
errorText = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Squeather.checkError: returned unknown error code " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
err
, errorFilename :: Text
errorFilename = Text
dbFn
}
checkInitError
:: Text
-> CInt
-> IO ()
checkInitError :: Text -> CInt -> IO ()
checkInitError Text
fn CInt
err = case CInt -> ParseErrorResult
forall a. (Integral a, Show a) => a -> ParseErrorResult
Bindings.parseError CInt
err of
ParseErrorResult
Bindings.ParseErrorOk -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bindings.ParseErrorStep StepResult
_ -> Error -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO (Error -> IO ()) -> Error -> IO ()
forall a b. (a -> b) -> a -> b
$ Error :: Text
-> Either ErrorFlag SqueatherErrorFlag -> Text -> Text -> Error
Error
{ errorContext :: Text
errorContext = Text
ctx
, errorFlag :: Either ErrorFlag SqueatherErrorFlag
errorFlag = SqueatherErrorFlag -> Either ErrorFlag SqueatherErrorFlag
forall a b. b -> Either a b
Right SqueatherErrorFlag
Bug
, errorText :: Text
errorText = Text
"Squeather.checkInitError: returned StepResult - should never happen"
, errorFilename :: Text
errorFilename = Text
fn
}
Bindings.ParseErrorError ErrorFlag
res -> Error -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO (Error -> IO ()) -> Error -> IO ()
forall a b. (a -> b) -> a -> b
$ Error :: Text
-> Either ErrorFlag SqueatherErrorFlag -> Text -> Text -> Error
Error
{ errorContext :: Text
errorContext = Text
ctx
, errorFlag :: Either ErrorFlag SqueatherErrorFlag
errorFlag = ErrorFlag -> Either ErrorFlag SqueatherErrorFlag
forall a b. a -> Either a b
Left ErrorFlag
res
, errorText :: Text
errorText = String -> Text
Text.pack
(String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Squeather.checkInitError: returned error code " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ErrorFlag -> String
forall a. Show a => a -> String
show ErrorFlag
res
, errorFilename :: Text
errorFilename = Text
fn
}
ParseErrorResult
Bindings.ParseErrorNotFound -> Error -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO (Error -> IO ()) -> Error -> IO ()
forall a b. (a -> b) -> a -> b
$ Error :: Text
-> Either ErrorFlag SqueatherErrorFlag -> Text -> Text -> Error
Error
{ errorContext :: Text
errorContext = Text
ctx
, errorFlag :: Either ErrorFlag SqueatherErrorFlag
errorFlag = SqueatherErrorFlag -> Either ErrorFlag SqueatherErrorFlag
forall a b. b -> Either a b
Right (SqueatherErrorFlag -> Either ErrorFlag SqueatherErrorFlag)
-> SqueatherErrorFlag -> Either ErrorFlag SqueatherErrorFlag
forall a b. (a -> b) -> a -> b
$ CInt -> SqueatherErrorFlag
UnknownSqliteError CInt
err
, errorText :: Text
errorText = String -> Text
Text.pack
(String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Squeather.checkInitError: returned unknown error code " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
err
, errorFilename :: Text
errorFilename = Text
fn
}
where
ctx :: Text
ctx = Text
"when initializing SQLite library"
checkStepError
:: Database
-> Text
-> CInt
-> IO StepResult
checkStepError :: Database -> Text -> CInt -> IO StepResult
checkStepError (Database ForeignPtr C'sqlite3
dbFp Text
dbName) Text
ctx CInt
err = case CInt -> ParseErrorResult
forall a. (Integral a, Show a) => a -> ParseErrorResult
Bindings.parseError CInt
err of
ParseErrorResult
Bindings.ParseErrorOk -> Error -> IO StepResult
forall e a. Exception e => e -> IO a
Exception.throwIO (Error -> IO StepResult) -> Error -> IO StepResult
forall a b. (a -> b) -> a -> b
$ Error :: Text
-> Either ErrorFlag SqueatherErrorFlag -> Text -> Text -> Error
Error
{ errorContext :: Text
errorContext = Text
ctx
, errorFlag :: Either ErrorFlag SqueatherErrorFlag
errorFlag = SqueatherErrorFlag -> Either ErrorFlag SqueatherErrorFlag
forall a b. b -> Either a b
Right SqueatherErrorFlag
Bug
, errorText :: Text
errorText = Text
"Squeather.checkStepError: returned SQLITE_OK - should never happen"
, errorFilename :: Text
errorFilename = Text
dbName
}
Bindings.ParseErrorStep StepResult
r -> StepResult -> IO StepResult
forall (m :: * -> *) a. Monad m => a -> m a
return StepResult
r
Bindings.ParseErrorError ErrorFlag
flag -> ForeignPtr C'sqlite3
-> (Ptr C'sqlite3 -> IO StepResult) -> IO StepResult
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr C'sqlite3
dbFp ((Ptr C'sqlite3 -> IO StepResult) -> IO StepResult)
-> (Ptr C'sqlite3 -> IO StepResult) -> IO StepResult
forall a b. (a -> b) -> a -> b
$ \Ptr C'sqlite3
db -> do
Ptr CChar
ptrMsg <- Ptr C'sqlite3 -> IO (Ptr CChar)
sqlite3_errmsg Ptr C'sqlite3
db
Text
errMsg <- Ptr CChar -> IO Text
readUtf8 Ptr CChar
ptrMsg
Error -> IO StepResult
forall e a. Exception e => e -> IO a
Exception.throwIO (Error -> IO StepResult) -> Error -> IO StepResult
forall a b. (a -> b) -> a -> b
$ Text
-> Either ErrorFlag SqueatherErrorFlag -> Text -> Text -> Error
Error Text
ctx (ErrorFlag -> Either ErrorFlag SqueatherErrorFlag
forall a b. a -> Either a b
Left ErrorFlag
flag) Text
errMsg Text
dbName
ParseErrorResult
Bindings.ParseErrorNotFound -> Error -> IO StepResult
forall e a. Exception e => e -> IO a
Exception.throwIO (Error -> IO StepResult) -> Error -> IO StepResult
forall a b. (a -> b) -> a -> b
$ Error :: Text
-> Either ErrorFlag SqueatherErrorFlag -> Text -> Text -> Error
Error
{ errorContext :: Text
errorContext = Text
ctx
, errorFlag :: Either ErrorFlag SqueatherErrorFlag
errorFlag = SqueatherErrorFlag -> Either ErrorFlag SqueatherErrorFlag
forall a b. b -> Either a b
Right (SqueatherErrorFlag -> Either ErrorFlag SqueatherErrorFlag)
-> SqueatherErrorFlag -> Either ErrorFlag SqueatherErrorFlag
forall a b. (a -> b) -> a -> b
$ CInt -> SqueatherErrorFlag
UnknownSqliteError CInt
err
, errorText :: Text
errorText = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Squeather.checkStepError: returned unknown error code " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
err
, errorFilename :: Text
errorFilename = Text
dbName
}
open
:: Text
-> IO Database
open :: Text -> IO Database
open = OpenFlags -> Text -> IO Database
openWithFlags OpenFlags
openFlags
openWithFlags
:: OpenFlags
-> Text
-> IO Database
openWithFlags :: OpenFlags -> Text -> IO Database
openWithFlags OpenFlags
flags Text
fn
= Text -> (Ptr CChar -> IO Database) -> IO Database
forall a. Text -> (Ptr CChar -> IO a) -> IO a
writeUtf8 Text
fn ((Ptr CChar -> IO Database) -> IO Database)
-> (Ptr CChar -> IO Database) -> IO Database
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
fnUtf8 ->
(Ptr (Ptr C'sqlite3) -> IO Database) -> IO Database
forall a b. Storable a => (Ptr a -> IO b) -> IO b
Foreign.alloca ((Ptr (Ptr C'sqlite3) -> IO Database) -> IO Database)
-> (Ptr (Ptr C'sqlite3) -> IO Database) -> IO Database
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'sqlite3)
ptrIn ->
Ptr (Ptr C'sqlite3) -> Ptr C'sqlite3 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
Foreign.poke Ptr (Ptr C'sqlite3)
ptrIn Ptr C'sqlite3
forall a. Ptr a
Foreign.nullPtr IO () -> IO Database -> IO Database
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
let acq :: IO CInt
acq = Ptr CChar -> Ptr (Ptr C'sqlite3) -> CInt -> Ptr CChar -> IO CInt
sqlite3_open_v2 Ptr CChar
fnUtf8 Ptr (Ptr C'sqlite3)
ptrIn (OpenFlags -> CInt
Bindings.flagsToInt OpenFlags
flags) Ptr CChar
forall a. Ptr a
Foreign.nullPtr
rel :: p -> IO CInt
rel p
_ = Ptr (Ptr C'sqlite3) -> IO (Ptr C'sqlite3)
forall a. Storable a => Ptr a -> IO a
Foreign.peek Ptr (Ptr C'sqlite3)
ptrIn IO (Ptr C'sqlite3) -> (Ptr C'sqlite3 -> IO CInt) -> IO CInt
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr C'sqlite3 -> IO CInt
sqlite3_close_v2
use :: b -> IO (ForeignPtr C'sqlite3, b)
use b
code = do
Ptr C'sqlite3
sqlite3 <- Ptr (Ptr C'sqlite3) -> IO (Ptr C'sqlite3)
forall a. Storable a => Ptr a -> IO a
Foreign.peek Ptr (Ptr C'sqlite3)
ptrIn
ForeignPtr C'sqlite3
fp <- FinalizerPtr C'sqlite3
-> Ptr C'sqlite3 -> IO (ForeignPtr C'sqlite3)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
Foreign.newForeignPtr FinalizerPtr C'sqlite3
p_squeather_close_v2 Ptr C'sqlite3
sqlite3
(ForeignPtr C'sqlite3, b) -> IO (ForeignPtr C'sqlite3, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr C'sqlite3
fp, b
code)
in do
IO CInt
sqlite3_initialize IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> CInt -> IO ()
checkInitError Text
fn
(ForeignPtr C'sqlite3
fp, CInt
code) <- IO CInt
-> (CInt -> IO CInt)
-> (CInt -> IO (ForeignPtr C'sqlite3, CInt))
-> IO (ForeignPtr C'sqlite3, CInt)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracketOnError IO CInt
acq CInt -> IO CInt
forall p. p -> IO CInt
rel CInt -> IO (ForeignPtr C'sqlite3, CInt)
forall b. b -> IO (ForeignPtr C'sqlite3, b)
use
let db :: Database
db = ForeignPtr C'sqlite3 -> Text -> Database
Database ForeignPtr C'sqlite3
fp Text
fn
Database -> Text -> CInt -> IO ()
checkError Database
db Text
"opening database" CInt
code
ForeignPtr C'sqlite3 -> (Ptr C'sqlite3 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr C'sqlite3
fp ((Ptr C'sqlite3 -> IO ()) -> IO ())
-> (Ptr C'sqlite3 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr C'sqlite3
ptrDb ->
Ptr C'sqlite3 -> Int -> IO CInt
sqlite3_extended_result_codes Ptr C'sqlite3
ptrDb Int
1
IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Database -> Text -> CInt -> IO ()
checkError Database
db Text
"setting extended result codes"
Database -> IO Database
forall (m :: * -> *) a. Monad m => a -> m a
return Database
db
foreign import ccall unsafe "sqlite3_prepare_v2" sqlite3_prepare_v2
:: Ptr C'sqlite3
-> Ptr CChar
-> CInt
-> Ptr (Ptr C'sqlite3_stmt)
-> Ptr (Ptr CChar)
-> IO CInt
prepare
:: Database
-> Text
-> IO Statement
prepare :: Database -> Text -> IO Statement
prepare db :: Database
db@(Database ForeignPtr C'sqlite3
dbFp Text
dbFn) Text
sql
= Text -> ((Ptr CChar, Int) -> IO Statement) -> IO Statement
forall a. Text -> ((Ptr CChar, Int) -> IO a) -> IO a
writeUtf8Len Text
sql (((Ptr CChar, Int) -> IO Statement) -> IO Statement)
-> ((Ptr CChar, Int) -> IO Statement) -> IO Statement
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
sqlUtf8, Int
sqlLen) ->
(Ptr (Ptr C'sqlite3_stmt) -> IO Statement) -> IO Statement
forall a b. Storable a => (Ptr a -> IO b) -> IO b
Foreign.alloca ((Ptr (Ptr C'sqlite3_stmt) -> IO Statement) -> IO Statement)
-> (Ptr (Ptr C'sqlite3_stmt) -> IO Statement) -> IO Statement
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'sqlite3_stmt)
ptrIn ->
ForeignPtr C'sqlite3
-> (Ptr C'sqlite3 -> IO Statement) -> IO Statement
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr C'sqlite3
dbFp ((Ptr C'sqlite3 -> IO Statement) -> IO Statement)
-> (Ptr C'sqlite3 -> IO Statement) -> IO Statement
forall a b. (a -> b) -> a -> b
$ \Ptr C'sqlite3
dbPtr -> do
Ptr (Ptr C'sqlite3_stmt) -> Ptr C'sqlite3_stmt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
Foreign.poke Ptr (Ptr C'sqlite3_stmt)
ptrIn Ptr C'sqlite3_stmt
forall a. Ptr a
Foreign.nullPtr
CInt
sqlLenCInt <- Text -> Text -> Int -> IO CInt
intToCInt Text
sql Text
dbFn Int
sqlLen
let acq :: IO CInt
acq = Ptr C'sqlite3
-> Ptr CChar
-> CInt
-> Ptr (Ptr C'sqlite3_stmt)
-> Ptr (Ptr CChar)
-> IO CInt
sqlite3_prepare_v2 Ptr C'sqlite3
dbPtr Ptr CChar
sqlUtf8 CInt
sqlLenCInt Ptr (Ptr C'sqlite3_stmt)
ptrIn Ptr (Ptr CChar)
forall a. Ptr a
Foreign.nullPtr
rel :: p -> IO CInt
rel p
_ = Ptr (Ptr C'sqlite3_stmt) -> IO (Ptr C'sqlite3_stmt)
forall a. Storable a => Ptr a -> IO a
Foreign.peek Ptr (Ptr C'sqlite3_stmt)
ptrIn IO (Ptr C'sqlite3_stmt)
-> (Ptr C'sqlite3_stmt -> IO CInt) -> IO CInt
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr C'sqlite3_stmt -> IO CInt
sqlite3_finalize
use :: CInt -> IO Statement
use CInt
code = do
Ptr C'sqlite3_stmt
ptrStmt <- Ptr (Ptr C'sqlite3_stmt) -> IO (Ptr C'sqlite3_stmt)
forall a. Storable a => Ptr a -> IO a
Foreign.peek Ptr (Ptr C'sqlite3_stmt)
ptrIn
ForeignPtr C'sqlite3_stmt
fp <- FinalizerPtr C'sqlite3_stmt
-> Ptr C'sqlite3_stmt -> IO (ForeignPtr C'sqlite3_stmt)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
Foreign.newForeignPtr FinalizerPtr C'sqlite3_stmt
p_squeather_finalize Ptr C'sqlite3_stmt
ptrStmt
Database -> Text -> CInt -> IO ()
checkError Database
db Text
sql CInt
code
Statement -> IO Statement
forall (m :: * -> *) a. Monad m => a -> m a
return (Statement -> IO Statement) -> Statement -> IO Statement
forall a b. (a -> b) -> a -> b
$ ForeignPtr C'sqlite3_stmt -> Text -> Database -> Statement
Statement ForeignPtr C'sqlite3_stmt
fp Text
sql Database
db
IO CInt
-> (CInt -> IO CInt) -> (CInt -> IO Statement) -> IO Statement
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracketOnError IO CInt
acq CInt -> IO CInt
forall p. p -> IO CInt
rel CInt -> IO Statement
use
foreign import ccall unsafe "sqlite3_bind_parameter_index" sqlite3_bind_parameter_index
:: Ptr C'sqlite3_stmt
-> Ptr CChar
-> IO CInt
getParameterIndex
:: Statement
-> Text
-> IO CInt
getParameterIndex :: Statement -> Text -> IO CInt
getParameterIndex (Statement ForeignPtr C'sqlite3_stmt
stFp Text
stSql (Database ForeignPtr C'sqlite3
_ Text
dbFn)) Text
param
= Text -> (Ptr CChar -> IO CInt) -> IO CInt
forall a. Text -> (Ptr CChar -> IO a) -> IO a
writeUtf8 Text
param ((Ptr CChar -> IO CInt) -> IO CInt)
-> (Ptr CChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
paramUtf8 ->
ForeignPtr C'sqlite3_stmt
-> (Ptr C'sqlite3_stmt -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr C'sqlite3_stmt
stFp ((Ptr C'sqlite3_stmt -> IO CInt) -> IO CInt)
-> (Ptr C'sqlite3_stmt -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr C'sqlite3_stmt
stPtr -> do
CInt
idx <- Ptr C'sqlite3_stmt -> Ptr CChar -> IO CInt
sqlite3_bind_parameter_index Ptr C'sqlite3_stmt
stPtr Ptr CChar
paramUtf8
if CInt
idx CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
then Error -> IO CInt
forall e a. Exception e => e -> IO a
throwIO (Error -> IO CInt) -> Error -> IO CInt
forall a b. (a -> b) -> a -> b
$ Text
-> Either ErrorFlag SqueatherErrorFlag -> Text -> Text -> Error
Error Text
stSql (SqueatherErrorFlag -> Either ErrorFlag SqueatherErrorFlag
forall a b. b -> Either a b
Right SqueatherErrorFlag
ParameterNotFound)
(Text
"parameter not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
param) Text
dbFn
else CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
idx
foreign import ccall safe "sqlite3_bind_blob" sqlite3_bind_blob
:: Ptr C'sqlite3_stmt
-> CInt
-> Ptr a
-> CInt
-> FunPtr (Ptr a -> IO ())
-> IO CInt
bindBlob
:: Statement
-> Text
-> ByteString
-> IO ()
bindBlob :: Statement -> Text -> ByteString -> IO ()
bindBlob st :: Statement
st@(Statement ForeignPtr C'sqlite3_stmt
stFp Text
sSql Database
db) Text
paramName ByteString
blob
= ByteString -> ((Ptr CChar, Int) -> IO ()) -> IO ()
forall a. ByteString -> ((Ptr CChar, Int) -> IO a) -> IO a
ByteString.useAsCStringLen ByteString
blob (((Ptr CChar, Int) -> IO ()) -> IO ())
-> ((Ptr CChar, Int) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ptrBlob, Int
blobLen) ->
ForeignPtr C'sqlite3_stmt -> (Ptr C'sqlite3_stmt -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr C'sqlite3_stmt
stFp ((Ptr C'sqlite3_stmt -> IO ()) -> IO ())
-> (Ptr C'sqlite3_stmt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr C'sqlite3_stmt
sPtr -> do
CInt
idx <- Statement -> Text -> IO CInt
getParameterIndex Statement
st Text
paramName
let transient :: FunPtr b
transient = Ptr Any -> FunPtr b
forall a b. Ptr a -> FunPtr b
Foreign.castPtrToFunPtr (Ptr Any -> FunPtr b) -> (IntPtr -> Ptr Any) -> IntPtr -> FunPtr b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntPtr -> Ptr Any
forall a. IntPtr -> Ptr a
Foreign.intPtrToPtr
(IntPtr -> FunPtr b) -> IntPtr -> FunPtr b
forall a b. (a -> b) -> a -> b
$ IntPtr
forall a. Integral a => a
Bindings.c'SQLITE_TRANSIENT
CInt
blobLenCInt <- Text -> Text -> Int -> IO CInt
intToCInt Text
sSql (Database -> Text
dbFilename Database
db) Int
blobLen
CInt
rslt <- Ptr C'sqlite3_stmt
-> CInt
-> Ptr CChar
-> CInt
-> FunPtr (Ptr CChar -> IO ())
-> IO CInt
forall a.
Ptr C'sqlite3_stmt
-> CInt -> Ptr a -> CInt -> FunPtr (Ptr a -> IO ()) -> IO CInt
sqlite3_bind_blob Ptr C'sqlite3_stmt
sPtr CInt
idx Ptr CChar
ptrBlob CInt
blobLenCInt FunPtr (Ptr CChar -> IO ())
forall b. FunPtr b
transient
Database -> Text -> CInt -> IO ()
checkError Database
db Text
sSql CInt
rslt
foreign import ccall unsafe "sqlite3_bind_double" sqlite3_bind_double
:: Ptr C'sqlite3_stmt
-> CInt
-> Double
-> IO CInt
bindDouble
:: Statement
-> Text
-> Double
-> IO ()
bindDouble :: Statement -> Text -> Double -> IO ()
bindDouble st :: Statement
st@(Statement ForeignPtr C'sqlite3_stmt
stFp Text
sSql Database
db) Text
paramName Double
dbl =
ForeignPtr C'sqlite3_stmt -> (Ptr C'sqlite3_stmt -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr C'sqlite3_stmt
stFp ((Ptr C'sqlite3_stmt -> IO ()) -> IO ())
-> (Ptr C'sqlite3_stmt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr C'sqlite3_stmt
sPtr -> do
CInt
idx <- Statement -> Text -> IO CInt
getParameterIndex Statement
st Text
paramName
CInt
rslt <- Ptr C'sqlite3_stmt -> CInt -> Double -> IO CInt
sqlite3_bind_double Ptr C'sqlite3_stmt
sPtr CInt
idx Double
dbl
Database -> Text -> CInt -> IO ()
checkError Database
db Text
sSql CInt
rslt
foreign import ccall unsafe "sqlite3_bind_int64" sqlite3_bind_int64
:: Ptr C'sqlite3_stmt
-> CInt
-> Int64
-> IO CInt
bindInt64
:: Statement
-> Text
-> Int64
-> IO ()
bindInt64 :: Statement -> Text -> Int64 -> IO ()
bindInt64 st :: Statement
st@(Statement ForeignPtr C'sqlite3_stmt
stFp Text
sSql Database
db) Text
paramName Int64
int64 =
ForeignPtr C'sqlite3_stmt -> (Ptr C'sqlite3_stmt -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr C'sqlite3_stmt
stFp ((Ptr C'sqlite3_stmt -> IO ()) -> IO ())
-> (Ptr C'sqlite3_stmt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr C'sqlite3_stmt
sPtr -> do
CInt
idx <- Statement -> Text -> IO CInt
getParameterIndex Statement
st Text
paramName
CInt
rslt <- Ptr C'sqlite3_stmt -> CInt -> Int64 -> IO CInt
sqlite3_bind_int64 Ptr C'sqlite3_stmt
sPtr CInt
idx Int64
int64
Database -> Text -> CInt -> IO ()
checkError Database
db Text
sSql CInt
rslt
foreign import ccall unsafe "sqlite3_bind_null" sqlite3_bind_null
:: Ptr C'sqlite3_stmt
-> CInt
-> IO CInt
bindNull
:: Statement
-> Text
-> IO ()
bindNull :: Statement -> Text -> IO ()
bindNull st :: Statement
st@(Statement ForeignPtr C'sqlite3_stmt
stFp Text
sSql Database
db) Text
paramName =
ForeignPtr C'sqlite3_stmt -> (Ptr C'sqlite3_stmt -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr C'sqlite3_stmt
stFp ((Ptr C'sqlite3_stmt -> IO ()) -> IO ())
-> (Ptr C'sqlite3_stmt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr C'sqlite3_stmt
sPtr -> do
CInt
idx <- Statement -> Text -> IO CInt
getParameterIndex Statement
st Text
paramName
CInt
rslt <- Ptr C'sqlite3_stmt -> CInt -> IO CInt
sqlite3_bind_null Ptr C'sqlite3_stmt
sPtr CInt
idx
Database -> Text -> CInt -> IO ()
checkError Database
db Text
sSql CInt
rslt
foreign import ccall unsafe "sqlite3_bind_text" sqlite3_bind_text
:: Ptr C'sqlite3_stmt
-> CInt
-> Ptr CChar
-> CInt
-> FunPtr (Ptr a -> IO ())
-> IO CInt
bindText
:: Statement
-> Text
-> Text
-> IO ()
bindText :: Statement -> Text -> Text -> IO ()
bindText st :: Statement
st@(Statement ForeignPtr C'sqlite3_stmt
stFp Text
sSql Database
db) Text
paramName Text
txt
= Text -> ((Ptr CChar, Int) -> IO ()) -> IO ()
forall a. Text -> ((Ptr CChar, Int) -> IO a) -> IO a
writeUtf8Len Text
txt (((Ptr CChar, Int) -> IO ()) -> IO ())
-> ((Ptr CChar, Int) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ptrTxt, Int
txtLen) ->
ForeignPtr C'sqlite3_stmt -> (Ptr C'sqlite3_stmt -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr C'sqlite3_stmt
stFp ((Ptr C'sqlite3_stmt -> IO ()) -> IO ())
-> (Ptr C'sqlite3_stmt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr C'sqlite3_stmt
sPtr -> do
CInt
idx <- Statement -> Text -> IO CInt
getParameterIndex Statement
st Text
paramName
let transient :: FunPtr b
transient = Ptr Any -> FunPtr b
forall a b. Ptr a -> FunPtr b
Foreign.castPtrToFunPtr (Ptr Any -> FunPtr b) -> (IntPtr -> Ptr Any) -> IntPtr -> FunPtr b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntPtr -> Ptr Any
forall a. IntPtr -> Ptr a
Foreign.intPtrToPtr
(IntPtr -> FunPtr b) -> IntPtr -> FunPtr b
forall a b. (a -> b) -> a -> b
$ IntPtr
forall a. Integral a => a
Bindings.c'SQLITE_TRANSIENT
CInt
txtLenCInt <- Text -> Text -> Int -> IO CInt
intToCInt Text
sSql (Database -> Text
dbFilename Database
db) Int
txtLen
CInt
rslt <- Ptr C'sqlite3_stmt
-> CInt
-> Ptr CChar
-> CInt
-> FunPtr (Ptr Any -> IO ())
-> IO CInt
forall a.
Ptr C'sqlite3_stmt
-> CInt -> Ptr CChar -> CInt -> FunPtr (Ptr a -> IO ()) -> IO CInt
sqlite3_bind_text Ptr C'sqlite3_stmt
sPtr CInt
idx Ptr CChar
ptrTxt CInt
txtLenCInt FunPtr (Ptr Any -> IO ())
forall b. FunPtr b
transient
Database -> Text -> CInt -> IO ()
checkError Database
db Text
sSql CInt
rslt
bindSqlData
:: Statement
-> Text
-> SQLData
-> IO ()
bindSqlData :: Statement -> Text -> SQLData -> IO ()
bindSqlData Statement
st Text
name SQLData
sqld = case SQLData
sqld of
SQLData
SQLNull -> Statement -> Text -> IO ()
bindNull Statement
st Text
name
SQLText Text
txt -> Statement -> Text -> Text -> IO ()
bindText Statement
st Text
name Text
txt
SQLFloat Double
dbl -> Statement -> Text -> Double -> IO ()
bindDouble Statement
st Text
name Double
dbl
SQLInteger Int64
i64 -> Statement -> Text -> Int64 -> IO ()
bindInt64 Statement
st Text
name Int64
i64
SQLBlob ByteString
blob -> Statement -> Text -> ByteString -> IO ()
bindBlob Statement
st Text
name ByteString
blob
foreign import ccall unsafe "sqlite3_step" sqlite3_step
:: Ptr C'sqlite3_stmt
-> IO CInt
step :: Statement -> IO StepResult
step :: Statement -> IO StepResult
step (Statement ForeignPtr C'sqlite3_stmt
stFp Text
sSql Database
db) =
ForeignPtr C'sqlite3_stmt
-> (Ptr C'sqlite3_stmt -> IO StepResult) -> IO StepResult
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr C'sqlite3_stmt
stFp ((Ptr C'sqlite3_stmt -> IO StepResult) -> IO StepResult)
-> (Ptr C'sqlite3_stmt -> IO StepResult) -> IO StepResult
forall a b. (a -> b) -> a -> b
$ \Ptr C'sqlite3_stmt
sPtr -> do
CInt
rslt <- Ptr C'sqlite3_stmt -> IO CInt
sqlite3_step Ptr C'sqlite3_stmt
sPtr
Database -> Text -> CInt -> IO StepResult
checkStepError Database
db Text
sSql CInt
rslt
foreign import ccall unsafe "sqlite3_column_count" sqlite3_column_count
:: Ptr C'sqlite3_stmt
-> IO CInt
foreign import ccall unsafe "sqlite3_column_bytes" sqlite3_column_bytes
:: Ptr C'sqlite3_stmt
-> CInt
-> IO CInt
foreign import ccall unsafe "sqlite3_column_type" sqlite3_column_type
:: Ptr C'sqlite3_stmt
-> CInt
-> IO CInt
foreign import ccall unsafe "sqlite3_column_blob" sqlite3_column_blob
:: Ptr C'sqlite3_stmt
-> CInt
-> IO (Ptr a)
foreign import ccall unsafe "sqlite3_column_double" sqlite3_column_double
:: Ptr C'sqlite3_stmt
-> CInt
-> IO Double
foreign import ccall unsafe "sqlite3_column_int64" sqlite3_column_int64
:: Ptr C'sqlite3_stmt
-> CInt
-> IO Int64
foreign import ccall unsafe "sqlite3_column_text" sqlite3_column_text
:: Ptr C'sqlite3_stmt
-> CInt
-> IO (Ptr CUChar)
column
:: Statement
-> Int
-> IO SQLData
column :: Statement -> Int -> IO SQLData
column (Statement ForeignPtr C'sqlite3_stmt
stFp Text
sSql Database
db) Int
intIdx =
ForeignPtr C'sqlite3_stmt
-> (Ptr C'sqlite3_stmt -> IO SQLData) -> IO SQLData
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr C'sqlite3_stmt
stFp ((Ptr C'sqlite3_stmt -> IO SQLData) -> IO SQLData)
-> (Ptr C'sqlite3_stmt -> IO SQLData) -> IO SQLData
forall a b. (a -> b) -> a -> b
$ \Ptr C'sqlite3_stmt
stPtr -> do
CInt
idx <- Text -> Text -> Int -> IO CInt
intToCInt Text
sSql (Database -> Text
dbFilename Database
db) Int
intIdx
CInt
colTypeNum <- Ptr C'sqlite3_stmt -> CInt -> IO CInt
sqlite3_column_type Ptr C'sqlite3_stmt
stPtr CInt
idx
SQLData
colType <- case CInt -> Maybe SQLData
forall a. Integral a => a -> Maybe SQLData
Bindings.convertCColumnType CInt
colTypeNum of
Just SQLData
n -> SQLData -> IO SQLData
forall (m :: * -> *) a. Monad m => a -> m a
return SQLData
n
Maybe SQLData
Nothing -> Error -> IO SQLData
forall e a. Exception e => e -> IO a
Exception.throwIO (Error -> IO SQLData) -> Error -> IO SQLData
forall a b. (a -> b) -> a -> b
$ Error :: Text
-> Either ErrorFlag SqueatherErrorFlag -> Text -> Text -> Error
Error
{ errorContext :: Text
errorContext = Text
sSql
, errorFlag :: Either ErrorFlag SqueatherErrorFlag
errorFlag = SqueatherErrorFlag -> Either ErrorFlag SqueatherErrorFlag
forall a b. b -> Either a b
Right (SqueatherErrorFlag -> Either ErrorFlag SqueatherErrorFlag)
-> SqueatherErrorFlag -> Either ErrorFlag SqueatherErrorFlag
forall a b. (a -> b) -> a -> b
$ CInt -> SqueatherErrorFlag
UnknownColumnType CInt
colTypeNum
, errorText :: Text
errorText = Text
"Unknown column type found"
, errorFilename :: Text
errorFilename = Database -> Text
dbFilename Database
db
}
case SQLData
colType of
SQLData
SQLNull -> SQLData -> IO SQLData
forall (m :: * -> *) a. Monad m => a -> m a
return SQLData
SQLNull
SQLFloat Double
_ -> (Double -> SQLData) -> IO Double -> IO SQLData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> SQLData
SQLFloat (IO Double -> IO SQLData) -> IO Double -> IO SQLData
forall a b. (a -> b) -> a -> b
$ Ptr C'sqlite3_stmt -> CInt -> IO Double
sqlite3_column_double Ptr C'sqlite3_stmt
stPtr CInt
idx
SQLBlob ByteString
_ -> do
Ptr CChar
resPtr <- Ptr C'sqlite3_stmt -> CInt -> IO (Ptr CChar)
forall a. Ptr C'sqlite3_stmt -> CInt -> IO (Ptr a)
sqlite3_column_blob Ptr C'sqlite3_stmt
stPtr CInt
idx
CInt
resLen <- Ptr C'sqlite3_stmt -> CInt -> IO CInt
sqlite3_column_bytes Ptr C'sqlite3_stmt
stPtr CInt
idx
Int
resLenInt <- Text -> Text -> CInt -> IO Int
intFromCInt Text
sSql (Database -> Text
dbFilename Database
db) CInt
resLen
ByteString
bs <- (Ptr CChar, Int) -> IO ByteString
ByteString.packCStringLen (Ptr CChar
resPtr, Int
resLenInt)
SQLData -> IO SQLData
forall (m :: * -> *) a. Monad m => a -> m a
return (SQLData -> IO SQLData) -> SQLData -> IO SQLData
forall a b. (a -> b) -> a -> b
$ ByteString -> SQLData
SQLBlob ByteString
bs
SQLInteger Int64
_ -> (Int64 -> SQLData) -> IO Int64 -> IO SQLData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> SQLData
SQLInteger (IO Int64 -> IO SQLData) -> IO Int64 -> IO SQLData
forall a b. (a -> b) -> a -> b
$ Ptr C'sqlite3_stmt -> CInt -> IO Int64
sqlite3_column_int64 Ptr C'sqlite3_stmt
stPtr CInt
idx
SQLText Text
_ -> do
Ptr CUChar
resPtr <- Ptr C'sqlite3_stmt -> CInt -> IO (Ptr CUChar)
sqlite3_column_text Ptr C'sqlite3_stmt
stPtr CInt
idx
CInt
resLen <- Ptr C'sqlite3_stmt -> CInt -> IO CInt
sqlite3_column_bytes Ptr C'sqlite3_stmt
stPtr CInt
idx
Int
resLenInt <- Text -> Text -> CInt -> IO Int
intFromCInt Text
sSql (Database -> Text
dbFilename Database
db) CInt
resLen
ByteString
bs <- (Ptr CChar, Int) -> IO ByteString
ByteString.packCStringLen (Ptr CUChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr CUChar
resPtr, Int
resLenInt)
SQLData -> IO SQLData
forall (m :: * -> *) a. Monad m => a -> m a
return (SQLData -> IO SQLData)
-> (ByteString -> SQLData) -> ByteString -> IO SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SQLData
SQLText (Text -> SQLData) -> (ByteString -> Text) -> ByteString -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Encoding.decodeUtf8 (ByteString -> IO SQLData) -> ByteString -> IO SQLData
forall a b. (a -> b) -> a -> b
$ ByteString
bs
columnCount :: Statement -> IO Int
columnCount :: Statement -> IO Int
columnCount (Statement ForeignPtr C'sqlite3_stmt
stFp Text
sSql Database
db)
= ForeignPtr C'sqlite3_stmt
-> (Ptr C'sqlite3_stmt -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr C'sqlite3_stmt
stFp ((Ptr C'sqlite3_stmt -> IO Int) -> IO Int)
-> (Ptr C'sqlite3_stmt -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr C'sqlite3_stmt
stPtr ->
Ptr C'sqlite3_stmt -> IO CInt
sqlite3_column_count Ptr C'sqlite3_stmt
stPtr IO CInt -> (CInt -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Text -> CInt -> IO Int
intFromCInt Text
sSql (Database -> Text
dbFilename Database
db)
columns :: Statement -> IO [SQLData]
columns :: Statement -> IO [SQLData]
columns Statement
st = do
Int
nCols <- Statement -> IO Int
columnCount Statement
st
(Int -> IO SQLData) -> [Int] -> IO [SQLData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Statement -> Int -> IO SQLData
column Statement
st) [Int
0 .. Int
nCols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
allRows :: Statement -> IO [[SQLData]]
allRows :: Statement -> IO [[SQLData]]
allRows Statement
st = do
StepResult
r <- Statement -> IO StepResult
step Statement
st
case StepResult
r of
StepResult
Types.Done -> [[SQLData]] -> IO [[SQLData]]
forall (m :: * -> *) a. Monad m => a -> m a
return []
StepResult
Types.Row -> do
[SQLData]
cols <- Statement -> IO [SQLData]
columns Statement
st
[[SQLData]]
rest <- Statement -> IO [[SQLData]]
allRows Statement
st
[[SQLData]] -> IO [[SQLData]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[SQLData]] -> IO [[SQLData]]) -> [[SQLData]] -> IO [[SQLData]]
forall a b. (a -> b) -> a -> b
$ [SQLData]
cols [SQLData] -> [[SQLData]] -> [[SQLData]]
forall a. a -> [a] -> [a]
: [[SQLData]]
rest
bindParams
:: Statement
-> [(Text, SQLData)]
-> IO ()
bindParams :: Statement -> [(Text, SQLData)] -> IO ()
bindParams Statement
st = ((Text, SQLData) -> IO ()) -> [(Text, SQLData)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Text -> SQLData -> IO ()) -> (Text, SQLData) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Statement -> Text -> SQLData -> IO ()
bindSqlData Statement
st))
execute
:: Database
-> Text
-> IO [[SQLData]]
execute :: Database -> Text -> IO [[SQLData]]
execute Database
db Text
sql = Database -> Text -> IO Statement
prepare Database
db Text
sql IO Statement -> (Statement -> IO [[SQLData]]) -> IO [[SQLData]]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Statement -> IO [[SQLData]]
allRows
executeNamed
:: Database
-> Text
-> [(Text, SQLData)]
-> IO [[SQLData]]
executeNamed :: Database -> Text -> [(Text, SQLData)] -> IO [[SQLData]]
executeNamed Database
db Text
sql [(Text, SQLData)]
params = Database -> Text -> IO Statement
prepare Database
db Text
sql IO Statement -> (Statement -> IO [[SQLData]]) -> IO [[SQLData]]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Statement -> IO [[SQLData]]
use
where
use :: Statement -> IO [[SQLData]]
use Statement
stmt = do
Statement -> [(Text, SQLData)] -> IO ()
bindParams Statement
stmt [(Text, SQLData)]
params
Statement -> IO [[SQLData]]
allRows Statement
stmt
executeNamedWithColumns
:: Database
-> Text
-> [(Text, SQLData)]
-> IO ([Text], [[SQLData]])
executeNamedWithColumns :: Database -> Text -> [(Text, SQLData)] -> IO ([Text], [[SQLData]])
executeNamedWithColumns Database
db Text
sql [(Text, SQLData)]
params = Database -> Text -> IO Statement
prepare Database
db Text
sql IO Statement
-> (Statement -> IO ([Text], [[SQLData]]))
-> IO ([Text], [[SQLData]])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Statement -> IO ([Text], [[SQLData]])
use
where
use :: Statement -> IO ([Text], [[SQLData]])
use Statement
stmt = do
Statement -> [(Text, SQLData)] -> IO ()
bindParams Statement
stmt [(Text, SQLData)]
params
[[SQLData]]
rows <- Statement -> IO [[SQLData]]
allRows Statement
stmt
[Text]
names <- Statement -> IO [Text]
columnNames Statement
stmt
([Text], [[SQLData]]) -> IO ([Text], [[SQLData]])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text]
names, [[SQLData]]
rows)
foreign import ccall unsafe "sqlite3_reset" sqlite3_reset
:: Ptr C'sqlite3_stmt
-> IO CInt
reset :: Statement -> IO ()
reset :: Statement -> IO ()
reset (Statement ForeignPtr C'sqlite3_stmt
stFp Text
_ Database
_) = ForeignPtr C'sqlite3_stmt -> (Ptr C'sqlite3_stmt -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr C'sqlite3_stmt
stFp ((Ptr C'sqlite3_stmt -> IO ()) -> IO ())
-> (Ptr C'sqlite3_stmt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr C'sqlite3_stmt
stPtr ->
Ptr C'sqlite3_stmt -> IO CInt
sqlite3_reset Ptr C'sqlite3_stmt
stPtr IO CInt -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
foreign import ccall unsafe "sqlite3_clear_bindings" sqlite3_clear_bindings
:: Ptr C'sqlite3_stmt
-> IO CInt
clearBindings :: Statement -> IO ()
clearBindings :: Statement -> IO ()
clearBindings (Statement ForeignPtr C'sqlite3_stmt
stFp Text
_ Database
db)
= ForeignPtr C'sqlite3_stmt -> (Ptr C'sqlite3_stmt -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr C'sqlite3_stmt
stFp ((Ptr C'sqlite3_stmt -> IO ()) -> IO ())
-> (Ptr C'sqlite3_stmt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr C'sqlite3_stmt
stPtr ->
Ptr C'sqlite3_stmt -> IO CInt
sqlite3_clear_bindings Ptr C'sqlite3_stmt
stPtr IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Database -> Text -> CInt -> IO ()
checkError Database
db Text
"clearing bindings"
foreign import ccall unsafe "sqlite3_finalize" sqlite3_finalize
:: Ptr C'sqlite3_stmt
-> IO CInt
foreign import ccall unsafe "&squeather_finalize" p_squeather_finalize
:: FunPtr (Ptr C'sqlite3_stmt -> IO ())
foreign import ccall unsafe "sqlite3_close_v2" sqlite3_close_v2
:: Ptr C'sqlite3
-> IO CInt
foreign import ccall unsafe "&squeather_close_v2" p_squeather_close_v2
:: FunPtr (Ptr C'sqlite3 -> IO ())
type ExecCallback a
= Ptr a
-> CInt
-> Ptr (Ptr CChar)
-> Ptr (Ptr CChar)
-> IO CInt
foreign import ccall "sqlite3_exec" sqlite3_exec
:: Ptr C'sqlite3
-> Ptr CChar
-> FunPtr (ExecCallback a)
-> Ptr a
-> Ptr (Ptr CChar)
-> IO CInt
foreign import ccall unsafe "sqlite3_free" sqlite3_free
:: Ptr a
-> IO ()
exec
:: Database
-> Text
-> IO ()
exec :: Database -> Text -> IO ()
exec db :: Database
db@(Database ForeignPtr C'sqlite3
dbFp Text
dbFn) Text
sqlTxt =
Text -> (Ptr CChar -> IO ()) -> IO ()
forall a. Text -> (Ptr CChar -> IO a) -> IO a
writeUtf8 Text
sqlTxt ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
ptrSql ->
ForeignPtr C'sqlite3 -> (Ptr C'sqlite3 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr C'sqlite3
dbFp ((Ptr C'sqlite3 -> IO ()) -> IO ())
-> (Ptr C'sqlite3 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr C'sqlite3
dbPtr ->
(Ptr (Ptr CChar) -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
Foreign.alloca ((Ptr (Ptr CChar) -> IO ()) -> IO ())
-> (Ptr (Ptr CChar) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
strErr -> do
Ptr (Ptr CChar) -> Ptr CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
Foreign.poke Ptr (Ptr CChar)
strErr Ptr CChar
forall a. Ptr a
Foreign.nullPtr
let cleanup :: IO ()
cleanup = Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
Foreign.peek Ptr (Ptr CChar)
strErr IO (Ptr CChar) -> (Ptr CChar -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
sqlite3_free
runExec :: IO ()
runExec = do
CInt
code <- Ptr C'sqlite3
-> Ptr CChar
-> FunPtr (ExecCallback Any)
-> Ptr Any
-> Ptr (Ptr CChar)
-> IO CInt
forall a.
Ptr C'sqlite3
-> Ptr CChar
-> FunPtr (ExecCallback a)
-> Ptr a
-> Ptr (Ptr CChar)
-> IO CInt
sqlite3_exec Ptr C'sqlite3
dbPtr Ptr CChar
ptrSql FunPtr (ExecCallback Any)
forall b. FunPtr b
Foreign.nullFunPtr Ptr Any
forall a. Ptr a
Foreign.nullPtr Ptr (Ptr CChar)
strErr
Ptr CChar
errVal <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
Foreign.peek Ptr (Ptr CChar)
strErr
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr CChar
errVal Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr CChar
forall a. Ptr a
Foreign.nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Text
errTxt <- Ptr CChar -> IO Text
readUtf8 Ptr CChar
errVal
Error -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO (Error -> IO ()) -> Error -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
-> Either ErrorFlag SqueatherErrorFlag -> Text -> Text -> Error
Error Text
sqlTxt (SqueatherErrorFlag -> Either ErrorFlag SqueatherErrorFlag
forall a b. b -> Either a b
Right SqueatherErrorFlag
ExecFailed) Text
errTxt Text
dbFn
Database -> Text -> CInt -> IO ()
checkError Database
db Text
sqlTxt CInt
code
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
Exception.finally IO ()
runExec IO ()
cleanup
foreign import ccall unsafe "sqlite3_last_insert_rowid" sqlite3_last_insert_rowid
:: Ptr C'sqlite3
-> IO Int64
lastInsertRowId :: Database -> IO Int64
lastInsertRowId :: Database -> IO Int64
lastInsertRowId (Database ForeignPtr C'sqlite3
dbFp Text
_) =
ForeignPtr C'sqlite3 -> (Ptr C'sqlite3 -> IO Int64) -> IO Int64
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr C'sqlite3
dbFp Ptr C'sqlite3 -> IO Int64
sqlite3_last_insert_rowid
intToCInt
:: Text
-> Text
-> Int
-> IO CInt
intToCInt :: Text -> Text -> Int -> IO CInt
intToCInt Text
ctx Text
fn Int
i
| Integer
iConv Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> CInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt
forall a. Bounded a => a
maxBound :: CInt)
= Text -> IO CInt
forall a. Text -> IO a
throw (Text -> IO CInt) -> (String -> Text) -> String -> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> IO CInt) -> String -> IO CInt
forall a b. (a -> b) -> a -> b
$ String
"number too big to convert to CInt: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
| Integer
iConv Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< CInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt
forall a. Bounded a => a
minBound :: CInt)
= Text -> IO CInt
forall a. Text -> IO a
throw (Text -> IO CInt) -> (String -> Text) -> String -> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> IO CInt) -> String -> IO CInt
forall a b. (a -> b) -> a -> b
$ String
"number too small to convert to CInt: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
| Bool
otherwise = CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> IO CInt) -> CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
where
iConv :: Integer
iConv = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i :: Integer
throw :: Text -> IO a
throw Text
str = Error -> IO a
forall e a. Exception e => e -> IO a
Exception.throwIO Error
exc
where
exc :: Error
exc = Error :: Text
-> Either ErrorFlag SqueatherErrorFlag -> Text -> Text -> Error
Error { errorContext :: Text
errorContext = Text
ctx
, errorFlag :: Either ErrorFlag SqueatherErrorFlag
errorFlag = SqueatherErrorFlag -> Either ErrorFlag SqueatherErrorFlag
forall a b. b -> Either a b
Right SqueatherErrorFlag
IntConversion
, errorText :: Text
errorText = Text
str
, errorFilename :: Text
errorFilename = Text
fn
}
intFromCInt
:: Text
-> Text
-> CInt
-> IO Int
intFromCInt :: Text -> Text -> CInt -> IO Int
intFromCInt Text
ctx Text
fn CInt
i
| Integer
iConv Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int)
= Text -> IO Int
forall a. Text -> IO a
throw (Text -> IO Int) -> (String -> Text) -> String -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> IO Int) -> String -> IO Int
forall a b. (a -> b) -> a -> b
$ String
"number too big to convert to Int: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
i
| Integer
iConv Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
minBound :: Int)
= Text -> IO Int
forall a. Text -> IO a
throw (Text -> IO Int) -> (String -> Text) -> String -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> IO Int) -> String -> IO Int
forall a b. (a -> b) -> a -> b
$ String
"number too small to convert to Int: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
i
| Bool
otherwise = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
i
where
iConv :: Integer
iConv = CInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
i :: Integer
throw :: Text -> IO a
throw Text
str = Error -> IO a
forall e a. Exception e => e -> IO a
Exception.throwIO Error
exc
where
exc :: Error
exc = Error :: Text
-> Either ErrorFlag SqueatherErrorFlag -> Text -> Text -> Error
Error { errorContext :: Text
errorContext = Text
ctx
, errorFlag :: Either ErrorFlag SqueatherErrorFlag
errorFlag = SqueatherErrorFlag -> Either ErrorFlag SqueatherErrorFlag
forall a b. b -> Either a b
Right SqueatherErrorFlag
IntConversion
, errorText :: Text
errorText = Text
str
, errorFilename :: Text
errorFilename = Text
fn
}
sqliteVersion :: String
sqliteVersion :: String
sqliteVersion = String
Bindings.c'SQLITE_VERSION
openFlags :: OpenFlags
openFlags :: OpenFlags
openFlags = OpenFlags :: WriteMode
-> Bool -> Bool -> ThreadMode -> CacheMode -> Bool -> OpenFlags
Types.OpenFlags
{ writeMode :: WriteMode
Types.writeMode = Create -> WriteMode
Types.ReadWrite Create
Types.Create
, uri :: Bool
Types.uri = Bool
False
, memory :: Bool
Types.memory = Bool
False
, threadMode :: ThreadMode
Types.threadMode = ThreadMode
Types.Serialized
, cacheMode :: CacheMode
Types.cacheMode = CacheMode
Types.Private
, noFollow :: Bool
Types.noFollow = Bool
False
}
data C'sqlite3_backup
foreign import ccall unsafe "sqlite3_backup_init" sqlite3_backup_init
:: Ptr C'sqlite3
-> Ptr CChar
-> Ptr C'sqlite3
-> Ptr CChar
-> IO (Ptr C'sqlite3_backup)
foreign import ccall unsafe "sqlite3_backup_step" sqlite3_backup_step
:: Ptr C'sqlite3_backup
-> CInt
-> IO CInt
foreign import ccall unsafe "sqlite3_backup_finish" sqlite3_backup_finish
:: Ptr C'sqlite3_backup
-> IO CInt
foreign import ccall unsafe "sqlite3_backup_remaining" sqlite3_backup_remaining
:: Ptr C'sqlite3_backup
-> IO CInt
foreign import ccall unsafe "sqlite3_backup_pagecount" sqlite3_backup_pagecount
:: Ptr C'sqlite3_backup
-> IO CInt
data Source = Source
{ Source -> Database
sourceConnection :: Database
, Source -> Text
sourceName :: Text
} deriving (Source -> Source -> Bool
(Source -> Source -> Bool)
-> (Source -> Source -> Bool) -> Eq Source
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Source -> Source -> Bool
$c/= :: Source -> Source -> Bool
== :: Source -> Source -> Bool
$c== :: Source -> Source -> Bool
Eq, Eq Source
Eq Source
-> (Source -> Source -> Ordering)
-> (Source -> Source -> Bool)
-> (Source -> Source -> Bool)
-> (Source -> Source -> Bool)
-> (Source -> Source -> Bool)
-> (Source -> Source -> Source)
-> (Source -> Source -> Source)
-> Ord Source
Source -> Source -> Bool
Source -> Source -> Ordering
Source -> Source -> Source
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Source -> Source -> Source
$cmin :: Source -> Source -> Source
max :: Source -> Source -> Source
$cmax :: Source -> Source -> Source
>= :: Source -> Source -> Bool
$c>= :: Source -> Source -> Bool
> :: Source -> Source -> Bool
$c> :: Source -> Source -> Bool
<= :: Source -> Source -> Bool
$c<= :: Source -> Source -> Bool
< :: Source -> Source -> Bool
$c< :: Source -> Source -> Bool
compare :: Source -> Source -> Ordering
$ccompare :: Source -> Source -> Ordering
$cp1Ord :: Eq Source
Ord, Int -> Source -> ShowS
[Source] -> ShowS
Source -> String
(Int -> Source -> ShowS)
-> (Source -> String) -> ([Source] -> ShowS) -> Show Source
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Source] -> ShowS
$cshowList :: [Source] -> ShowS
show :: Source -> String
$cshow :: Source -> String
showsPrec :: Int -> Source -> ShowS
$cshowsPrec :: Int -> Source -> ShowS
Show)
data Destination = Destination
{ Destination -> Database
destConnection :: Database
, Destination -> Text
destName :: Text
} deriving (Destination -> Destination -> Bool
(Destination -> Destination -> Bool)
-> (Destination -> Destination -> Bool) -> Eq Destination
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Destination -> Destination -> Bool
$c/= :: Destination -> Destination -> Bool
== :: Destination -> Destination -> Bool
$c== :: Destination -> Destination -> Bool
Eq, Eq Destination
Eq Destination
-> (Destination -> Destination -> Ordering)
-> (Destination -> Destination -> Bool)
-> (Destination -> Destination -> Bool)
-> (Destination -> Destination -> Bool)
-> (Destination -> Destination -> Bool)
-> (Destination -> Destination -> Destination)
-> (Destination -> Destination -> Destination)
-> Ord Destination
Destination -> Destination -> Bool
Destination -> Destination -> Ordering
Destination -> Destination -> Destination
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Destination -> Destination -> Destination
$cmin :: Destination -> Destination -> Destination
max :: Destination -> Destination -> Destination
$cmax :: Destination -> Destination -> Destination
>= :: Destination -> Destination -> Bool
$c>= :: Destination -> Destination -> Bool
> :: Destination -> Destination -> Bool
$c> :: Destination -> Destination -> Bool
<= :: Destination -> Destination -> Bool
$c<= :: Destination -> Destination -> Bool
< :: Destination -> Destination -> Bool
$c< :: Destination -> Destination -> Bool
compare :: Destination -> Destination -> Ordering
$ccompare :: Destination -> Destination -> Ordering
$cp1Ord :: Eq Destination
Ord, Int -> Destination -> ShowS
[Destination] -> ShowS
Destination -> String
(Int -> Destination -> ShowS)
-> (Destination -> String)
-> ([Destination] -> ShowS)
-> Show Destination
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Destination] -> ShowS
$cshowList :: [Destination] -> ShowS
show :: Destination -> String
$cshow :: Destination -> String
showsPrec :: Int -> Destination -> ShowS
$cshowsPrec :: Int -> Destination -> ShowS
Show)
backup :: Source -> Destination -> IO ()
backup :: Source -> Destination -> IO ()
backup Source
src Destination
dest =
ForeignPtr C'sqlite3 -> (Ptr C'sqlite3 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr (Database -> ForeignPtr C'sqlite3
dbPointer (Database -> ForeignPtr C'sqlite3)
-> (Destination -> Database) -> Destination -> ForeignPtr C'sqlite3
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Destination -> Database
destConnection (Destination -> ForeignPtr C'sqlite3)
-> Destination -> ForeignPtr C'sqlite3
forall a b. (a -> b) -> a -> b
$ Destination
dest) ((Ptr C'sqlite3 -> IO ()) -> IO ())
-> (Ptr C'sqlite3 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr C'sqlite3
ptrDestDb ->
ForeignPtr C'sqlite3 -> (Ptr C'sqlite3 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr (Database -> ForeignPtr C'sqlite3
dbPointer (Database -> ForeignPtr C'sqlite3)
-> (Source -> Database) -> Source -> ForeignPtr C'sqlite3
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Source -> Database
sourceConnection (Source -> ForeignPtr C'sqlite3) -> Source -> ForeignPtr C'sqlite3
forall a b. (a -> b) -> a -> b
$ Source
src) ((Ptr C'sqlite3 -> IO ()) -> IO ())
-> (Ptr C'sqlite3 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr C'sqlite3
ptrSrcDb ->
Text -> (Ptr CChar -> IO ()) -> IO ()
forall a. Text -> (Ptr CChar -> IO a) -> IO a
writeUtf8 (Source -> Text
sourceName Source
src) ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
ptrSrcName ->
Text -> (Ptr CChar -> IO ()) -> IO ()
forall a. Text -> (Ptr CChar -> IO a) -> IO a
writeUtf8 (Destination -> Text
destName Destination
dest) ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
ptrDestName ->
let
acq :: IO (Ptr C'sqlite3_backup)
acq = Ptr C'sqlite3
-> Ptr CChar
-> Ptr C'sqlite3
-> Ptr CChar
-> IO (Ptr C'sqlite3_backup)
sqlite3_backup_init Ptr C'sqlite3
ptrDestDb Ptr CChar
ptrDestName Ptr C'sqlite3
ptrSrcDb Ptr CChar
ptrSrcName
rel :: Ptr C'sqlite3_backup -> IO CInt
rel = Ptr C'sqlite3_backup -> IO CInt
sqlite3_backup_finish
use :: Ptr C'sqlite3_backup -> IO ()
use Ptr C'sqlite3_backup
bkpPtr = do
CInt
code <- Ptr C'sqlite3_backup -> CInt -> IO CInt
sqlite3_backup_step Ptr C'sqlite3_backup
bkpPtr (-CInt
1)
case CInt -> ParseErrorResult
forall a. (Integral a, Show a) => a -> ParseErrorResult
Bindings.parseError CInt
code of
Bindings.ParseErrorStep StepResult
Types.Done -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ParseErrorResult
Bindings.ParseErrorOk -> Error -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO (Error -> IO ()) -> Error -> IO ()
forall a b. (a -> b) -> a -> b
$ Error :: Text
-> Either ErrorFlag SqueatherErrorFlag -> Text -> Text -> Error
Error
{ errorContext :: Text
errorContext = Text
ctx
, errorFlag :: Either ErrorFlag SqueatherErrorFlag
errorFlag = SqueatherErrorFlag -> Either ErrorFlag SqueatherErrorFlag
forall a b. b -> Either a b
Right SqueatherErrorFlag
IncompleteBackup
, errorText :: Text
errorText = Text
"Squeather.backup: backup did not complete"
, errorFilename :: Text
errorFilename = Text
ctx
}
Bindings.ParseErrorStep StepResult
Types.Row -> Error -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO (Error -> IO ()) -> Error -> IO ()
forall a b. (a -> b) -> a -> b
$ Error :: Text
-> Either ErrorFlag SqueatherErrorFlag -> Text -> Text -> Error
Error
{ errorContext :: Text
errorContext = Text
ctx
, errorFlag :: Either ErrorFlag SqueatherErrorFlag
errorFlag = SqueatherErrorFlag -> Either ErrorFlag SqueatherErrorFlag
forall a b. b -> Either a b
Right SqueatherErrorFlag
Bug
, errorText :: Text
errorText = Text
"Squeather.backup: returned Row StepResult - should never happen"
, errorFilename :: Text
errorFilename = Text
ctx
}
Bindings.ParseErrorError ErrorFlag
flg -> Error -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO (Error -> IO ()) -> Error -> IO ()
forall a b. (a -> b) -> a -> b
$ Error :: Text
-> Either ErrorFlag SqueatherErrorFlag -> Text -> Text -> Error
Error
{ errorContext :: Text
errorContext = Text
ctx
, errorFlag :: Either ErrorFlag SqueatherErrorFlag
errorFlag = ErrorFlag -> Either ErrorFlag SqueatherErrorFlag
forall a b. a -> Either a b
Left ErrorFlag
flg
, errorText :: Text
errorText = Text
"Squeather.backup: error during backup"
, errorFilename :: Text
errorFilename = Text
ctx
}
ParseErrorResult
Bindings.ParseErrorNotFound -> Error -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO (Error -> IO ()) -> Error -> IO ()
forall a b. (a -> b) -> a -> b
$ Error :: Text
-> Either ErrorFlag SqueatherErrorFlag -> Text -> Text -> Error
Error
{ errorContext :: Text
errorContext = Text
ctx
, errorFlag :: Either ErrorFlag SqueatherErrorFlag
errorFlag = SqueatherErrorFlag -> Either ErrorFlag SqueatherErrorFlag
forall a b. b -> Either a b
Right (SqueatherErrorFlag -> Either ErrorFlag SqueatherErrorFlag)
-> SqueatherErrorFlag -> Either ErrorFlag SqueatherErrorFlag
forall a b. (a -> b) -> a -> b
$ CInt -> SqueatherErrorFlag
UnknownSqliteError CInt
code
, errorText :: Text
errorText = Text
"Squeather.backup: error during backup - code not found"
, errorFilename :: Text
errorFilename = Text
ctx
}
ctx :: Text
ctx = Text
"during backup from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Database -> Text
dbFilename (Source -> Database
sourceConnection Source
src) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Database -> Text
dbFilename (Destination -> Database
destConnection Destination
dest)
in IO (Ptr C'sqlite3_backup)
-> (Ptr C'sqlite3_backup -> IO CInt)
-> (Ptr C'sqlite3_backup -> IO ())
-> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracket IO (Ptr C'sqlite3_backup)
acq Ptr C'sqlite3_backup -> IO CInt
rel Ptr C'sqlite3_backup -> IO ()
use
foreign import ccall unsafe "sqlite3_changes" sqlite3_changes
:: Ptr C'sqlite3
-> IO CInt
changes :: Database -> IO Int
changes :: Database -> IO Int
changes (Database ForeignPtr C'sqlite3
dbFp Text
dbName) =
ForeignPtr C'sqlite3 -> (Ptr C'sqlite3 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr C'sqlite3
dbFp ((Ptr C'sqlite3 -> IO Int) -> IO Int)
-> (Ptr C'sqlite3 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr C'sqlite3
dbPtr ->
Ptr C'sqlite3 -> IO CInt
sqlite3_changes Ptr C'sqlite3
dbPtr IO CInt -> (CInt -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Text -> CInt -> IO Int
intFromCInt Text
"changes" Text
dbName
foreign import ccall unsafe "sqlite3_column_name" sqlite3_column_name
:: Ptr C'sqlite3_stmt
-> CInt
-> IO (Ptr CChar)
columnName
:: Statement
-> Int
-> IO Text
columnName :: Statement -> Int -> IO Text
columnName (Statement ForeignPtr C'sqlite3_stmt
stFp Text
stSql Database
db) Int
idx =
ForeignPtr C'sqlite3_stmt
-> (Ptr C'sqlite3_stmt -> IO Text) -> IO Text
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr C'sqlite3_stmt
stFp ((Ptr C'sqlite3_stmt -> IO Text) -> IO Text)
-> (Ptr C'sqlite3_stmt -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \Ptr C'sqlite3_stmt
stPtr -> do
CInt
cIntIdx <- Text -> Text -> Int -> IO CInt
intToCInt (Text
"getting column name in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
stSql) (Database -> Text
dbFilename Database
db) Int
idx
Ptr CChar
ptrStr <- Ptr C'sqlite3_stmt -> CInt -> IO (Ptr CChar)
sqlite3_column_name Ptr C'sqlite3_stmt
stPtr CInt
cIntIdx
if Ptr CChar
ptrStr Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
Foreign.nullPtr
then Error -> IO Text
forall e a. Exception e => e -> IO a
throwIO (Error -> IO Text) -> Error -> IO Text
forall a b. (a -> b) -> a -> b
$ Error :: Text
-> Either ErrorFlag SqueatherErrorFlag -> Text -> Text -> Error
Error
{ errorContext :: Text
errorContext = Text
stSql
, errorFlag :: Either ErrorFlag SqueatherErrorFlag
errorFlag = SqueatherErrorFlag -> Either ErrorFlag SqueatherErrorFlag
forall a b. b -> Either a b
Right (Int -> SqueatherErrorFlag
ColumnNameNull Int
idx)
, errorText :: Text
errorText = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"null pointer returned when getting column name for index " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
idx
, errorFilename :: Text
errorFilename = Database -> Text
dbFilename Database
db
}
else Ptr CChar -> IO Text
readUtf8 Ptr CChar
ptrStr
columnNames :: Statement -> IO [Text]
columnNames :: Statement -> IO [Text]
columnNames Statement
stmt = do
Int
i <- Statement -> IO Int
columnCount Statement
stmt
(Int -> IO Text) -> [Int] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Statement -> Int -> IO Text
columnName Statement
stmt) [Int
0 .. (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
foreign import ccall unsafe "sqlite3_threadsafe" sqlite3_threadsafe
:: IO CInt
foreign import ccall unsafe "sqlite3_initialize" sqlite3_initialize
:: IO CInt