{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-} -- Pattern match 'PersistDbSpecific'
-- | A port of the direct-sqlite package for dealing directly with
-- 'PersistValue's.
module Database.Sqlite  (
                         Connection,
                         Statement,
                         Error(..),
                         SqliteException(..),
                         StepResult(Row, Done),
                         Config(ConfigLogFn),
                         LogFunction,
                         SqliteStatus (..),
                         SqliteStatusVerb (..),
    -- * Basic usage guide
    -- |
    --
    -- Note that the example code shown here is a low level interface
    -- usage. Let's create a small demo sqlite3 database which we will
    -- use in our program:
    --
    -- > $ sqlite3 ~/test.db
    -- > sqlite> create table t1(a,b);
    -- > sqlite> insert into t1(a,b) values (1,1);
    -- > sqlite> insert into t1(a,b) values (2,2);
    -- > sqlite> select * from t1;
    -- > 1|1
    -- > 2|2
    --
    -- Now let's write code using the functions in this module to
    -- fetch the rows from the table:
    --
    -- > {-#LANGUAGE OverloadedStrings#-}
    -- >
    -- > import Database.Sqlite
    -- > import Data.Text
    -- >
    -- > main :: IO ()
    -- > main = do
    -- >   conn <- open "/home/sibi/test.db"
    -- >   smt <- prepare conn "select * from t1;"
    -- >   row1 <- step smt >> columns smt
    -- >   row2 <- step smt >> columns smt
    -- >   print (row1, row2)
    -- >   finalize smt
    -- >   close conn
    --
    -- On executing the above code:
    --
    -- > $ ./demo-program
    -- > $ ([PersistInt64 1,PersistInt64 1],[PersistInt64 2,PersistInt64 2])

                         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(..))

-- | A custom exception type to make it easier to catch exceptions.
--
-- @since 2.1.3
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
    -- for all sqlite flags, check out https://www.sqlite.org/c3ref/open.html
    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


-- @since 2.9.2
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

-- @since 2.9.2
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

-- | Execute a database statement. It's recommended to use 'stepConn' instead, because it gives better error messages.
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

-- | Execute a database statement. This function uses the 'Connection' passed to it to give better error messages than 'step'.
--
-- @since 2.6.4
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 () -- FIXME confirm this is correct sqlError Nothing "reset" error
      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 () -- sqlError Nothing "finalize" error

-- Taken from: https://github.com/IreneKnapp/direct-sqlite/blob/master/Database/SQLite3/Direct.hs
-- | Like 'unsafeUseAsCStringLen', but if the string is empty,
-- never pass the callback a null pointer.
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 -- copy of PersistList's definition
            PersistObjectId ByteString
_ -> String -> IO ()
forall a. HasCallStack => String -> a
P.error String
"Refusing to serialize a PersistObjectId to a SQLite value"

            -- I know one of these is broken, but the docs for `sqlite3_bind_text` aren't very illuminating.
            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

-- | Log function callback. Arguments are error code and log message.
--
-- @since 2.1.4
type RawLogFunction = Ptr () -> Int -> CString -> IO ()

foreign import ccall "wrapper"
  mkRawLogFunction :: RawLogFunction -> IO (FunPtr RawLogFunction)

-- |
-- @since 2.1.4
newtype LogFunction = LogFunction (FunPtr RawLogFunction)

-- | Wraps a given function to a 'LogFunction' to be further used with 'ConfigLogFn'.
-- First argument of given function will take error code, second - log message.
-- Returned value should be released with 'freeLogFunction' when no longer required.
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

-- | Releases a native FunPtr for the 'LogFunction'.
--
-- @since 2.1.4
freeLogFunction :: LogFunction -> IO ()
freeLogFunction :: LogFunction -> IO ()
freeLogFunction (LogFunction FunPtr RawLogFunction
fn) = FunPtr RawLogFunction -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr RawLogFunction
fn

-- | Configuration option for SQLite to be used together with the 'config' function.
--
-- @since 2.1.4
data Config
  -- | A function to be used for logging
  = ConfigLogFn LogFunction

foreign import ccall "persistent_sqlite_set_log"
  set_logC :: FunPtr RawLogFunction -> Ptr () -> IO Int

-- | Sets SQLite global configuration parameter. See SQLite documentation for the <https://www.sqlite.org/c3ref/config.html sqlite3_config> function.
-- In short, this must be called prior to any other SQLite function if you want the call to succeed.
--
-- @since 2.1.4
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

-- | Return type of the 'status' function
--
-- @since 2.6.1
data SqliteStatus = SqliteStatus
  { SqliteStatus -> Maybe Int
sqliteStatusCurrent   :: Maybe Int
  -- ^ The current value of the parameter. Some parameters do not record current value.
  , SqliteStatus -> Maybe Int
sqliteStatusHighwater :: Maybe Int
  -- ^ The highest recorded value. Some parameters do not record the highest value.
  } 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)

-- | Run-time status parameter that can be returned by 'status' function.
--
-- @since 2.6.1
data SqliteStatusVerb
  -- | This parameter is the current amount of memory checked out using sqlite3_malloc(),
  -- either directly or indirectly. The figure includes calls made to sqlite3_malloc()
  -- by the application and internal memory usage by the SQLite library. Scratch memory
  -- controlled by SQLITE_CONFIG_SCRATCH and auxiliary page-cache memory controlled by
  -- SQLITE_CONFIG_PAGECACHE is not included in this parameter. The amount returned is
  -- the sum of the allocation sizes as reported by the xSize method in sqlite3_mem_methods.
  = SqliteStatusMemoryUsed
  -- | This parameter returns the number of pages used out of the pagecache memory
  -- allocator that was configured using SQLITE_CONFIG_PAGECACHE. The value returned
  -- is in pages, not in bytes.
  | SqliteStatusPagecacheUsed
  -- | This parameter returns the number of bytes of page cache allocation which
  -- could not be satisfied by the SQLITE_CONFIG_PAGECACHE buffer and where forced
  -- to overflow to sqlite3_malloc(). The returned value includes allocations that
  -- overflowed because they where too large (they were larger than the "sz"
  -- parameter to SQLITE_CONFIG_PAGECACHE) and allocations that overflowed because
  -- no space was left in the page cache.
  | SqliteStatusPagecacheOverflow
  -- | This parameter returns the number of allocations used out of the scratch
  -- memory allocator configured using SQLITE_CONFIG_SCRATCH. The value returned
  -- is in allocations, not in bytes. Since a single thread may only have one
  -- scratch allocation outstanding at time, this parameter also reports the
  -- number of threads using scratch memory at the same time.
  | SqliteStatusScratchUsed
  -- | This parameter returns the number of bytes of scratch memory allocation
  -- which could not be satisfied by the SQLITE_CONFIG_SCRATCH buffer and where
  -- forced to overflow to sqlite3_malloc(). The values returned include overflows
  -- because the requested allocation was too larger (that is, because the requested
  -- allocation was larger than the "sz" parameter to SQLITE_CONFIG_SCRATCH) and
  -- because no scratch buffer slots were available.
  | SqliteStatusScratchOverflow
  -- | This parameter records the largest memory allocation request handed to
  -- sqlite3_malloc() or sqlite3_realloc() (or their internal equivalents). Only
  -- the value returned in 'sqliteStatusHighwater' field of 'SqliteStatus' record
  -- is of interest. The value written into the 'sqliteStatusCurrent' field is Nothing.
  | SqliteStatusMallocSize
  -- | This parameter records the largest memory allocation request handed to
  -- pagecache memory allocator. Only the value returned in the 'sqliteStatusHighwater'
  -- field of 'SqliteStatus' record is of interest. The value written into the
  -- 'sqliteStatusCurrent' field is Nothing.
  | SqliteStatusPagecacheSize
  -- | This parameter records the largest memory allocation request handed to
  -- scratch memory allocator. Only the value returned in the 'sqliteStatusHighwater'
  -- field of 'SqliteStatus' record is of interest. The value written into the
  -- 'sqliteStatusCurrent' field is Nothing.
  | SqliteStatusScratchSize
  -- | This parameter records the number of separate memory allocations currently
  -- checked out.
  | SqliteStatusMallocCount

-- Internal function to convert status parameter to a triple of its integral
-- constant and two bools indicating if native sqlite3_status function actually
-- modifies values at pCurrent and pHighwater pointers.
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

-- | Retrieves runtime status information about the performance of SQLite,
-- and optionally resets various highwater marks. The first argument is a
-- status parameter to measure, the second is reset flag. If reset flag is
-- True then the highest recorded value is reset after being returned from
-- this function.
--
-- @since 2.6.1
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

-- | Sets and/or queries the soft limit on the amount of heap memory that may be
-- allocated by SQLite. If the argument is zero then the soft heap limit is disabled.
-- If the argument is negative then no change is made to the soft heap limit. Hence,
-- the current size of the soft heap limit can be determined by invoking
-- this function with a negative argument.
--
-- @since 2.6.1
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)