{-# 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 -> [Char]
show (SqliteException Error
error Text
functionName Text
details) = Text -> [Char]
unpack forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
Data.Monoid.mconcat
[Text
"SQLite3 returned "
, [Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
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
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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> [Char]
$cshow :: Error -> [Char]
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show)
data StepResult = Row | Done deriving (StepResult -> StepResult -> Bool
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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [StepResult] -> ShowS
$cshowList :: [StepResult] -> ShowS
show :: StepResult -> [Char]
$cshow :: StepResult -> [Char]
showsPrec :: Int -> StepResult -> ShowS
$cshowsPrec :: Int -> StepResult -> ShowS
Show)
data ColumnType = IntegerColumn
| FloatColumn
| TextColumn
| BlobColumn
| NullColumn
deriving (ColumnType -> ColumnType -> Bool
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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ColumnType] -> ShowS
$cshowList :: [ColumnType] -> ShowS
show :: ColumnType -> [Char]
$cshow :: ColumnType -> [Char]
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 = forall a. HasCallStack => [Char] -> a
P.error forall a b. (a -> b) -> a -> b
$ [Char]
"decodeError " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
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 = forall a. HasCallStack => [Char] -> a
P.error forall a b. (a -> b) -> a -> b
$ [Char]
"decodeColumnType " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode ByteString
byteString
sqlError :: Maybe Connection -> Text -> Error -> IO a
sqlError :: forall a. 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
": " forall a. Monoid a => a -> a -> a
`Data.Monoid.mappend` Text
details
Maybe Connection
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
"."
forall e a. Exception e => e -> IO a
throwIO 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 forall a. Bits a => a -> a -> a
.|. Int
sqliteFlagCreate forall a. Bits a => a -> a -> a
.|. Int
sqliteFlagUri
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString (Text -> ByteString
encodeUtf8 Text
path') forall a b. (a -> b) -> a -> b
$ \CString
path -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
database -> do
Error
err <- Int -> Error
decodeError 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 forall a. Ptr a
nullPtr
case Error
err of
Error
ErrorOK -> do Ptr ()
database' <- forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr ())
database
IORef Bool
active <- forall a. a -> IO (IORef a)
newIORef Bool
True
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ IORef Bool -> Connection' -> Connection
Connection IORef Bool
active forall a b. (a -> b) -> a -> b
$ Ptr () -> Connection'
Connection' Ptr ()
database'
Error
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return Connection
database
Right Error
error -> forall a. Maybe Connection -> Text -> Error -> IO a
sqlError forall a. Maybe a
Nothing (Text
"open " forall a. Monoid a => a -> a -> a
`mappend` ([Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
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
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
iactive Bool
False
Int
error <- Ptr () -> IO Int
closeC Ptr ()
database
forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Error
_ -> forall a. Maybe Connection -> Text -> Error -> IO a
sqlError (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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Error
_ -> forall a. Maybe Connection -> Text -> Error -> IO a
sqlError (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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Error
_ -> forall a. Maybe Connection -> Text -> Error -> IO a
sqlError (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
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString (Text -> ByteString
encodeUtf8 Text
text')
(\CString
text -> do
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 forall a. Ptr a
nullPtr
Error
error <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Error
decodeError Int
error'
case Error
error of
Error
ErrorOK -> do
Ptr ()
statement' <- forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr ())
statement
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Ptr () -> Statement
Statement Ptr ()
statement'
Error
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return Statement
statement
Right Error
error -> forall a. Maybe Connection -> Text -> Error -> IO a
sqlError (forall a. a -> Maybe a
Just Connection
database) (Text
"prepare " forall a. Monoid a => a -> a -> a
`mappend` ([Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
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
forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return StepResult
Row
Error
ErrorDone -> forall (m :: * -> *) a. Monad m => a -> m a
return StepResult
Done
Error
_ -> forall a. Maybe Connection -> Text -> Error -> IO a
sqlError 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return StepResult
Row
Error
ErrorDone -> forall (m :: * -> *) a. Monad m => a -> m a
return StepResult
Done
Error
_ -> forall a. Maybe Connection -> Text -> Error -> IO a
sqlError (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
forall (m :: * -> *) a. Monad m => a -> m a
return 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 <- 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Error
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
else 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
forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Error
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
unsafeUseAsCStringLenNoNull
:: BS.ByteString
-> (CString -> Int -> IO a)
-> IO a
unsafeUseAsCStringLenNoNull :: forall a. 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 (forall a. IntPtr -> Ptr a
intPtrToPtr IntPtr
1) Int
0
| Bool
otherwise = forall a. ByteString -> (CStringLen -> IO a) -> IO a
BSU.unsafeUseAsCStringLen ByteString
bs forall a b. (a -> b) -> a -> b
$ \(CString
ptr, Int
len) ->
CString -> Int -> IO a
cb CString
ptr (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 =
forall a. ByteString -> (CString -> Int -> IO a) -> IO a
unsafeUseAsCStringLenNoNull ByteString
byteString 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 (forall a b. Ptr a -> Ptr b
castPtr CString
dataC) Int
size
(forall a. IntPtr -> Ptr a
intPtrToPtr (-IntPtr
1))
forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Error
_ -> forall a. Maybe Connection -> Text -> Error -> IO a
sqlError 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
forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Error
_ -> forall a. Maybe Connection -> Text -> Error -> IO a
sqlError 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
forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Error
_ -> forall a. Maybe Connection -> Text -> Error -> IO a
sqlError 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
forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Error
_ -> forall a. Maybe Connection -> Text -> Error -> IO a
sqlError 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
forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Error
_ -> forall a. Maybe Connection -> Text -> Error -> IO a
sqlError 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 =
forall a. ByteString -> (CString -> Int -> IO a) -> IO a
unsafeUseAsCStringLenNoNull (Text -> ByteString
encodeUtf8 Text
text) 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 (forall a. IntPtr -> Ptr a
intPtrToPtr (-IntPtr
1))
forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Error
_ -> forall a. Maybe Connection -> Text -> Error -> IO a
sqlError forall a. Maybe a
Nothing Text
"bind text" Error
error
bind :: Statement -> [PersistValue] -> IO ()
bind :: Statement -> [PersistValue] -> IO ()
bind Statement
statement [PersistValue]
sqlData = do
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 forall a b. (a -> b) -> a -> b
$ [Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show (forall a. Fractional a => Rational -> a
fromRational Rational
rational :: Pico)
PersistBool Bool
b -> Statement -> Int -> Int64 -> IO ()
bindInt64 Statement
statement Int
parameterIndex 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 forall a b. (a -> b) -> a -> b
$ [Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Day
d
PersistTimeOfDay TimeOfDay
d -> Statement -> Int -> Text -> IO ()
bindText Statement
statement Int
parameterIndex forall a b. (a -> b) -> a -> b
$ [Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show TimeOfDay
d
PersistUTCTime UTCTime
d -> Statement -> Int -> Text -> IO ()
bindText Statement
statement Int
parameterIndex forall a b. (a -> b) -> a -> b
$ [Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ UTCTime -> [Char]
format8601 UTCTime
d
PersistList [PersistValue]
l -> Statement -> Int -> Text -> IO ()
bindText Statement
statement Int
parameterIndex 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 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 forall a b. (a -> b) -> a -> b
$ [PersistValue] -> Text
listToJSON [PersistValue]
a
PersistObjectId ByteString
_ -> forall a. HasCallStack => [Char] -> a
P.error [Char]
"Refusing to serialize a PersistObjectId to a SQLite value"
PersistLiteral_ LiteralType
DbSpecific ByteString
s -> Statement -> Int -> Text -> IO ()
bindText Statement
statement Int
parameterIndex 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 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 forall a b. (a -> b) -> a -> b
$ OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode ByteString
e
)
forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [PersistValue]
sqlData
forall (m :: * -> *) a. Monad m => a -> m a
return ()
format8601 :: UTCTime -> String
format8601 :: UTCTime -> [Char]
format8601 = forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%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
forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. Eq a => a -> a -> Bool
/= forall a. Ptr a
nullPtr
then Ptr Word8 -> Ptr Word8 -> Int -> IO ()
BSI.memcpy Ptr Word8
resultPtr (forall a b. Ptr a -> Ptr b
castPtr Ptr ()
dataPtr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)
else 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)
forall (m :: * -> *) a. Monad m => a -> m a
return 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
forall (m :: * -> *) a. Monad m => a -> m a
return 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
forall (m :: * -> *) a. Monad m => a -> m a
return 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
forall (m :: * -> *) a. Monad m => a -> m a
return 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> PersistValue
PersistByteString ByteString
byteString
ColumnType
NullColumn -> 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
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
countforall 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) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 -> [Char] -> IO ()) -> IO LogFunction
mkLogFunction Int -> [Char] -> IO ()
fn = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FunPtr RawLogFunction -> LogFunction
LogFunction forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawLogFunction -> IO (FunPtr RawLogFunction)
mkRawLogFunction forall a b. (a -> b) -> a -> b
$ \Ptr ()
_ Int
errCode CString
cmsg -> do
[Char]
msg <- CString -> IO [Char]
peekCString CString
cmsg
Int -> [Char] -> IO ()
fn Int
errCode [Char]
msg
freeLogFunction :: LogFunction -> IO ()
freeLogFunction :: LogFunction -> IO ()
freeLogFunction (LogFunction FunPtr RawLogFunction
fn) = 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 <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Error
decodeError forall a b. (a -> b) -> a -> b
$ FunPtr RawLogFunction -> Ptr () -> IO Int
set_logC FunPtr RawLogFunction
rawLogFn forall a. Ptr a
nullPtr
case Error
e of
Error
ErrorOK -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Error
_ -> forall a. Maybe Connection -> Text -> Error -> IO a
sqlError 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
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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SqliteStatus] -> ShowS
$cshowList :: [SqliteStatus] -> ShowS
show :: SqliteStatus -> [Char]
$cshow :: SqliteStatus -> [Char]
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' = forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CInt
pCurrent -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca 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 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 forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
pCurrent else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Maybe Int
highwater <- if Bool
hasHighwater then forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
pHighwater else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> SqliteStatus
SqliteStatus Maybe Int
current Maybe Int
highwater
Error
_ -> forall a. Maybe Connection -> Text -> Error -> IO a
sqlError 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CLLong -> IO CLLong
softHeapLimit64C (Int64 -> CLLong
CLLong Int64
x)