{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-}
module Database.Sqlite (
Connection,
Statement,
Error(..),
SqliteException(..),
StepResult(Row, Done),
Config(ConfigLogFn),
LogFunction,
SqliteStatus (..),
SqliteStatusVerb (..),
open,
close,
prepare,
step,
stepConn,
reset,
finalize,
bindBlob,
bindDouble,
bindInt,
bindInt64,
bindNull,
bindText,
bind,
column,
columns,
changes,
mkLogFunction,
freeLogFunction,
config,
status,
softHeapLimit,
enableExtendedResultCodes,
disableExtendedResultCodes
)
where
import Prelude hiding (error)
import qualified Prelude as P
import Control.Exception (Exception, throwIO)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BSU
import qualified Data.ByteString.Internal as BSI
import Data.Fixed (Pico)
import Data.IORef (newIORef, readIORef, writeIORef)
import Data.Monoid (mappend, mconcat)
import Data.Text (Text, pack, unpack)
import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import Data.Time (defaultTimeLocale, formatTime, UTCTime)
import Database.Sqlite.Internal (Connection(..), Connection'(..), Statement(..))
import Foreign
import Foreign.C
import Database.Persist (PersistValue (..), listToJSON, mapToJSON, LiteralType(..))
data SqliteException = SqliteException
{ SqliteException -> Error
seError :: !Error
, SqliteException -> Text
seFunctionName :: !Text
, SqliteException -> Text
seDetails :: !Text
}
instance Show SqliteException where
show :: SqliteException -> String
show (SqliteException Error
error Text
functionName Text
details) = Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
Data.Monoid.mconcat
[Text
"SQLite3 returned "
, String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Error -> String
forall a. Show a => a -> String
show Error
error
, Text
" while attempting to perform "
, Text
functionName
, Text
details
]
instance Exception SqliteException
data Error = ErrorOK
| ErrorError
| ErrorInternal
| ErrorPermission
| ErrorAbort
| ErrorBusy
| ErrorLocked
| ErrorNoMemory
| ErrorReadOnly
| ErrorInterrupt
| ErrorIO
| ErrorNotFound
| ErrorCorrupt
| ErrorFull
| ErrorCan'tOpen
| ErrorProtocol
| ErrorEmpty
| ErrorSchema
| ErrorTooBig
| ErrorConstraint
| ErrorMismatch
| ErrorMisuse
| ErrorNoLargeFileSupport
| ErrorAuthorization
| ErrorFormat
| ErrorRange
| ErrorNotAConnection
| ErrorRow
| ErrorDone
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, 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)
data StepResult = Row | Done deriving (StepResult -> StepResult -> Bool
(StepResult -> StepResult -> Bool)
-> (StepResult -> StepResult -> Bool) -> Eq StepResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StepResult -> StepResult -> Bool
$c/= :: StepResult -> StepResult -> Bool
== :: StepResult -> StepResult -> Bool
$c== :: StepResult -> StepResult -> Bool
Eq, Int -> StepResult -> ShowS
[StepResult] -> ShowS
StepResult -> String
(Int -> StepResult -> ShowS)
-> (StepResult -> String)
-> ([StepResult] -> ShowS)
-> Show StepResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StepResult] -> ShowS
$cshowList :: [StepResult] -> ShowS
show :: StepResult -> String
$cshow :: StepResult -> String
showsPrec :: Int -> StepResult -> ShowS
$cshowsPrec :: Int -> StepResult -> ShowS
Show)
data ColumnType = IntegerColumn
| FloatColumn
| TextColumn
| BlobColumn
| NullColumn
deriving (ColumnType -> ColumnType -> Bool
(ColumnType -> ColumnType -> Bool)
-> (ColumnType -> ColumnType -> Bool) -> Eq ColumnType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnType -> ColumnType -> Bool
$c/= :: ColumnType -> ColumnType -> Bool
== :: ColumnType -> ColumnType -> Bool
$c== :: ColumnType -> ColumnType -> Bool
Eq, Int -> ColumnType -> ShowS
[ColumnType] -> ShowS
ColumnType -> String
(Int -> ColumnType -> ShowS)
-> (ColumnType -> String)
-> ([ColumnType] -> ShowS)
-> Show ColumnType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnType] -> ShowS
$cshowList :: [ColumnType] -> ShowS
show :: ColumnType -> String
$cshow :: ColumnType -> String
showsPrec :: Int -> ColumnType -> ShowS
$cshowsPrec :: Int -> ColumnType -> ShowS
Show)
decodeError :: Int -> Error
decodeError :: Int -> Error
decodeError Int
0 = Error
ErrorOK
decodeError Int
1 = Error
ErrorError
decodeError Int
2 = Error
ErrorInternal
decodeError Int
3 = Error
ErrorPermission
decodeError Int
4 = Error
ErrorAbort
decodeError Int
5 = Error
ErrorBusy
decodeError Int
6 = Error
ErrorLocked
decodeError Int
7 = Error
ErrorNoMemory
decodeError Int
8 = Error
ErrorReadOnly
decodeError Int
9 = Error
ErrorInterrupt
decodeError Int
10 = Error
ErrorIO
decodeError Int
11 = Error
ErrorNotFound
decodeError Int
12 = Error
ErrorCorrupt
decodeError Int
13 = Error
ErrorFull
decodeError Int
14 = Error
ErrorCan'tOpen
decodeError Int
15 = Error
ErrorProtocol
decodeError Int
16 = Error
ErrorEmpty
decodeError Int
17 = Error
ErrorSchema
decodeError Int
18 = Error
ErrorTooBig
decodeError Int
19 = Error
ErrorConstraint
decodeError Int
20 = Error
ErrorMismatch
decodeError Int
21 = Error
ErrorMisuse
decodeError Int
22 = Error
ErrorNoLargeFileSupport
decodeError Int
23 = Error
ErrorAuthorization
decodeError Int
24 = Error
ErrorFormat
decodeError Int
25 = Error
ErrorRange
decodeError Int
26 = Error
ErrorNotAConnection
decodeError Int
100 = Error
ErrorRow
decodeError Int
101 = Error
ErrorDone
decodeError Int
i = String -> Error
forall a. HasCallStack => String -> a
P.error (String -> Error) -> String -> Error
forall a b. (a -> b) -> a -> b
$ String
"decodeError " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
decodeColumnType :: Int -> ColumnType
decodeColumnType :: Int -> ColumnType
decodeColumnType Int
1 = ColumnType
IntegerColumn
decodeColumnType Int
2 = ColumnType
FloatColumn
decodeColumnType Int
3 = ColumnType
TextColumn
decodeColumnType Int
4 = ColumnType
BlobColumn
decodeColumnType Int
5 = ColumnType
NullColumn
decodeColumnType Int
i = String -> ColumnType
forall a. HasCallStack => String -> a
P.error (String -> ColumnType) -> String -> ColumnType
forall a b. (a -> b) -> a -> b
$ String
"decodeColumnType " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
foreign import ccall "sqlite3_errmsg"
errmsgC :: Ptr () -> IO CString
errmsg :: Connection -> IO Text
errmsg :: Connection -> IO Text
errmsg (Connection IORef Bool
_ (Connection' Ptr ()
database)) = do
CString
message <- Ptr () -> IO CString
errmsgC Ptr ()
database
ByteString
byteString <- CString -> IO ByteString
BS.packCString CString
message
Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode ByteString
byteString
sqlError :: Maybe Connection -> Text -> Error -> IO a
sqlError :: Maybe Connection -> Text -> Error -> IO a
sqlError Maybe Connection
maybeConnection Text
functionName Error
error = do
Text
details <- case Maybe Connection
maybeConnection of
Just Connection
database -> do
Text
details <- Connection -> IO Text
errmsg Connection
database
Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ Text
": " Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`Data.Monoid.mappend` Text
details
Maybe Connection
Nothing -> Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"."
SqliteException -> IO a
forall e a. Exception e => e -> IO a
throwIO SqliteException :: Error -> Text -> Text -> SqliteException
SqliteException
{ seError :: Error
seError = Error
error
, seFunctionName :: Text
seFunctionName = Text
functionName
, seDetails :: Text
seDetails = Text
details
}
foreign import ccall "sqlite3_open_v2"
openC :: CString -> Ptr (Ptr ()) -> Int -> CString -> IO Int
openError :: Text -> IO (Either Connection Error)
openError :: Text -> IO (Either Connection Error)
openError Text
path' = do
let flag :: Int
flag = Int
sqliteFlagReadWrite Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
sqliteFlagCreate Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
sqliteFlagUri
ByteString
-> (CString -> IO (Either Connection Error))
-> IO (Either Connection Error)
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString (Text -> ByteString
encodeUtf8 Text
path') ((CString -> IO (Either Connection Error))
-> IO (Either Connection Error))
-> (CString -> IO (Either Connection Error))
-> IO (Either Connection Error)
forall a b. (a -> b) -> a -> b
$ \CString
path -> (Ptr (Ptr ()) -> IO (Either Connection Error))
-> IO (Either Connection Error)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr ()) -> IO (Either Connection Error))
-> IO (Either Connection Error))
-> (Ptr (Ptr ()) -> IO (Either Connection Error))
-> IO (Either Connection Error)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
database -> do
Error
err <- Int -> Error
decodeError (Int -> Error) -> IO Int -> IO Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> Ptr (Ptr ()) -> Int -> CString -> IO Int
openC CString
path Ptr (Ptr ())
database Int
flag CString
forall a. Ptr a
nullPtr
case Error
err of
Error
ErrorOK -> do Ptr ()
database' <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr ())
database
IORef Bool
active <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
True
Either Connection Error -> IO (Either Connection Error)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Connection Error -> IO (Either Connection Error))
-> Either Connection Error -> IO (Either Connection Error)
forall a b. (a -> b) -> a -> b
$ Connection -> Either Connection Error
forall a b. a -> Either a b
Left (Connection -> Either Connection Error)
-> Connection -> Either Connection Error
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Connection' -> Connection
Connection IORef Bool
active (Connection' -> Connection) -> Connection' -> Connection
forall a b. (a -> b) -> a -> b
$ Ptr () -> Connection'
Connection' Ptr ()
database'
Error
_ -> Either Connection Error -> IO (Either Connection Error)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Connection Error -> IO (Either Connection Error))
-> Either Connection Error -> IO (Either Connection Error)
forall a b. (a -> b) -> a -> b
$ Error -> Either Connection Error
forall a b. b -> Either a b
Right Error
err
where
sqliteFlagReadWrite :: Int
sqliteFlagReadWrite = Int
0x2
sqliteFlagCreate :: Int
sqliteFlagCreate = Int
0x4
sqliteFlagUri :: Int
sqliteFlagUri = Int
0x40
open :: Text -> IO Connection
open :: Text -> IO Connection
open Text
path = do
Either Connection Error
databaseOrError <- Text -> IO (Either Connection Error)
openError Text
path
case Either Connection Error
databaseOrError of
Left Connection
database -> Connection -> IO Connection
forall (m :: * -> *) a. Monad m => a -> m a
return Connection
database
Right Error
error -> Maybe Connection -> Text -> Error -> IO Connection
forall a. Maybe Connection -> Text -> Error -> IO a
sqlError Maybe Connection
forall a. Maybe a
Nothing (Text
"open " Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. Show a => a -> String
show Text
path)) Error
error
foreign import ccall "sqlite3_close"
closeC :: Ptr () -> IO Int
closeError :: Connection -> IO Error
closeError :: Connection -> IO Error
closeError (Connection IORef Bool
iactive (Connection' Ptr ()
database)) = do
IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
iactive Bool
False
Int
error <- Ptr () -> IO Int
closeC Ptr ()
database
Error -> IO Error
forall (m :: * -> *) a. Monad m => a -> m a
return (Error -> IO Error) -> Error -> IO Error
forall a b. (a -> b) -> a -> b
$ Int -> Error
decodeError Int
error
close :: Connection -> IO ()
close :: Connection -> IO ()
close Connection
database = do
Error
error <- Connection -> IO Error
closeError Connection
database
case Error
error of
Error
ErrorOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Error
_ -> Maybe Connection -> Text -> Error -> IO ()
forall a. Maybe Connection -> Text -> Error -> IO a
sqlError (Connection -> Maybe Connection
forall a. a -> Maybe a
Just Connection
database) Text
"close" Error
error
foreign import ccall "sqlite3_extended_result_codes"
sqlite3_extended_result_codesC :: Ptr () -> Int -> IO Int
enableExtendedResultCodes :: Connection -> IO ()
enableExtendedResultCodes :: Connection -> IO ()
enableExtendedResultCodes con :: Connection
con@(Connection IORef Bool
_ (Connection' Ptr ()
database)) = do
Int
error <- Ptr () -> Int -> IO Int
sqlite3_extended_result_codesC Ptr ()
database Int
1
let err :: Error
err = Int -> Error
decodeError Int
error
case Error
err of
Error
ErrorOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Error
_ -> Maybe Connection -> Text -> Error -> IO ()
forall a. Maybe Connection -> Text -> Error -> IO a
sqlError (Connection -> Maybe Connection
forall a. a -> Maybe a
Just Connection
con) Text
"enableExtendedResultCodes" Error
err
disableExtendedResultCodes :: Connection -> IO ()
disableExtendedResultCodes :: Connection -> IO ()
disableExtendedResultCodes con :: Connection
con@(Connection IORef Bool
_ (Connection' Ptr ()
database)) = do
Int
error <- Ptr () -> Int -> IO Int
sqlite3_extended_result_codesC Ptr ()
database Int
0
let err :: Error
err = Int -> Error
decodeError Int
error
case Error
err of
Error
ErrorOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Error
_ -> Maybe Connection -> Text -> Error -> IO ()
forall a. Maybe Connection -> Text -> Error -> IO a
sqlError (Connection -> Maybe Connection
forall a. a -> Maybe a
Just Connection
con) Text
"disableExtendedResultCodes" Error
err
foreign import ccall "sqlite3_prepare_v2"
prepareC :: Ptr () -> CString -> Int -> Ptr (Ptr ()) -> Ptr (Ptr ()) -> IO Int
prepareError :: Connection -> Text -> IO (Either Statement Error)
prepareError :: Connection -> Text -> IO (Either Statement Error)
prepareError (Connection IORef Bool
_ (Connection' Ptr ()
database)) Text
text' = do
ByteString
-> (CString -> IO (Either Statement Error))
-> IO (Either Statement Error)
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString (Text -> ByteString
encodeUtf8 Text
text')
(\CString
text -> do
(Ptr (Ptr ()) -> IO (Either Statement Error))
-> IO (Either Statement Error)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca (\Ptr (Ptr ())
statement -> do
Int
error' <- Ptr () -> CString -> Int -> Ptr (Ptr ()) -> Ptr (Ptr ()) -> IO Int
prepareC Ptr ()
database CString
text (-Int
1) Ptr (Ptr ())
statement Ptr (Ptr ())
forall a. Ptr a
nullPtr
Error
error <- Error -> IO Error
forall (m :: * -> *) a. Monad m => a -> m a
return (Error -> IO Error) -> Error -> IO Error
forall a b. (a -> b) -> a -> b
$ Int -> Error
decodeError Int
error'
case Error
error of
Error
ErrorOK -> do
Ptr ()
statement' <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr ())
statement
Either Statement Error -> IO (Either Statement Error)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Statement Error -> IO (Either Statement Error))
-> Either Statement Error -> IO (Either Statement Error)
forall a b. (a -> b) -> a -> b
$ Statement -> Either Statement Error
forall a b. a -> Either a b
Left (Statement -> Either Statement Error)
-> Statement -> Either Statement Error
forall a b. (a -> b) -> a -> b
$ Ptr () -> Statement
Statement Ptr ()
statement'
Error
_ -> Either Statement Error -> IO (Either Statement Error)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Statement Error -> IO (Either Statement Error))
-> Either Statement Error -> IO (Either Statement Error)
forall a b. (a -> b) -> a -> b
$ Error -> Either Statement Error
forall a b. b -> Either a b
Right Error
error))
prepare :: Connection -> Text -> IO Statement
prepare :: Connection -> Text -> IO Statement
prepare Connection
database Text
text = do
Either Statement Error
statementOrError <- Connection -> Text -> IO (Either Statement Error)
prepareError Connection
database Text
text
case Either Statement Error
statementOrError of
Left Statement
statement -> Statement -> IO Statement
forall (m :: * -> *) a. Monad m => a -> m a
return Statement
statement
Right Error
error -> Maybe Connection -> Text -> Error -> IO Statement
forall a. Maybe Connection -> Text -> Error -> IO a
sqlError (Connection -> Maybe Connection
forall a. a -> Maybe a
Just Connection
database) (Text
"prepare " Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. Show a => a -> String
show Text
text)) Error
error
foreign import ccall "sqlite3_step"
stepC :: Ptr () -> IO Int
stepError :: Statement -> IO Error
stepError :: Statement -> IO Error
stepError (Statement Ptr ()
statement) = do
Int
error <- Ptr () -> IO Int
stepC Ptr ()
statement
Error -> IO Error
forall (m :: * -> *) a. Monad m => a -> m a
return (Error -> IO Error) -> Error -> IO Error
forall a b. (a -> b) -> a -> b
$ Int -> Error
decodeError Int
error
step :: Statement -> IO StepResult
step :: Statement -> IO StepResult
step Statement
statement = do
Error
error <- Statement -> IO Error
stepError Statement
statement
case Error
error of
Error
ErrorRow -> StepResult -> IO StepResult
forall (m :: * -> *) a. Monad m => a -> m a
return StepResult
Row
Error
ErrorDone -> StepResult -> IO StepResult
forall (m :: * -> *) a. Monad m => a -> m a
return StepResult
Done
Error
_ -> Maybe Connection -> Text -> Error -> IO StepResult
forall a. Maybe Connection -> Text -> Error -> IO a
sqlError Maybe Connection
forall a. Maybe a
Nothing Text
"step" Error
error
stepConn :: Connection -> Statement -> IO StepResult
stepConn :: Connection -> Statement -> IO StepResult
stepConn Connection
database Statement
statement = do
Error
error <- Statement -> IO Error
stepError Statement
statement
case Error
error of
Error
ErrorRow -> StepResult -> IO StepResult
forall (m :: * -> *) a. Monad m => a -> m a
return StepResult
Row
Error
ErrorDone -> StepResult -> IO StepResult
forall (m :: * -> *) a. Monad m => a -> m a
return StepResult
Done
Error
_ -> Maybe Connection -> Text -> Error -> IO StepResult
forall a. Maybe Connection -> Text -> Error -> IO a
sqlError (Connection -> Maybe Connection
forall a. a -> Maybe a
Just Connection
database) Text
"step" Error
error
foreign import ccall "sqlite3_reset"
resetC :: Ptr () -> IO Int
resetError :: Statement -> IO Error
resetError :: Statement -> IO Error
resetError (Statement Ptr ()
statement) = do
Int
error <- Ptr () -> IO Int
resetC Ptr ()
statement
Error -> IO Error
forall (m :: * -> *) a. Monad m => a -> m a
return (Error -> IO Error) -> Error -> IO Error
forall a b. (a -> b) -> a -> b
$ Int -> Error
decodeError Int
error
reset :: Connection -> Statement -> IO ()
reset :: Connection -> Statement -> IO ()
reset (Connection IORef Bool
iactive Connection'
_) Statement
statement = do
Bool
active <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
iactive
if Bool
active
then do
Error
error <- Statement -> IO Error
resetError Statement
statement
case Error
error of
Error
ErrorOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Error
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
foreign import ccall "sqlite3_finalize"
finalizeC :: Ptr () -> IO Int
finalizeError :: Statement -> IO Error
finalizeError :: Statement -> IO Error
finalizeError (Statement Ptr ()
statement) = do
Int
error <- Ptr () -> IO Int
finalizeC Ptr ()
statement
Error -> IO Error
forall (m :: * -> *) a. Monad m => a -> m a
return (Error -> IO Error) -> Error -> IO Error
forall a b. (a -> b) -> a -> b
$ Int -> Error
decodeError Int
error
finalize :: Statement -> IO ()
finalize :: Statement -> IO ()
finalize Statement
statement = do
Error
error <- Statement -> IO Error
finalizeError Statement
statement
case Error
error of
Error
ErrorOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Error
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
unsafeUseAsCStringLenNoNull
:: BS.ByteString
-> (CString -> Int -> IO a)
-> IO a
unsafeUseAsCStringLenNoNull :: ByteString -> (CString -> Int -> IO a) -> IO a
unsafeUseAsCStringLenNoNull ByteString
bs CString -> Int -> IO a
cb
| ByteString -> Bool
BS.null ByteString
bs = CString -> Int -> IO a
cb (IntPtr -> CString
forall a. IntPtr -> Ptr a
intPtrToPtr IntPtr
1) Int
0
| Bool
otherwise = ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BSU.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO a) -> IO a) -> (CStringLen -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \(CString
ptr, Int
len) ->
CString -> Int -> IO a
cb CString
ptr (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
foreign import ccall "sqlite3_bind_blob"
bindBlobC :: Ptr () -> Int -> Ptr () -> Int -> Ptr () -> IO Int
bindBlobError :: Statement -> Int -> BS.ByteString -> IO Error
bindBlobError :: Statement -> Int -> ByteString -> IO Error
bindBlobError (Statement Ptr ()
statement) Int
parameterIndex ByteString
byteString =
ByteString -> (CString -> Int -> IO Error) -> IO Error
forall a. ByteString -> (CString -> Int -> IO a) -> IO a
unsafeUseAsCStringLenNoNull ByteString
byteString ((CString -> Int -> IO Error) -> IO Error)
-> (CString -> Int -> IO Error) -> IO Error
forall a b. (a -> b) -> a -> b
$ \CString
dataC Int
size -> do
Int
error <- Ptr () -> Int -> Ptr () -> Int -> Ptr () -> IO Int
bindBlobC Ptr ()
statement Int
parameterIndex (CString -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr CString
dataC) Int
size
(IntPtr -> Ptr ()
forall a. IntPtr -> Ptr a
intPtrToPtr (-IntPtr
1))
Error -> IO Error
forall (m :: * -> *) a. Monad m => a -> m a
return (Error -> IO Error) -> Error -> IO Error
forall a b. (a -> b) -> a -> b
$ Int -> Error
decodeError Int
error
bindBlob :: Statement -> Int -> BS.ByteString -> IO ()
bindBlob :: Statement -> Int -> ByteString -> IO ()
bindBlob Statement
statement Int
parameterIndex ByteString
byteString = do
Error
error <- Statement -> Int -> ByteString -> IO Error
bindBlobError Statement
statement Int
parameterIndex ByteString
byteString
case Error
error of
Error
ErrorOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Error
_ -> Maybe Connection -> Text -> Error -> IO ()
forall a. Maybe Connection -> Text -> Error -> IO a
sqlError Maybe Connection
forall a. Maybe a
Nothing Text
"bind blob" Error
error
foreign import ccall "sqlite3_bind_double"
bindDoubleC :: Ptr () -> Int -> Double -> IO Int
bindDoubleError :: Statement -> Int -> Double -> IO Error
bindDoubleError :: Statement -> Int -> Double -> IO Error
bindDoubleError (Statement Ptr ()
statement) Int
parameterIndex Double
datum = do
Int
error <- Ptr () -> Int -> Double -> IO Int
bindDoubleC Ptr ()
statement Int
parameterIndex Double
datum
Error -> IO Error
forall (m :: * -> *) a. Monad m => a -> m a
return (Error -> IO Error) -> Error -> IO Error
forall a b. (a -> b) -> a -> b
$ Int -> Error
decodeError Int
error
bindDouble :: Statement -> Int -> Double -> IO ()
bindDouble :: Statement -> Int -> Double -> IO ()
bindDouble Statement
statement Int
parameterIndex Double
datum = do
Error
error <- Statement -> Int -> Double -> IO Error
bindDoubleError Statement
statement Int
parameterIndex Double
datum
case Error
error of
Error
ErrorOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Error
_ -> Maybe Connection -> Text -> Error -> IO ()
forall a. Maybe Connection -> Text -> Error -> IO a
sqlError Maybe Connection
forall a. Maybe a
Nothing Text
"bind double" Error
error
foreign import ccall "sqlite3_bind_int"
bindIntC :: Ptr () -> Int -> Int -> IO Int
bindIntError :: Statement -> Int -> Int -> IO Error
bindIntError :: Statement -> Int -> Int -> IO Error
bindIntError (Statement Ptr ()
statement) Int
parameterIndex Int
datum = do
Int
error <- Ptr () -> Int -> Int -> IO Int
bindIntC Ptr ()
statement Int
parameterIndex Int
datum
Error -> IO Error
forall (m :: * -> *) a. Monad m => a -> m a
return (Error -> IO Error) -> Error -> IO Error
forall a b. (a -> b) -> a -> b
$ Int -> Error
decodeError Int
error
bindInt :: Statement -> Int -> Int -> IO ()
bindInt :: Statement -> Int -> Int -> IO ()
bindInt Statement
statement Int
parameterIndex Int
datum = do
Error
error <- Statement -> Int -> Int -> IO Error
bindIntError Statement
statement Int
parameterIndex Int
datum
case Error
error of
Error
ErrorOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Error
_ -> Maybe Connection -> Text -> Error -> IO ()
forall a. Maybe Connection -> Text -> Error -> IO a
sqlError Maybe Connection
forall a. Maybe a
Nothing Text
"bind int" Error
error
foreign import ccall "sqlite3_bind_int64"
bindInt64C :: Ptr () -> Int -> Int64 -> IO Int
bindInt64Error :: Statement -> Int -> Int64 -> IO Error
bindInt64Error :: Statement -> Int -> Int64 -> IO Error
bindInt64Error (Statement Ptr ()
statement) Int
parameterIndex Int64
datum = do
Int
error <- Ptr () -> Int -> Int64 -> IO Int
bindInt64C Ptr ()
statement Int
parameterIndex Int64
datum
Error -> IO Error
forall (m :: * -> *) a. Monad m => a -> m a
return (Error -> IO Error) -> Error -> IO Error
forall a b. (a -> b) -> a -> b
$ Int -> Error
decodeError Int
error
bindInt64 :: Statement -> Int -> Int64 -> IO ()
bindInt64 :: Statement -> Int -> Int64 -> IO ()
bindInt64 Statement
statement Int
parameterIndex Int64
datum = do
Error
error <- Statement -> Int -> Int64 -> IO Error
bindInt64Error Statement
statement Int
parameterIndex Int64
datum
case Error
error of
Error
ErrorOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Error
_ -> Maybe Connection -> Text -> Error -> IO ()
forall a. Maybe Connection -> Text -> Error -> IO a
sqlError Maybe Connection
forall a. Maybe a
Nothing Text
"bind int64" Error
error
foreign import ccall "sqlite3_bind_null"
bindNullC :: Ptr () -> Int -> IO Int
bindNullError :: Statement -> Int -> IO Error
bindNullError :: Statement -> Int -> IO Error
bindNullError (Statement Ptr ()
statement) Int
parameterIndex = do
Int
error <- Ptr () -> Int -> IO Int
bindNullC Ptr ()
statement Int
parameterIndex
Error -> IO Error
forall (m :: * -> *) a. Monad m => a -> m a
return (Error -> IO Error) -> Error -> IO Error
forall a b. (a -> b) -> a -> b
$ Int -> Error
decodeError Int
error
bindNull :: Statement -> Int -> IO ()
bindNull :: Statement -> Int -> IO ()
bindNull Statement
statement Int
parameterIndex = do
Error
error <- Statement -> Int -> IO Error
bindNullError Statement
statement Int
parameterIndex
case Error
error of
Error
ErrorOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Error
_ -> Maybe Connection -> Text -> Error -> IO ()
forall a. Maybe Connection -> Text -> Error -> IO a
sqlError Maybe Connection
forall a. Maybe a
Nothing Text
"bind null" Error
error
foreign import ccall "sqlite3_bind_text"
bindTextC :: Ptr () -> Int -> CString -> Int -> Ptr () -> IO Int
bindTextError :: Statement -> Int -> Text -> IO Error
bindTextError :: Statement -> Int -> Text -> IO Error
bindTextError (Statement Ptr ()
statement) Int
parameterIndex Text
text =
ByteString -> (CString -> Int -> IO Error) -> IO Error
forall a. ByteString -> (CString -> Int -> IO a) -> IO a
unsafeUseAsCStringLenNoNull (Text -> ByteString
encodeUtf8 Text
text) ((CString -> Int -> IO Error) -> IO Error)
-> (CString -> Int -> IO Error) -> IO Error
forall a b. (a -> b) -> a -> b
$ \CString
dataC Int
size -> do
Int
error <- Ptr () -> Int -> CString -> Int -> Ptr () -> IO Int
bindTextC Ptr ()
statement Int
parameterIndex CString
dataC Int
size (IntPtr -> Ptr ()
forall a. IntPtr -> Ptr a
intPtrToPtr (-IntPtr
1))
Error -> IO Error
forall (m :: * -> *) a. Monad m => a -> m a
return (Error -> IO Error) -> Error -> IO Error
forall a b. (a -> b) -> a -> b
$ Int -> Error
decodeError Int
error
bindText :: Statement -> Int -> Text -> IO ()
bindText :: Statement -> Int -> Text -> IO ()
bindText Statement
statement Int
parameterIndex Text
text = do
Error
error <- Statement -> Int -> Text -> IO Error
bindTextError Statement
statement Int
parameterIndex Text
text
case Error
error of
Error
ErrorOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Error
_ -> Maybe Connection -> Text -> Error -> IO ()
forall a. Maybe Connection -> Text -> Error -> IO a
sqlError Maybe Connection
forall a. Maybe a
Nothing Text
"bind text" Error
error
bind :: Statement -> [PersistValue] -> IO ()
bind :: Statement -> [PersistValue] -> IO ()
bind Statement
statement [PersistValue]
sqlData = do
((Int, PersistValue) -> IO ()) -> [(Int, PersistValue)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
parameterIndex, PersistValue
datum) -> do
case PersistValue
datum of
PersistInt64 Int64
int64 -> Statement -> Int -> Int64 -> IO ()
bindInt64 Statement
statement Int
parameterIndex Int64
int64
PersistDouble Double
double -> Statement -> Int -> Double -> IO ()
bindDouble Statement
statement Int
parameterIndex Double
double
PersistRational Rational
rational -> Statement -> Int -> Text -> IO ()
bindText Statement
statement Int
parameterIndex (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Pico -> String
forall a. Show a => a -> String
show (Rational -> Pico
forall a. Fractional a => Rational -> a
fromRational Rational
rational :: Pico)
PersistBool Bool
b -> Statement -> Int -> Int64 -> IO ()
bindInt64 Statement
statement Int
parameterIndex (Int64 -> IO ()) -> Int64 -> IO ()
forall a b. (a -> b) -> a -> b
$
if Bool
b then Int64
1 else Int64
0
PersistText Text
text -> Statement -> Int -> Text -> IO ()
bindText Statement
statement Int
parameterIndex Text
text
PersistByteString ByteString
blob -> Statement -> Int -> ByteString -> IO ()
bindBlob Statement
statement Int
parameterIndex ByteString
blob
PersistValue
PersistNull -> Statement -> Int -> IO ()
bindNull Statement
statement Int
parameterIndex
PersistDay Day
d -> Statement -> Int -> Text -> IO ()
bindText Statement
statement Int
parameterIndex (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Day -> String
forall a. Show a => a -> String
show Day
d
PersistTimeOfDay TimeOfDay
d -> Statement -> Int -> Text -> IO ()
bindText Statement
statement Int
parameterIndex (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> String
forall a. Show a => a -> String
show TimeOfDay
d
PersistUTCTime UTCTime
d -> Statement -> Int -> Text -> IO ()
bindText Statement
statement Int
parameterIndex (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ UTCTime -> String
format8601 UTCTime
d
PersistList [PersistValue]
l -> Statement -> Int -> Text -> IO ()
bindText Statement
statement Int
parameterIndex (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [PersistValue] -> Text
listToJSON [PersistValue]
l
PersistMap [(Text, PersistValue)]
m -> Statement -> Int -> Text -> IO ()
bindText Statement
statement Int
parameterIndex (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [(Text, PersistValue)] -> Text
mapToJSON [(Text, PersistValue)]
m
PersistArray [PersistValue]
a -> Statement -> Int -> Text -> IO ()
bindText Statement
statement Int
parameterIndex (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [PersistValue] -> Text
listToJSON [PersistValue]
a
PersistObjectId ByteString
_ -> String -> IO ()
forall a. HasCallStack => String -> a
P.error String
"Refusing to serialize a PersistObjectId to a SQLite value"
PersistLiteral_ LiteralType
DbSpecific ByteString
s -> Statement -> Int -> Text -> IO ()
bindText Statement
statement Int
parameterIndex (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode ByteString
s
PersistLiteral_ LiteralType
Unescaped ByteString
l -> Statement -> Int -> Text -> IO ()
bindText Statement
statement Int
parameterIndex (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode ByteString
l
PersistLiteral_ LiteralType
Escaped ByteString
e -> Statement -> Int -> Text -> IO ()
bindText Statement
statement Int
parameterIndex (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode ByteString
e
)
([(Int, PersistValue)] -> IO ()) -> [(Int, PersistValue)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Int] -> [PersistValue] -> [(Int, PersistValue)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [PersistValue]
sqlData
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
format8601 :: UTCTime -> String
format8601 :: UTCTime -> String
format8601 = TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%FT%T%Q"
foreign import ccall "sqlite3_column_type"
columnTypeC :: Ptr () -> Int -> IO Int
columnType :: Statement -> Int -> IO ColumnType
columnType :: Statement -> Int -> IO ColumnType
columnType (Statement Ptr ()
statement) Int
columnIndex = do
Int
result <- Ptr () -> Int -> IO Int
columnTypeC Ptr ()
statement Int
columnIndex
ColumnType -> IO ColumnType
forall (m :: * -> *) a. Monad m => a -> m a
return (ColumnType -> IO ColumnType) -> ColumnType -> IO ColumnType
forall a b. (a -> b) -> a -> b
$ Int -> ColumnType
decodeColumnType Int
result
foreign import ccall "sqlite3_column_bytes"
columnBytesC :: Ptr () -> Int -> IO Int
foreign import ccall "sqlite3_column_blob"
columnBlobC :: Ptr () -> Int -> IO (Ptr ())
columnBlob :: Statement -> Int -> IO BS.ByteString
columnBlob :: Statement -> Int -> IO ByteString
columnBlob (Statement Ptr ()
statement) Int
columnIndex = do
Int
size <- Ptr () -> Int -> IO Int
columnBytesC Ptr ()
statement Int
columnIndex
Int -> (Ptr Word8 -> IO ()) -> IO ByteString
BSI.create Int
size (\Ptr Word8
resultPtr -> do
Ptr ()
dataPtr <- Ptr () -> Int -> IO (Ptr ())
columnBlobC Ptr ()
statement Int
columnIndex
if Ptr ()
dataPtr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr ()
forall a. Ptr a
nullPtr
then Ptr Word8 -> Ptr Word8 -> Int -> IO ()
BSI.memcpy Ptr Word8
resultPtr (Ptr () -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
dataPtr) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)
else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
foreign import ccall "sqlite3_column_int64"
columnInt64C :: Ptr () -> Int -> IO Int64
columnInt64 :: Statement -> Int -> IO Int64
columnInt64 :: Statement -> Int -> IO Int64
columnInt64 (Statement Ptr ()
statement) Int
columnIndex = do
Ptr () -> Int -> IO Int64
columnInt64C Ptr ()
statement Int
columnIndex
foreign import ccall "sqlite3_column_double"
columnDoubleC :: Ptr () -> Int -> IO Double
columnDouble :: Statement -> Int -> IO Double
columnDouble :: Statement -> Int -> IO Double
columnDouble (Statement Ptr ()
statement) Int
columnIndex = do
Ptr () -> Int -> IO Double
columnDoubleC Ptr ()
statement Int
columnIndex
foreign import ccall "sqlite3_column_text"
columnTextC :: Ptr () -> Int -> IO CString
columnText :: Statement -> Int -> IO Text
columnText :: Statement -> Int -> IO Text
columnText (Statement Ptr ()
statement) Int
columnIndex = do
CString
text <- Ptr () -> Int -> IO CString
columnTextC Ptr ()
statement Int
columnIndex
Int
len <- Ptr () -> Int -> IO Int
columnBytesC Ptr ()
statement Int
columnIndex
ByteString
byteString <- CStringLen -> IO ByteString
BS.packCStringLen (CString
text, Int
len)
Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode ByteString
byteString
foreign import ccall "sqlite3_column_count"
columnCountC :: Ptr () -> IO Int
columnCount :: Statement -> IO Int
columnCount :: Statement -> IO Int
columnCount (Statement Ptr ()
statement) = do
Ptr () -> IO Int
columnCountC Ptr ()
statement
column :: Statement -> Int -> IO PersistValue
column :: Statement -> Int -> IO PersistValue
column Statement
statement Int
columnIndex = do
ColumnType
theType <- Statement -> Int -> IO ColumnType
columnType Statement
statement Int
columnIndex
case ColumnType
theType of
ColumnType
IntegerColumn -> do
Int64
int64 <- Statement -> Int -> IO Int64
columnInt64 Statement
statement Int
columnIndex
PersistValue -> IO PersistValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PersistValue -> IO PersistValue)
-> PersistValue -> IO PersistValue
forall a b. (a -> b) -> a -> b
$ Int64 -> PersistValue
PersistInt64 Int64
int64
ColumnType
FloatColumn -> do
Double
double <- Statement -> Int -> IO Double
columnDouble Statement
statement Int
columnIndex
PersistValue -> IO PersistValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PersistValue -> IO PersistValue)
-> PersistValue -> IO PersistValue
forall a b. (a -> b) -> a -> b
$ Double -> PersistValue
PersistDouble Double
double
ColumnType
TextColumn -> do
Text
text <- Statement -> Int -> IO Text
columnText Statement
statement Int
columnIndex
PersistValue -> IO PersistValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PersistValue -> IO PersistValue)
-> PersistValue -> IO PersistValue
forall a b. (a -> b) -> a -> b
$ Text -> PersistValue
PersistText Text
text
ColumnType
BlobColumn -> do
ByteString
byteString <- Statement -> Int -> IO ByteString
columnBlob Statement
statement Int
columnIndex
PersistValue -> IO PersistValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PersistValue -> IO PersistValue)
-> PersistValue -> IO PersistValue
forall a b. (a -> b) -> a -> b
$ ByteString -> PersistValue
PersistByteString ByteString
byteString
ColumnType
NullColumn -> PersistValue -> IO PersistValue
forall (m :: * -> *) a. Monad m => a -> m a
return PersistValue
PersistNull
columns :: Statement -> IO [PersistValue]
columns :: Statement -> IO [PersistValue]
columns Statement
statement = do
Int
count <- Statement -> IO Int
columnCount Statement
statement
(Int -> IO PersistValue) -> [Int] -> IO [PersistValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Int
i -> Statement -> Int -> IO PersistValue
column Statement
statement Int
i) [Int
0..Int
countInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
foreign import ccall "sqlite3_changes"
changesC :: Connection' -> IO Int
changes :: Connection -> IO Int64
changes :: Connection -> IO Int64
changes (Connection IORef Bool
_ Connection'
c) = (Int -> Int64) -> IO Int -> IO Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO Int -> IO Int64) -> IO Int -> IO Int64
forall a b. (a -> b) -> a -> b
$ Connection' -> IO Int
changesC Connection'
c
type RawLogFunction = Ptr () -> Int -> CString -> IO ()
foreign import ccall "wrapper"
mkRawLogFunction :: RawLogFunction -> IO (FunPtr RawLogFunction)
newtype LogFunction = LogFunction (FunPtr RawLogFunction)
mkLogFunction :: (Int -> String -> IO ()) -> IO LogFunction
mkLogFunction :: (Int -> String -> IO ()) -> IO LogFunction
mkLogFunction Int -> String -> IO ()
fn = (FunPtr RawLogFunction -> LogFunction)
-> IO (FunPtr RawLogFunction) -> IO LogFunction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FunPtr RawLogFunction -> LogFunction
LogFunction (IO (FunPtr RawLogFunction) -> IO LogFunction)
-> (RawLogFunction -> IO (FunPtr RawLogFunction))
-> RawLogFunction
-> IO LogFunction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawLogFunction -> IO (FunPtr RawLogFunction)
mkRawLogFunction (RawLogFunction -> IO LogFunction)
-> RawLogFunction -> IO LogFunction
forall a b. (a -> b) -> a -> b
$ \Ptr ()
_ Int
errCode CString
cmsg -> do
String
msg <- CString -> IO String
peekCString CString
cmsg
Int -> String -> IO ()
fn Int
errCode String
msg
freeLogFunction :: LogFunction -> IO ()
freeLogFunction :: LogFunction -> IO ()
freeLogFunction (LogFunction FunPtr RawLogFunction
fn) = FunPtr RawLogFunction -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr RawLogFunction
fn
data Config
= ConfigLogFn LogFunction
foreign import ccall "persistent_sqlite_set_log"
set_logC :: FunPtr RawLogFunction -> Ptr () -> IO Int
config :: Config -> IO ()
config :: Config -> IO ()
config Config
c = case Config
c of
ConfigLogFn (LogFunction FunPtr RawLogFunction
rawLogFn) -> do
Error
e <- (Int -> Error) -> IO Int -> IO Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Error
decodeError (IO Int -> IO Error) -> IO Int -> IO Error
forall a b. (a -> b) -> a -> b
$ FunPtr RawLogFunction -> Ptr () -> IO Int
set_logC FunPtr RawLogFunction
rawLogFn Ptr ()
forall a. Ptr a
nullPtr
case Error
e of
Error
ErrorOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Error
_ -> Maybe Connection -> Text -> Error -> IO ()
forall a. Maybe Connection -> Text -> Error -> IO a
sqlError Maybe Connection
forall a. Maybe a
Nothing Text
"sqlite3_config" Error
e
data SqliteStatus = SqliteStatus
{ SqliteStatus -> Maybe Int
sqliteStatusCurrent :: Maybe Int
, SqliteStatus -> Maybe Int
sqliteStatusHighwater :: Maybe Int
} deriving (SqliteStatus -> SqliteStatus -> Bool
(SqliteStatus -> SqliteStatus -> Bool)
-> (SqliteStatus -> SqliteStatus -> Bool) -> Eq SqliteStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SqliteStatus -> SqliteStatus -> Bool
$c/= :: SqliteStatus -> SqliteStatus -> Bool
== :: SqliteStatus -> SqliteStatus -> Bool
$c== :: SqliteStatus -> SqliteStatus -> Bool
Eq, Int -> SqliteStatus -> ShowS
[SqliteStatus] -> ShowS
SqliteStatus -> String
(Int -> SqliteStatus -> ShowS)
-> (SqliteStatus -> String)
-> ([SqliteStatus] -> ShowS)
-> Show SqliteStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SqliteStatus] -> ShowS
$cshowList :: [SqliteStatus] -> ShowS
show :: SqliteStatus -> String
$cshow :: SqliteStatus -> String
showsPrec :: Int -> SqliteStatus -> ShowS
$cshowsPrec :: Int -> SqliteStatus -> ShowS
Show)
data SqliteStatusVerb
= SqliteStatusMemoryUsed
| SqliteStatusPagecacheUsed
| SqliteStatusPagecacheOverflow
| SqliteStatusScratchUsed
| SqliteStatusScratchOverflow
| SqliteStatusMallocSize
| SqliteStatusPagecacheSize
| SqliteStatusScratchSize
| SqliteStatusMallocCount
statusVerbInfo :: SqliteStatusVerb -> (CInt, Bool, Bool)
statusVerbInfo :: SqliteStatusVerb -> (CInt, Bool, Bool)
statusVerbInfo SqliteStatusVerb
v = case SqliteStatusVerb
v of
SqliteStatusVerb
SqliteStatusMemoryUsed -> (CInt
0, Bool
True, Bool
True)
SqliteStatusVerb
SqliteStatusPagecacheUsed -> (CInt
1, Bool
True, Bool
True)
SqliteStatusVerb
SqliteStatusPagecacheOverflow -> (CInt
2, Bool
True, Bool
True)
SqliteStatusVerb
SqliteStatusScratchUsed -> (CInt
3, Bool
True, Bool
True)
SqliteStatusVerb
SqliteStatusScratchOverflow -> (CInt
4, Bool
True, Bool
True)
SqliteStatusVerb
SqliteStatusMallocSize -> (CInt
5, Bool
False, Bool
True)
SqliteStatusVerb
SqliteStatusPagecacheSize -> (CInt
7, Bool
False, Bool
True)
SqliteStatusVerb
SqliteStatusScratchSize -> (CInt
8, Bool
False, Bool
True)
SqliteStatusVerb
SqliteStatusMallocCount -> (CInt
9, Bool
True, Bool
True)
foreign import ccall "sqlite3_status"
statusC :: CInt -> Ptr CInt -> Ptr CInt -> CInt -> IO Int
status :: SqliteStatusVerb -> Bool -> IO SqliteStatus
status :: SqliteStatusVerb -> Bool -> IO SqliteStatus
status SqliteStatusVerb
verb Bool
reset' = (Ptr CInt -> IO SqliteStatus) -> IO SqliteStatus
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO SqliteStatus) -> IO SqliteStatus)
-> (Ptr CInt -> IO SqliteStatus) -> IO SqliteStatus
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
pCurrent -> (Ptr CInt -> IO SqliteStatus) -> IO SqliteStatus
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO SqliteStatus) -> IO SqliteStatus)
-> (Ptr CInt -> IO SqliteStatus) -> IO SqliteStatus
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
pHighwater -> do
let (CInt
code, Bool
hasCurrent, Bool
hasHighwater) = SqliteStatusVerb -> (CInt, Bool, Bool)
statusVerbInfo SqliteStatusVerb
verb
Error
e <- Int -> Error
decodeError (Int -> Error) -> IO Int -> IO Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> Ptr CInt -> Ptr CInt -> CInt -> IO Int
statusC CInt
code Ptr CInt
pCurrent Ptr CInt
pHighwater (if Bool
reset' then CInt
1 else CInt
0)
case Error
e of
Error
ErrorOK -> do
Maybe Int
current <- if Bool
hasCurrent then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> (CInt -> Int) -> CInt -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Maybe Int) -> IO CInt -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
pCurrent else Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
Maybe Int
highwater <- if Bool
hasHighwater then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> (CInt -> Int) -> CInt -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Maybe Int) -> IO CInt -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
pHighwater else Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
SqliteStatus -> IO SqliteStatus
forall (m :: * -> *) a. Monad m => a -> m a
return (SqliteStatus -> IO SqliteStatus)
-> SqliteStatus -> IO SqliteStatus
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> SqliteStatus
SqliteStatus Maybe Int
current Maybe Int
highwater
Error
_ -> Maybe Connection -> Text -> Error -> IO SqliteStatus
forall a. Maybe Connection -> Text -> Error -> IO a
sqlError Maybe Connection
forall a. Maybe a
Nothing Text
"sqlite3_status" Error
e
foreign import ccall "sqlite3_soft_heap_limit64"
softHeapLimit64C :: CLLong -> IO CLLong
softHeapLimit :: Int64 -> IO Int64
softHeapLimit :: Int64 -> IO Int64
softHeapLimit Int64
x = CLLong -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CLLong -> Int64) -> IO CLLong -> IO Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CLLong -> IO CLLong
softHeapLimit64C (Int64 -> CLLong
CLLong Int64
x)