{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
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 Data.Typeable (Typeable)
import Database.Sqlite.Internal (Connection(..), Connection'(..), Statement(..))
import Foreign
import Foreign.C
import Database.Persist (PersistValue (..), listToJSON, mapToJSON)
data SqliteException = SqliteException
{ SqliteException -> Error
seError :: !Error
, SqliteException -> Text
seFunctionName :: !Text
, SqliteException -> Text
seDetails :: !Text
}
deriving (Typeable)
instance Show SqliteException where
show :: SqliteException -> String
show (SqliteException error :: Error
error functionName :: Text
functionName details :: 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
["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
, " 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 0 = Error
ErrorOK
decodeError 1 = Error
ErrorError
decodeError 2 = Error
ErrorInternal
decodeError 3 = Error
ErrorPermission
decodeError 4 = Error
ErrorAbort
decodeError 5 = Error
ErrorBusy
decodeError 6 = Error
ErrorLocked
decodeError 7 = Error
ErrorNoMemory
decodeError 8 = Error
ErrorReadOnly
decodeError 9 = Error
ErrorInterrupt
decodeError 10 = Error
ErrorIO
decodeError 11 = Error
ErrorNotFound
decodeError 12 = Error
ErrorCorrupt
decodeError 13 = Error
ErrorFull
decodeError 14 = Error
ErrorCan'tOpen
decodeError 15 = Error
ErrorProtocol
decodeError 16 = Error
ErrorEmpty
decodeError 17 = Error
ErrorSchema
decodeError 18 = Error
ErrorTooBig
decodeError 19 = Error
ErrorConstraint
decodeError 20 = Error
ErrorMismatch
decodeError 21 = Error
ErrorMisuse
decodeError 22 = Error
ErrorNoLargeFileSupport
decodeError 23 = Error
ErrorAuthorization
decodeError 24 = Error
ErrorFormat
decodeError 25 = Error
ErrorRange
decodeError 26 = Error
ErrorNotAConnection
decodeError 100 = Error
ErrorRow
decodeError 101 = Error
ErrorDone
decodeError i :: Int
i = String -> Error
forall a. HasCallStack => String -> a
P.error (String -> Error) -> String -> Error
forall a b. (a -> b) -> a -> b
$ "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 1 = ColumnType
IntegerColumn
decodeColumnType 2 = ColumnType
FloatColumn
decodeColumnType 3 = ColumnType
TextColumn
decodeColumnType 4 = ColumnType
BlobColumn
decodeColumnType 5 = ColumnType
NullColumn
decodeColumnType i :: Int
i = String -> ColumnType
forall a. HasCallStack => String -> a
P.error (String -> ColumnType) -> String -> ColumnType
forall a b. (a -> b) -> a -> b
$ "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 _ (Connection' database :: 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 maybeConnection :: Maybe Connection
maybeConnection functionName :: Text
functionName error :: Error
error = do
Text
details <- case Maybe Connection
maybeConnection of
Just database :: 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
forall a. Monoid a => a -> a -> a
`Data.Monoid.mappend` Text
details
Nothing -> Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return "."
SqliteException -> IO a
forall e a. Exception e => e -> IO a
throwIO $WSqliteException :: 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 path' :: 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
$ \path :: 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
$ \database :: 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
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'
_ -> 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 = 0x2
sqliteFlagCreate :: Int
sqliteFlagCreate = 0x4
sqliteFlagUri :: Int
sqliteFlagUri = 0x40
open :: Text -> IO Connection
open :: Text -> IO Connection
open path :: Text
path = do
Either Connection Error
databaseOrError <- Text -> IO (Either Connection Error)
openError Text
path
case Either Connection Error
databaseOrError of
Left database :: Connection
database -> Connection -> IO Connection
forall (m :: * -> *) a. Monad m => a -> m a
return Connection
database
Right error :: Error
error -> Maybe Connection -> Text -> Error -> IO Connection
forall a. Maybe Connection -> Text -> Error -> IO a
sqlError Maybe Connection
forall a. Maybe a
Nothing ("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 iactive :: IORef Bool
iactive (Connection' database :: 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 database :: Connection
database = do
Error
error <- Connection -> IO Error
closeError Connection
database
case Error
error of
ErrorOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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) "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 _ (Connection' database :: Ptr ()
database)) = do
Int
error <- Ptr () -> Int -> IO Int
sqlite3_extended_result_codesC Ptr ()
database 1
let err :: Error
err = Int -> Error
decodeError Int
error
case Error
err of
ErrorOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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) "enableExtendedResultCodes" Error
err
disableExtendedResultCodes :: Connection -> IO ()
disableExtendedResultCodes :: Connection -> IO ()
disableExtendedResultCodes con :: Connection
con@(Connection _ (Connection' database :: Ptr ()
database)) = do
Int
error <- Ptr () -> Int -> IO Int
sqlite3_extended_result_codesC Ptr ()
database 0
let err :: Error
err = Int -> Error
decodeError Int
error
case Error
err of
ErrorOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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) "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 _ (Connection' database :: Ptr ()
database)) text' :: 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')
(\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 (\statement :: Ptr (Ptr ())
statement -> do
Int
error' <- Ptr () -> CString -> Int -> Ptr (Ptr ()) -> Ptr (Ptr ()) -> IO Int
prepareC Ptr ()
database CString
text (-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
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'
_ -> 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 database :: Connection
database text :: 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 -> Statement -> IO Statement
forall (m :: * -> *) a. Monad m => a -> m a
return Statement
statement
Right error :: 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) ("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 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
statement = do
Error
error <- Statement -> IO Error
stepError Statement
statement
case Error
error of
ErrorRow -> StepResult -> IO StepResult
forall (m :: * -> *) a. Monad m => a -> m a
return StepResult
Row
ErrorDone -> StepResult -> IO StepResult
forall (m :: * -> *) a. Monad m => a -> m a
return StepResult
Done
_ -> Maybe Connection -> Text -> Error -> IO StepResult
forall a. Maybe Connection -> Text -> Error -> IO a
sqlError Maybe Connection
forall a. Maybe a
Nothing "step" Error
error
stepConn :: Connection -> Statement -> IO StepResult
stepConn :: Connection -> Statement -> IO StepResult
stepConn database :: Connection
database statement :: Statement
statement = do
Error
error <- Statement -> IO Error
stepError Statement
statement
case Error
error of
ErrorRow -> StepResult -> IO StepResult
forall (m :: * -> *) a. Monad m => a -> m a
return StepResult
Row
ErrorDone -> StepResult -> IO StepResult
forall (m :: * -> *) a. Monad m => a -> m a
return StepResult
Done
_ -> 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) "step" Error
error
foreign import ccall "sqlite3_reset"
resetC :: Ptr () -> IO Int
resetError :: Statement -> IO Error
resetError :: Statement -> IO Error
resetError (Statement 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 iactive :: IORef Bool
iactive _) statement :: 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
ErrorOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> () -> 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 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
statement = do
Error
error <- Statement -> IO Error
finalizeError Statement
statement
case Error
error of
ErrorOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> () -> 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 bs :: ByteString
bs cb :: CString -> Int -> IO a
cb
| ByteString -> Bool
BS.null ByteString
bs = CString -> Int -> IO a
cb (IntPtr -> CString
forall a. IntPtr -> Ptr a
intPtrToPtr 1) 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
$ \(ptr :: CString
ptr, len :: 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 statement :: Ptr ()
statement) parameterIndex :: Int
parameterIndex byteString :: 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
$ \dataC :: CString
dataC size :: 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 (-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
statement parameterIndex :: Int
parameterIndex byteString :: ByteString
byteString = do
Error
error <- Statement -> Int -> ByteString -> IO Error
bindBlobError Statement
statement Int
parameterIndex ByteString
byteString
case Error
error of
ErrorOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> Maybe Connection -> Text -> Error -> IO ()
forall a. Maybe Connection -> Text -> Error -> IO a
sqlError Maybe Connection
forall a. Maybe a
Nothing "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 statement :: Ptr ()
statement) parameterIndex :: Int
parameterIndex datum :: 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
statement parameterIndex :: Int
parameterIndex datum :: Double
datum = do
Error
error <- Statement -> Int -> Double -> IO Error
bindDoubleError Statement
statement Int
parameterIndex Double
datum
case Error
error of
ErrorOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> Maybe Connection -> Text -> Error -> IO ()
forall a. Maybe Connection -> Text -> Error -> IO a
sqlError Maybe Connection
forall a. Maybe a
Nothing "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 statement :: Ptr ()
statement) parameterIndex :: Int
parameterIndex datum :: 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
statement parameterIndex :: Int
parameterIndex datum :: Int
datum = do
Error
error <- Statement -> Int -> Int -> IO Error
bindIntError Statement
statement Int
parameterIndex Int
datum
case Error
error of
ErrorOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> Maybe Connection -> Text -> Error -> IO ()
forall a. Maybe Connection -> Text -> Error -> IO a
sqlError Maybe Connection
forall a. Maybe a
Nothing "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 statement :: Ptr ()
statement) parameterIndex :: Int
parameterIndex datum :: 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
statement parameterIndex :: Int
parameterIndex datum :: Int64
datum = do
Error
error <- Statement -> Int -> Int64 -> IO Error
bindInt64Error Statement
statement Int
parameterIndex Int64
datum
case Error
error of
ErrorOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> Maybe Connection -> Text -> Error -> IO ()
forall a. Maybe Connection -> Text -> Error -> IO a
sqlError Maybe Connection
forall a. Maybe a
Nothing "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 statement :: Ptr ()
statement) parameterIndex :: 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
statement parameterIndex :: Int
parameterIndex = do
Error
error <- Statement -> Int -> IO Error
bindNullError Statement
statement Int
parameterIndex
case Error
error of
ErrorOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> Maybe Connection -> Text -> Error -> IO ()
forall a. Maybe Connection -> Text -> Error -> IO a
sqlError Maybe Connection
forall a. Maybe a
Nothing "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 statement :: Ptr ()
statement) parameterIndex :: Int
parameterIndex text :: 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
$ \dataC :: CString
dataC size :: 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 (-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
statement parameterIndex :: Int
parameterIndex text :: Text
text = do
Error
error <- Statement -> Int -> Text -> IO Error
bindTextError Statement
statement Int
parameterIndex Text
text
case Error
error of
ErrorOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> Maybe Connection -> Text -> Error -> IO ()
forall a. Maybe Connection -> Text -> Error -> IO a
sqlError Maybe Connection
forall a. Maybe a
Nothing "bind text" Error
error
bind :: Statement -> [PersistValue] -> IO ()
bind :: Statement -> [PersistValue] -> IO ()
bind statement :: Statement
statement sqlData :: [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_ (\(parameterIndex :: Int
parameterIndex, datum :: PersistValue
datum) -> do
case PersistValue
datum of
PersistInt64 int64 :: Int64
int64 -> Statement -> Int -> Int64 -> IO ()
bindInt64 Statement
statement Int
parameterIndex Int64
int64
PersistDouble double :: Double
double -> Statement -> Int -> Double -> IO ()
bindDouble Statement
statement Int
parameterIndex Double
double
PersistRational rational :: 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 b :: 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 1 else 0
PersistText text :: Text
text -> Statement -> Int -> Text -> IO ()
bindText Statement
statement Int
parameterIndex Text
text
PersistByteString blob :: ByteString
blob -> Statement -> Int -> ByteString -> IO ()
bindBlob Statement
statement Int
parameterIndex ByteString
blob
PersistNull -> Statement -> Int -> IO ()
bindNull Statement
statement Int
parameterIndex
PersistDay d :: 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 d :: 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 d :: 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 l :: [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 m :: [(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
PersistDbSpecific s :: 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
PersistArray a :: [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 _ -> String -> IO ()
forall a. HasCallStack => String -> a
P.error "Refusing to serialize a PersistObjectId to a SQLite value"
)
([(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 [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 "%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 statement :: Ptr ()
statement) columnIndex :: 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 statement :: Ptr ()
statement) columnIndex :: Int
columnIndex = do
Int
size <- Ptr () -> Int -> IO Int
columnBytesC Ptr ()
statement Int
columnIndex
Int -> (Ptr Word8 -> IO ()) -> IO ByteString
BSI.create Int
size (\resultPtr :: 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 statement :: Ptr ()
statement) columnIndex :: 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 statement :: Ptr ()
statement) columnIndex :: 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 statement :: Ptr ()
statement) columnIndex :: 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 statement :: Ptr ()
statement) = do
Ptr () -> IO Int
columnCountC Ptr ()
statement
column :: Statement -> Int -> IO PersistValue
column :: Statement -> Int -> IO PersistValue
column statement :: Statement
statement columnIndex :: Int
columnIndex = do
ColumnType
theType <- Statement -> Int -> IO ColumnType
columnType Statement
statement Int
columnIndex
case ColumnType
theType of
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
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
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
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
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
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 (\i :: Int
i -> Statement -> Int -> IO PersistValue
column Statement
statement Int
i) [0..Int
countInt -> Int -> Int
forall a. Num a => a -> a -> a
-1]
foreign import ccall "sqlite3_changes"
changesC :: Connection' -> IO Int
changes :: Connection -> IO Int64
changes :: Connection -> IO Int64
changes (Connection _ c :: 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 fn :: 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
$ \_ errCode :: Int
errCode cmsg :: 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 fn :: 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 c :: Config
c = case Config
c of
ConfigLogFn (LogFunction rawLogFn :: 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
ErrorOK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> Maybe Connection -> Text -> Error -> IO ()
forall a. Maybe Connection -> Text -> Error -> IO a
sqlError Maybe Connection
forall a. Maybe a
Nothing "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 v :: SqliteStatusVerb
v = case SqliteStatusVerb
v of
SqliteStatusMemoryUsed -> (0, Bool
True, Bool
True)
SqliteStatusPagecacheUsed -> (1, Bool
True, Bool
True)
SqliteStatusPagecacheOverflow -> (2, Bool
True, Bool
True)
SqliteStatusScratchUsed -> (3, Bool
True, Bool
True)
SqliteStatusScratchOverflow -> (4, Bool
True, Bool
True)
SqliteStatusMallocSize -> (5, Bool
False, Bool
True)
SqliteStatusPagecacheSize -> (7, Bool
False, Bool
True)
SqliteStatusScratchSize -> (8, Bool
False, Bool
True)
SqliteStatusMallocCount -> (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 verb :: SqliteStatusVerb
verb reset' :: 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
$ \pCurrent :: 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
$ \pHighwater :: Ptr CInt
pHighwater -> do
let (code :: CInt
code, hasCurrent :: Bool
hasCurrent, hasHighwater :: 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 1 else 0)
case Error
e of
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
_ -> Maybe Connection -> Text -> Error -> IO SqliteStatus
forall a. Maybe Connection -> Text -> Error -> IO a
sqlError Maybe Connection
forall a. Maybe a
Nothing "sqlite3_status" Error
e
foreign import ccall "sqlite3_soft_heap_limit64"
softHeapLimit64C :: CLLong -> IO CLLong
softHeapLimit :: Int64 -> IO Int64
softHeapLimit :: Int64 -> IO Int64
softHeapLimit x :: 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)