{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, GeneralizedNewtypeDeriving, ScopedTypeVariables, GADTs #-}

------------------------------------------------------------------------------
-- |
-- Module:      Database.SQLite.Simple
-- Copyright:   (c) 2011 MailRank, Inc.
--              (c) 2011-2012 Leon P Smith
--              (c) 2012-2013 Janne Hellsten
-- License:     BSD3
-- Maintainer:  Janne Hellsten <jjhellst@gmail.com>
-- Portability: portable
--
------------------------------------------------------------------------------

module Database.SQLite.Simple (
    -- ** Examples of use
    -- $use

    -- ** The Query type
    -- $querytype

    -- ** Parameter substitution
    -- $subst

    -- *** Positional parameters
    -- $substpos

    -- *** Named parameters
    -- $substnamed

    -- *** Type inference
    -- $inference

    -- ** Substituting a single parameter
    -- $only_param

    -- * Extracting results
    -- $result

    -- ** Handling null values
    -- $null

    -- ** Type conversions
    -- $types

    -- *** Conversion to/from UTCTime
    -- $utctime

    Query(..)
  , Connection(..)
  , ToRow(..)
  , FromRow(..)
  , Only(..)
  , (:.)(..)
  , Base.SQLData(..)
  , Statement(..)
  , ColumnIndex(..)
  , NamedParam(..)
    -- * Connections
  , open
  , close
  , withConnection
  , setTrace
    -- * Queries that return results
  , query
  , query_
  , queryWith
  , queryWith_
  , queryNamed
  , lastInsertRowId
  , changes
  , totalChanges
    -- * Queries that stream results
  , fold
  , fold_
  , foldNamed
    -- * Statements that do not return results
  , execute
  , execute_
  , executeMany
  , executeNamed
  , field
    -- * Transactions
  , withTransaction
  , withImmediateTransaction
  , withExclusiveTransaction
    -- * Low-level statement API for stream access and prepared statements
  , openStatement
  , closeStatement
  , withStatement
  , bind
  , bindNamed
  , reset
  , columnName
  , columnCount
  , withBind
  , nextRow
    -- ** Exceptions
  , FormatError(..)
  , ResultError(..)
  , Base.SQLError(..)
  , Base.Error(..)
  ) where

import           Control.Exception
import           Control.Monad (void, when, forM_)
import           Control.Monad.Trans.Reader
import           Control.Monad.Trans.State.Strict
import           Data.Int (Int64)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import           Data.Typeable (Typeable)
import           Database.SQLite.Simple.Types
import qualified Database.SQLite3 as Base
import qualified Database.SQLite3.Direct as BaseD


import           Database.SQLite.Simple.FromField (ResultError(..))
import           Database.SQLite.Simple.FromRow
import           Database.SQLite.Simple.Internal
import           Database.SQLite.Simple.Ok
import           Database.SQLite.Simple.ToField (ToField(..))
import           Database.SQLite.Simple.ToRow (ToRow(..))

-- | An SQLite prepared statement.
newtype Statement = Statement { Statement -> Statement
unStatement :: Base.Statement }

-- | Index of a column in a result set. Column indices start from 0.
newtype ColumnIndex = ColumnIndex BaseD.ColumnIndex
    deriving (ColumnIndex -> ColumnIndex -> Bool
(ColumnIndex -> ColumnIndex -> Bool)
-> (ColumnIndex -> ColumnIndex -> Bool) -> Eq ColumnIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnIndex -> ColumnIndex -> Bool
$c/= :: ColumnIndex -> ColumnIndex -> Bool
== :: ColumnIndex -> ColumnIndex -> Bool
$c== :: ColumnIndex -> ColumnIndex -> Bool
Eq, Eq ColumnIndex
Eq ColumnIndex =>
(ColumnIndex -> ColumnIndex -> Ordering)
-> (ColumnIndex -> ColumnIndex -> Bool)
-> (ColumnIndex -> ColumnIndex -> Bool)
-> (ColumnIndex -> ColumnIndex -> Bool)
-> (ColumnIndex -> ColumnIndex -> Bool)
-> (ColumnIndex -> ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex -> ColumnIndex)
-> Ord ColumnIndex
ColumnIndex -> ColumnIndex -> Bool
ColumnIndex -> ColumnIndex -> Ordering
ColumnIndex -> ColumnIndex -> ColumnIndex
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ColumnIndex -> ColumnIndex -> ColumnIndex
$cmin :: ColumnIndex -> ColumnIndex -> ColumnIndex
max :: ColumnIndex -> ColumnIndex -> ColumnIndex
$cmax :: ColumnIndex -> ColumnIndex -> ColumnIndex
>= :: ColumnIndex -> ColumnIndex -> Bool
$c>= :: ColumnIndex -> ColumnIndex -> Bool
> :: ColumnIndex -> ColumnIndex -> Bool
$c> :: ColumnIndex -> ColumnIndex -> Bool
<= :: ColumnIndex -> ColumnIndex -> Bool
$c<= :: ColumnIndex -> ColumnIndex -> Bool
< :: ColumnIndex -> ColumnIndex -> Bool
$c< :: ColumnIndex -> ColumnIndex -> Bool
compare :: ColumnIndex -> ColumnIndex -> Ordering
$ccompare :: ColumnIndex -> ColumnIndex -> Ordering
$cp1Ord :: Eq ColumnIndex
Ord, Int -> ColumnIndex
ColumnIndex -> Int
ColumnIndex -> [ColumnIndex]
ColumnIndex -> ColumnIndex
ColumnIndex -> ColumnIndex -> [ColumnIndex]
ColumnIndex -> ColumnIndex -> ColumnIndex -> [ColumnIndex]
(ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex)
-> (Int -> ColumnIndex)
-> (ColumnIndex -> Int)
-> (ColumnIndex -> [ColumnIndex])
-> (ColumnIndex -> ColumnIndex -> [ColumnIndex])
-> (ColumnIndex -> ColumnIndex -> [ColumnIndex])
-> (ColumnIndex -> ColumnIndex -> ColumnIndex -> [ColumnIndex])
-> Enum ColumnIndex
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ColumnIndex -> ColumnIndex -> ColumnIndex -> [ColumnIndex]
$cenumFromThenTo :: ColumnIndex -> ColumnIndex -> ColumnIndex -> [ColumnIndex]
enumFromTo :: ColumnIndex -> ColumnIndex -> [ColumnIndex]
$cenumFromTo :: ColumnIndex -> ColumnIndex -> [ColumnIndex]
enumFromThen :: ColumnIndex -> ColumnIndex -> [ColumnIndex]
$cenumFromThen :: ColumnIndex -> ColumnIndex -> [ColumnIndex]
enumFrom :: ColumnIndex -> [ColumnIndex]
$cenumFrom :: ColumnIndex -> [ColumnIndex]
fromEnum :: ColumnIndex -> Int
$cfromEnum :: ColumnIndex -> Int
toEnum :: Int -> ColumnIndex
$ctoEnum :: Int -> ColumnIndex
pred :: ColumnIndex -> ColumnIndex
$cpred :: ColumnIndex -> ColumnIndex
succ :: ColumnIndex -> ColumnIndex
$csucc :: ColumnIndex -> ColumnIndex
Enum, Integer -> ColumnIndex
ColumnIndex -> ColumnIndex
ColumnIndex -> ColumnIndex -> ColumnIndex
(ColumnIndex -> ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex)
-> (Integer -> ColumnIndex)
-> Num ColumnIndex
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> ColumnIndex
$cfromInteger :: Integer -> ColumnIndex
signum :: ColumnIndex -> ColumnIndex
$csignum :: ColumnIndex -> ColumnIndex
abs :: ColumnIndex -> ColumnIndex
$cabs :: ColumnIndex -> ColumnIndex
negate :: ColumnIndex -> ColumnIndex
$cnegate :: ColumnIndex -> ColumnIndex
* :: ColumnIndex -> ColumnIndex -> ColumnIndex
$c* :: ColumnIndex -> ColumnIndex -> ColumnIndex
- :: ColumnIndex -> ColumnIndex -> ColumnIndex
$c- :: ColumnIndex -> ColumnIndex -> ColumnIndex
+ :: ColumnIndex -> ColumnIndex -> ColumnIndex
$c+ :: ColumnIndex -> ColumnIndex -> ColumnIndex
Num, Num ColumnIndex
Ord ColumnIndex
(Num ColumnIndex, Ord ColumnIndex) =>
(ColumnIndex -> Rational) -> Real ColumnIndex
ColumnIndex -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
toRational :: ColumnIndex -> Rational
$ctoRational :: ColumnIndex -> Rational
$cp2Real :: Ord ColumnIndex
$cp1Real :: Num ColumnIndex
Real, Enum ColumnIndex
Real ColumnIndex
(Real ColumnIndex, Enum ColumnIndex) =>
(ColumnIndex -> ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex -> (ColumnIndex, ColumnIndex))
-> (ColumnIndex -> ColumnIndex -> (ColumnIndex, ColumnIndex))
-> (ColumnIndex -> Integer)
-> Integral ColumnIndex
ColumnIndex -> Integer
ColumnIndex -> ColumnIndex -> (ColumnIndex, ColumnIndex)
ColumnIndex -> ColumnIndex -> ColumnIndex
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: ColumnIndex -> Integer
$ctoInteger :: ColumnIndex -> Integer
divMod :: ColumnIndex -> ColumnIndex -> (ColumnIndex, ColumnIndex)
$cdivMod :: ColumnIndex -> ColumnIndex -> (ColumnIndex, ColumnIndex)
quotRem :: ColumnIndex -> ColumnIndex -> (ColumnIndex, ColumnIndex)
$cquotRem :: ColumnIndex -> ColumnIndex -> (ColumnIndex, ColumnIndex)
mod :: ColumnIndex -> ColumnIndex -> ColumnIndex
$cmod :: ColumnIndex -> ColumnIndex -> ColumnIndex
div :: ColumnIndex -> ColumnIndex -> ColumnIndex
$cdiv :: ColumnIndex -> ColumnIndex -> ColumnIndex
rem :: ColumnIndex -> ColumnIndex -> ColumnIndex
$crem :: ColumnIndex -> ColumnIndex -> ColumnIndex
quot :: ColumnIndex -> ColumnIndex -> ColumnIndex
$cquot :: ColumnIndex -> ColumnIndex -> ColumnIndex
$cp2Integral :: Enum ColumnIndex
$cp1Integral :: Real ColumnIndex
Integral)

data NamedParam where
    (:=) :: (ToField v) => T.Text -> v -> NamedParam

data TransactionType = Deferred | Immediate | Exclusive

infixr 3 :=

instance Show NamedParam where
  show :: NamedParam -> String
show (k :: Text
k := v :: v
v) = (Text, SQLData) -> String
forall a. Show a => a -> String
show (Text
k, v -> SQLData
forall a. ToField a => a -> SQLData
toField v
v)

-- | Exception thrown if a 'Query' was malformed.
-- This may occur if the number of \'@?@\' characters in the query
-- string does not match the number of parameters provided.
data FormatError = FormatError {
      FormatError -> String
fmtMessage :: String
    , FormatError -> Query
fmtQuery   :: Query
    , FormatError -> [String]
fmtParams  :: [String]
    } deriving (FormatError -> FormatError -> Bool
(FormatError -> FormatError -> Bool)
-> (FormatError -> FormatError -> Bool) -> Eq FormatError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormatError -> FormatError -> Bool
$c/= :: FormatError -> FormatError -> Bool
== :: FormatError -> FormatError -> Bool
$c== :: FormatError -> FormatError -> Bool
Eq, Int -> FormatError -> ShowS
[FormatError] -> ShowS
FormatError -> String
(Int -> FormatError -> ShowS)
-> (FormatError -> String)
-> ([FormatError] -> ShowS)
-> Show FormatError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormatError] -> ShowS
$cshowList :: [FormatError] -> ShowS
show :: FormatError -> String
$cshow :: FormatError -> String
showsPrec :: Int -> FormatError -> ShowS
$cshowsPrec :: Int -> FormatError -> ShowS
Show, Typeable)

instance Exception FormatError

-- | Open a database connection to a given file.  Will throw an
-- exception if it cannot connect.
--
-- Every 'open' must be closed with a call to 'close'.
--
-- If you specify \":memory:\" or an empty string as the input filename,
-- then a private, temporary in-memory database is created for the
-- connection.  This database will vanish when you close the
-- connection.
open :: String -> IO Connection
open :: String -> IO Connection
open fname :: String
fname = Database -> Connection
Connection (Database -> Connection) -> IO Database -> IO Connection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> IO Database
Base.open (String -> Text
T.pack String
fname)

-- | Close a database connection.
close :: Connection -> IO ()
close :: Connection -> IO ()
close (Connection c :: Database
c) = Database -> IO ()
Base.close Database
c

-- | Opens a database connection, executes an action using this connection, and
-- closes the connection, even in the presence of exceptions.
withConnection :: String -> (Connection -> IO a) -> IO a
withConnection :: String -> (Connection -> IO a) -> IO a
withConnection connString :: String
connString = IO Connection
-> (Connection -> IO ()) -> (Connection -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (String -> IO Connection
open String
connString) Connection -> IO ()
close

unUtf8 :: BaseD.Utf8 -> T.Text
unUtf8 :: Utf8 -> Text
unUtf8 (BaseD.Utf8 bs :: ByteString
bs) = ByteString -> Text
TE.decodeUtf8 ByteString
bs

-- | <http://www.sqlite.org/c3ref/profile.html>
--
-- Enable/disable tracing of SQL execution.  Tracing can be disabled
-- by setting 'Nothing' as the logger callback.
--
-- Warning: If the logger callback throws an exception, your whole
-- program may crash.  Enable only for debugging!
setTrace :: Connection -> Maybe (T.Text -> IO ()) -> IO ()
setTrace :: Connection -> Maybe (Text -> IO ()) -> IO ()
setTrace (Connection db :: Database
db) logger :: Maybe (Text -> IO ())
logger =
  Database -> Maybe (Utf8 -> IO ()) -> IO ()
BaseD.setTrace Database
db (((Text -> IO ()) -> Utf8 -> IO ())
-> Maybe (Text -> IO ()) -> Maybe (Utf8 -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\lf :: Text -> IO ()
lf -> Text -> IO ()
lf (Text -> IO ()) -> (Utf8 -> Text) -> Utf8 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8 -> Text
unUtf8) Maybe (Text -> IO ())
logger)

-- | Binds parameters to a prepared statement. Once 'nextRow' returns 'Nothing',
-- the statement must be reset with the 'reset' function before it can be
-- executed again by calling 'nextRow'.
bind :: (ToRow params) => Statement -> params -> IO ()
bind :: Statement -> params -> IO ()
bind (Statement stmt :: Statement
stmt) params :: params
params = do
  let qp :: [SQLData]
qp = params -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow params
params
  ParamIndex
stmtParamCount <- Statement -> IO ParamIndex
Base.bindParameterCount Statement
stmt
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([SQLData] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SQLData]
qp Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= ParamIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ParamIndex
stmtParamCount) ([SQLData] -> ParamIndex -> IO ()
throwColumnMismatch [SQLData]
qp ParamIndex
stmtParamCount)
  (ParamIndex -> IO ()) -> [ParamIndex] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([SQLData] -> ParamIndex -> IO ()
errorCheckParamName [SQLData]
qp) [1..ParamIndex
stmtParamCount]
  Statement -> [SQLData] -> IO ()
Base.bind Statement
stmt [SQLData]
qp
  where
    throwColumnMismatch :: [SQLData] -> ParamIndex -> IO ()
throwColumnMismatch qp :: [SQLData]
qp nParams :: ParamIndex
nParams = do
      Query
templ <- Statement -> IO Query
getQuery Statement
stmt
      String -> Query -> [SQLData] -> IO ()
forall v a. Show v => String -> Query -> [v] -> a
fmtError ("SQL query contains " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ParamIndex -> String
forall a. Show a => a -> String
show ParamIndex
nParams String -> ShowS
forall a. [a] -> [a] -> [a]
++ " params, but " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                Int -> String
forall a. Show a => a -> String
show ([SQLData] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SQLData]
qp) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " arguments given") Query
templ [SQLData]
qp
    errorCheckParamName :: [SQLData] -> ParamIndex -> IO ()
errorCheckParamName qp :: [SQLData]
qp paramNdx :: ParamIndex
paramNdx = do
      Query
templ <- Statement -> IO Query
getQuery Statement
stmt
      Maybe Text
name <- Statement -> ParamIndex -> IO (Maybe Text)
Base.bindParameterName Statement
stmt ParamIndex
paramNdx
      case Maybe Text
name of
        Just n :: Text
n ->
          String -> Query -> [SQLData] -> IO ()
forall v a. Show v => String -> Query -> [v] -> a
fmtError ("Only unnamed '?' query parameters are accepted, '"String -> ShowS
forall a. [a] -> [a] -> [a]
++Text -> String
T.unpack Text
nString -> ShowS
forall a. [a] -> [a] -> [a]
++"' given")
                    Query
templ [SQLData]
qp
        Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$! ()

-- | Binds named parameters to a prepared statement.
bindNamed :: Statement -> [NamedParam] -> IO ()
bindNamed :: Statement -> [NamedParam] -> IO ()
bindNamed (Statement stmt :: Statement
stmt) params :: [NamedParam]
params = do
  ParamIndex
stmtParamCount <- Statement -> IO ParamIndex
Base.bindParameterCount Statement
stmt
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([NamedParam] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NamedParam]
params Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= ParamIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ParamIndex
stmtParamCount) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ParamIndex -> IO ()
throwColumnMismatch ParamIndex
stmtParamCount
  Statement -> [NamedParam] -> IO ()
bind Statement
stmt [NamedParam]
params
  where
    bind :: Statement -> [NamedParam] -> IO ()
bind stmt :: Statement
stmt params :: [NamedParam]
params =
      (NamedParam -> IO ()) -> [NamedParam] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(n :: Text
n := v :: v
v) -> do
              Maybe ParamIndex
idx <- Statement -> Utf8 -> IO (Maybe ParamIndex)
BaseD.bindParameterIndex Statement
stmt (ByteString -> Utf8
BaseD.Utf8 (ByteString -> Utf8) -> (Text -> ByteString) -> Text -> Utf8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8 (Text -> Utf8) -> Text -> Utf8
forall a b. (a -> b) -> a -> b
$ Text
n)
              case Maybe ParamIndex
idx of
                Just i :: ParamIndex
i ->
                  Statement -> ParamIndex -> SQLData -> IO ()
Base.bindSQLData Statement
stmt ParamIndex
i (v -> SQLData
forall a. ToField a => a -> SQLData
toField v
v)
                Nothing -> do
                  Query
templ <- Statement -> IO Query
getQuery Statement
stmt
                  String -> Query -> [NamedParam] -> IO ()
forall v a. Show v => String -> Query -> [v] -> a
fmtError ("Unknown named parameter '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ "'")
                    Query
templ [NamedParam]
params)
            [NamedParam]
params

    throwColumnMismatch :: ParamIndex -> IO ()
throwColumnMismatch nParams :: ParamIndex
nParams = do
      Query
templ <- Statement -> IO Query
getQuery Statement
stmt
      String -> Query -> [NamedParam] -> IO ()
forall v a. Show v => String -> Query -> [v] -> a
fmtError ("SQL query contains " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ParamIndex -> String
forall a. Show a => a -> String
show ParamIndex
nParams String -> ShowS
forall a. [a] -> [a] -> [a]
++ " params, but " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                Int -> String
forall a. Show a => a -> String
show ([NamedParam] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NamedParam]
params) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " arguments given") Query
templ [NamedParam]
params

-- | Resets a statement. This does not reset bound parameters, if any, but
-- allows the statement to be reexecuted again by invoking 'nextRow'.
reset :: Statement -> IO ()
reset :: Statement -> IO ()
reset (Statement stmt :: Statement
stmt) = Statement -> IO ()
Base.reset Statement
stmt

-- | Return the name of a a particular column in the result set of a
-- 'Statement'.  Throws an 'ArrayException' if the colum index is out
-- of bounds.
--
-- <http://www.sqlite.org/c3ref/column_name.html>
columnName :: Statement -> ColumnIndex -> IO T.Text
columnName :: Statement -> ColumnIndex -> IO Text
columnName (Statement stmt :: Statement
stmt) (ColumnIndex n :: ColumnIndex
n) = Statement -> ColumnIndex -> IO (Maybe Utf8)
BaseD.columnName Statement
stmt ColumnIndex
n IO (Maybe Utf8) -> (Maybe Utf8 -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Utf8 -> IO Text
takeUtf8
  where
    takeUtf8 :: Maybe Utf8 -> IO Text
takeUtf8 (Just s :: Utf8
s) = 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
$ Utf8 -> Text
unUtf8 Utf8
s
    takeUtf8 Nothing  =
      ArrayException -> IO Text
forall e a. Exception e => e -> IO a
throwIO (String -> ArrayException
IndexOutOfBounds ("Column index " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ColumnIndex -> String
forall a. Show a => a -> String
show ColumnIndex
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ " out of bounds"))

-- | Return number of columns in the query
columnCount :: Statement -> IO ColumnIndex
columnCount :: Statement -> IO ColumnIndex
columnCount (Statement stmt :: Statement
stmt) = ColumnIndex -> ColumnIndex
ColumnIndex (ColumnIndex -> ColumnIndex) -> IO ColumnIndex -> IO ColumnIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Statement -> IO ColumnIndex
BaseD.columnCount Statement
stmt

-- | Binds parameters to a prepared statement, and 'reset's the statement when
-- the callback completes, even in the presence of exceptions.
--
-- Use 'withBind' to reuse prepared statements.  Because it 'reset's the
-- statement /after/ each usage, it avoids a pitfall involving implicit
-- transactions.  SQLite creates an implicit transaction if you don't say
-- @BEGIN@ explicitly, and does not commit it until all active statements are
-- finished with either 'reset' or 'closeStatement'.
withBind :: (ToRow params) => Statement -> params -> IO a -> IO a
withBind :: Statement -> params -> IO a -> IO a
withBind stmt :: Statement
stmt params :: params
params io :: IO a
io = do
  Statement -> params -> IO ()
forall params. ToRow params => Statement -> params -> IO ()
bind Statement
stmt params
params
  IO a
io IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`finally` Statement -> IO ()
reset Statement
stmt

-- | Opens a prepared statement. A prepared statement must always be closed with
-- a corresponding call to 'closeStatement' before closing the connection. Use
-- 'nextRow' to iterate on the values returned. Once 'nextRow' returns
-- 'Nothing', you need to invoke 'reset' before reexecuting the statement again
-- with 'nextRow'.
openStatement :: Connection -> Query -> IO Statement
openStatement :: Connection -> Query -> IO Statement
openStatement (Connection c :: Database
c) (Query t :: Text
t) = do
  Statement
stmt <- Database -> Text -> IO Statement
Base.prepare Database
c Text
t
  Statement -> IO Statement
forall (m :: * -> *) a. Monad m => a -> m a
return (Statement -> IO Statement) -> Statement -> IO Statement
forall a b. (a -> b) -> a -> b
$ Statement -> Statement
Statement Statement
stmt

-- | Closes a prepared statement.
closeStatement :: Statement -> IO ()
closeStatement :: Statement -> IO ()
closeStatement (Statement stmt :: Statement
stmt) = Statement -> IO ()
Base.finalize Statement
stmt

-- | Opens a prepared statement, executes an action using this statement, and
-- closes the statement, even in the presence of exceptions.
withStatement :: Connection -> Query -> (Statement -> IO a) -> IO a
withStatement :: Connection -> Query -> (Statement -> IO a) -> IO a
withStatement conn :: Connection
conn query :: Query
query = IO Statement -> (Statement -> IO ()) -> (Statement -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Connection -> Query -> IO Statement
openStatement Connection
conn Query
query) Statement -> IO ()
closeStatement

-- A version of 'withStatement' which binds parameters.
withStatementParams :: (ToRow params)
                       => Connection
                       -> Query
                       -> params
                       -> (Statement -> IO a)
                       -> IO a
withStatementParams :: Connection -> Query -> params -> (Statement -> IO a) -> IO a
withStatementParams conn :: Connection
conn template :: Query
template params :: params
params action :: Statement -> IO a
action =
  Connection -> Query -> (Statement -> IO a) -> IO a
forall a. Connection -> Query -> (Statement -> IO a) -> IO a
withStatement Connection
conn Query
template ((Statement -> IO a) -> IO a) -> (Statement -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \stmt :: Statement
stmt ->
    -- Don't use withBind here, there is no need to reset the parameters since
    -- we're destroying the statement
    Statement -> [SQLData] -> IO ()
forall params. ToRow params => Statement -> params -> IO ()
bind Statement
stmt (params -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow params
params) IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Statement -> IO a
action Statement
stmt

-- A version of 'withStatement' which binds named parameters.
withStatementNamedParams :: Connection
                         -> Query
                         -> [NamedParam]
                         -> (Statement -> IO a)
                         -> IO a
withStatementNamedParams :: Connection -> Query -> [NamedParam] -> (Statement -> IO a) -> IO a
withStatementNamedParams conn :: Connection
conn template :: Query
template namedParams :: [NamedParam]
namedParams action :: Statement -> IO a
action =
  Connection -> Query -> (Statement -> IO a) -> IO a
forall a. Connection -> Query -> (Statement -> IO a) -> IO a
withStatement Connection
conn Query
template ((Statement -> IO a) -> IO a) -> (Statement -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \stmt :: Statement
stmt -> Statement -> [NamedParam] -> IO ()
bindNamed Statement
stmt [NamedParam]
namedParams IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Statement -> IO a
action Statement
stmt

-- | Execute an @INSERT@, @UPDATE@, or other SQL query that is not
-- expected to return results.
--
-- Throws 'FormatError' if the query could not be formatted correctly.
execute :: (ToRow q) => Connection -> Query -> q -> IO ()
execute :: Connection -> Query -> q -> IO ()
execute conn :: Connection
conn template :: Query
template qs :: q
qs =
  Connection -> Query -> q -> (Statement -> IO ()) -> IO ()
forall params a.
ToRow params =>
Connection -> Query -> params -> (Statement -> IO a) -> IO a
withStatementParams Connection
conn Query
template q
qs ((Statement -> IO ()) -> IO ()) -> (Statement -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Statement stmt :: Statement
stmt) ->
    IO StepResult -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO StepResult -> IO ())
-> (Statement -> IO StepResult) -> Statement -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Statement -> IO StepResult
Base.step (Statement -> IO ()) -> Statement -> IO ()
forall a b. (a -> b) -> a -> b
$ Statement
stmt

-- | Execute a multi-row @INSERT@, @UPDATE@, or other SQL query that is not
-- expected to return results.
--
-- Throws 'FormatError' if the query could not be formatted correctly.
executeMany :: ToRow q => Connection -> Query -> [q] -> IO ()
executeMany :: Connection -> Query -> [q] -> IO ()
executeMany conn :: Connection
conn template :: Query
template paramRows :: [q]
paramRows = Connection -> Query -> (Statement -> IO ()) -> IO ()
forall a. Connection -> Query -> (Statement -> IO a) -> IO a
withStatement Connection
conn Query
template ((Statement -> IO ()) -> IO ()) -> (Statement -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \stmt :: Statement
stmt -> do
  let Statement stmt' :: Statement
stmt' = Statement
stmt
  [q] -> (q -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [q]
paramRows ((q -> IO ()) -> IO ()) -> (q -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \params :: q
params ->
    Statement -> q -> IO () -> IO ()
forall params a.
ToRow params =>
Statement -> params -> IO a -> IO a
withBind Statement
stmt q
params
      (IO StepResult -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO StepResult -> IO ())
-> (Statement -> IO StepResult) -> Statement -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Statement -> IO StepResult
Base.step (Statement -> IO ()) -> Statement -> IO ()
forall a b. (a -> b) -> a -> b
$ Statement
stmt')


doFoldToList :: RowParser row -> Statement -> IO [row]
doFoldToList :: RowParser row -> Statement -> IO [row]
doFoldToList fromRow_ :: RowParser row
fromRow_ stmt :: Statement
stmt =
  ([row] -> [row]) -> IO [row] -> IO [row]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [row] -> [row]
forall a. [a] -> [a]
reverse (IO [row] -> IO [row]) -> IO [row] -> IO [row]
forall a b. (a -> b) -> a -> b
$ RowParser row
-> Statement -> [row] -> ([row] -> row -> IO [row]) -> IO [row]
forall row a.
RowParser row -> Statement -> a -> (a -> row -> IO a) -> IO a
doFold RowParser row
fromRow_ Statement
stmt [] (\acc :: [row]
acc e :: row
e -> [row] -> IO [row]
forall (m :: * -> *) a. Monad m => a -> m a
return (row
e row -> [row] -> [row]
forall a. a -> [a] -> [a]
: [row]
acc))

-- | Perform a @SELECT@ or other SQL query that is expected to return
-- results. All results are retrieved and converted before this
-- function returns.
--
-- When processing large results, this function will consume a lot of
-- client-side memory.  Consider using 'fold' instead.
--
-- Exceptions that may be thrown:
--
-- * 'FormatError': the query string mismatched with given arguments.
--
-- * 'ResultError': result conversion failed.
query :: (ToRow q, FromRow r)
         => Connection -> Query -> q -> IO [r]
query :: Connection -> Query -> q -> IO [r]
query = RowParser r -> Connection -> Query -> q -> IO [r]
forall q r.
ToRow q =>
RowParser r -> Connection -> Query -> q -> IO [r]
queryWith RowParser r
forall a. FromRow a => RowParser a
fromRow

-- | A version of 'query' that does not perform query substitution.
query_ :: (FromRow r) => Connection -> Query -> IO [r]
query_ :: Connection -> Query -> IO [r]
query_ = RowParser r -> Connection -> Query -> IO [r]
forall r. RowParser r -> Connection -> Query -> IO [r]
queryWith_ RowParser r
forall a. FromRow a => RowParser a
fromRow

-- | A version of 'query' that takes an explicit 'RowParser'.
queryWith :: (ToRow q) => RowParser r -> Connection -> Query -> q -> IO [r]
queryWith :: RowParser r -> Connection -> Query -> q -> IO [r]
queryWith fromRow_ :: RowParser r
fromRow_ conn :: Connection
conn templ :: Query
templ qs :: q
qs =
  Connection -> Query -> q -> (Statement -> IO [r]) -> IO [r]
forall params a.
ToRow params =>
Connection -> Query -> params -> (Statement -> IO a) -> IO a
withStatementParams Connection
conn Query
templ q
qs ((Statement -> IO [r]) -> IO [r])
-> (Statement -> IO [r]) -> IO [r]
forall a b. (a -> b) -> a -> b
$ \stmt :: Statement
stmt -> RowParser r -> Statement -> IO [r]
forall row. RowParser row -> Statement -> IO [row]
doFoldToList RowParser r
fromRow_ Statement
stmt

-- | A version of 'query' that does not perform query substitution and
-- takes an explicit 'RowParser'.
queryWith_ :: RowParser r -> Connection -> Query -> IO [r]
queryWith_ :: RowParser r -> Connection -> Query -> IO [r]
queryWith_ fromRow_ :: RowParser r
fromRow_ conn :: Connection
conn query :: Query
query =
  Connection -> Query -> (Statement -> IO [r]) -> IO [r]
forall a. Connection -> Query -> (Statement -> IO a) -> IO a
withStatement Connection
conn Query
query (RowParser r -> Statement -> IO [r]
forall row. RowParser row -> Statement -> IO [row]
doFoldToList RowParser r
fromRow_)

-- | A version of 'query' where the query parameters (placeholders)
-- are named.
--
-- Example:
--
-- @
-- r \<- 'queryNamed' c \"SELECT * FROM posts WHERE id=:id AND date>=:date\" [\":id\" ':=' postId, \":date\" ':=' afterDate]
-- @
queryNamed :: (FromRow r) => Connection -> Query -> [NamedParam] -> IO [r]
queryNamed :: Connection -> Query -> [NamedParam] -> IO [r]
queryNamed conn :: Connection
conn templ :: Query
templ params :: [NamedParam]
params =
  Connection
-> Query -> [NamedParam] -> (Statement -> IO [r]) -> IO [r]
forall a.
Connection -> Query -> [NamedParam] -> (Statement -> IO a) -> IO a
withStatementNamedParams Connection
conn Query
templ [NamedParam]
params ((Statement -> IO [r]) -> IO [r])
-> (Statement -> IO [r]) -> IO [r]
forall a b. (a -> b) -> a -> b
$ \stmt :: Statement
stmt -> RowParser r -> Statement -> IO [r]
forall row. RowParser row -> Statement -> IO [row]
doFoldToList RowParser r
forall a. FromRow a => RowParser a
fromRow Statement
stmt

-- | A version of 'execute' that does not perform query substitution.
execute_ :: Connection -> Query -> IO ()
execute_ :: Connection -> Query -> IO ()
execute_ conn :: Connection
conn template :: Query
template =
  Connection -> Query -> (Statement -> IO ()) -> IO ()
forall a. Connection -> Query -> (Statement -> IO a) -> IO a
withStatement Connection
conn Query
template ((Statement -> IO ()) -> IO ()) -> (Statement -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Statement stmt :: Statement
stmt) ->
    IO StepResult -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO StepResult -> IO ()) -> IO StepResult -> IO ()
forall a b. (a -> b) -> a -> b
$ Statement -> IO StepResult
Base.step Statement
stmt

-- | A version of 'execute' where the query parameters (placeholders)
-- are named.
executeNamed :: Connection -> Query -> [NamedParam] -> IO ()
executeNamed :: Connection -> Query -> [NamedParam] -> IO ()
executeNamed conn :: Connection
conn template :: Query
template params :: [NamedParam]
params =
  Connection
-> Query -> [NamedParam] -> (Statement -> IO ()) -> IO ()
forall a.
Connection -> Query -> [NamedParam] -> (Statement -> IO a) -> IO a
withStatementNamedParams Connection
conn Query
template [NamedParam]
params ((Statement -> IO ()) -> IO ()) -> (Statement -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Statement stmt :: Statement
stmt) ->
    IO StepResult -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO StepResult -> IO ()) -> IO StepResult -> IO ()
forall a b. (a -> b) -> a -> b
$ Statement -> IO StepResult
Base.step Statement
stmt

-- | Perform a @SELECT@ or other SQL query that is expected to return results.
-- Results are converted and fed into the 'action' callback as they are being
-- retrieved from the database.
--
-- This allows gives the possibility of processing results in constant space
-- (for instance writing them to disk).
--
-- Exceptions that may be thrown:
--
-- * 'FormatError': the query string mismatched with given arguments.
--
-- * 'ResultError': result conversion failed.
fold :: ( FromRow row, ToRow params )
        => Connection
        -> Query
        -> params
        -> a
        -> (a -> row -> IO a)
        -> IO a
fold :: Connection -> Query -> params -> a -> (a -> row -> IO a) -> IO a
fold conn :: Connection
conn query :: Query
query params :: params
params initalState :: a
initalState action :: a -> row -> IO a
action =
  Connection -> Query -> params -> (Statement -> IO a) -> IO a
forall params a.
ToRow params =>
Connection -> Query -> params -> (Statement -> IO a) -> IO a
withStatementParams Connection
conn Query
query params
params ((Statement -> IO a) -> IO a) -> (Statement -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \stmt :: Statement
stmt ->
    RowParser row -> Statement -> a -> (a -> row -> IO a) -> IO a
forall row a.
RowParser row -> Statement -> a -> (a -> row -> IO a) -> IO a
doFold RowParser row
forall a. FromRow a => RowParser a
fromRow Statement
stmt a
initalState a -> row -> IO a
action

-- | A version of 'fold' which does not perform parameter substitution.
fold_ :: ( FromRow row )
        => Connection
        -> Query
        -> a
        -> (a -> row -> IO a)
        -> IO a
fold_ :: Connection -> Query -> a -> (a -> row -> IO a) -> IO a
fold_ conn :: Connection
conn query :: Query
query initalState :: a
initalState action :: a -> row -> IO a
action =
  Connection -> Query -> (Statement -> IO a) -> IO a
forall a. Connection -> Query -> (Statement -> IO a) -> IO a
withStatement Connection
conn Query
query ((Statement -> IO a) -> IO a) -> (Statement -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \stmt :: Statement
stmt ->
    RowParser row -> Statement -> a -> (a -> row -> IO a) -> IO a
forall row a.
RowParser row -> Statement -> a -> (a -> row -> IO a) -> IO a
doFold RowParser row
forall a. FromRow a => RowParser a
fromRow Statement
stmt a
initalState a -> row -> IO a
action

-- | A version of 'fold' where the query parameters (placeholders) are
-- named.
foldNamed :: ( FromRow row )
          => Connection
          -> Query
          -> [NamedParam]
          -> a
          -> (a -> row -> IO a)
          -> IO a
foldNamed :: Connection
-> Query -> [NamedParam] -> a -> (a -> row -> IO a) -> IO a
foldNamed conn :: Connection
conn query :: Query
query params :: [NamedParam]
params initalState :: a
initalState action :: a -> row -> IO a
action =
  Connection -> Query -> [NamedParam] -> (Statement -> IO a) -> IO a
forall a.
Connection -> Query -> [NamedParam] -> (Statement -> IO a) -> IO a
withStatementNamedParams Connection
conn Query
query [NamedParam]
params ((Statement -> IO a) -> IO a) -> (Statement -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \stmt :: Statement
stmt ->
    RowParser row -> Statement -> a -> (a -> row -> IO a) -> IO a
forall row a.
RowParser row -> Statement -> a -> (a -> row -> IO a) -> IO a
doFold RowParser row
forall a. FromRow a => RowParser a
fromRow Statement
stmt a
initalState a -> row -> IO a
action

doFold :: RowParser row -> Statement ->  a -> (a -> row -> IO a) -> IO a
doFold :: RowParser row -> Statement -> a -> (a -> row -> IO a) -> IO a
doFold fromRow_ :: RowParser row
fromRow_ stmt :: Statement
stmt initState :: a
initState action :: a -> row -> IO a
action =
  a -> IO a
loop a
initState
  where
    loop :: a -> IO a
loop val :: a
val = do
      Maybe row
maybeNextRow <- RowParser row -> Statement -> IO (Maybe row)
forall r. RowParser r -> Statement -> IO (Maybe r)
nextRowWith RowParser row
fromRow_ Statement
stmt
      case Maybe row
maybeNextRow of
        Just row :: row
row  -> do
          a
val' <- a -> row -> IO a
action a
val row
row
          a
val' a -> IO a -> IO a
forall a b. a -> b -> b
`seq` a -> IO a
loop a
val'
        Nothing   -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val

-- | Extracts the next row from the prepared statement.
nextRow :: (FromRow r) => Statement -> IO (Maybe r)
nextRow :: Statement -> IO (Maybe r)
nextRow = RowParser r -> Statement -> IO (Maybe r)
forall r. RowParser r -> Statement -> IO (Maybe r)
nextRowWith RowParser r
forall a. FromRow a => RowParser a
fromRow

nextRowWith :: RowParser r -> Statement -> IO (Maybe r)
nextRowWith :: RowParser r -> Statement -> IO (Maybe r)
nextRowWith fromRow_ :: RowParser r
fromRow_ (Statement stmt :: Statement
stmt) = do
  StepResult
statRes <- Statement -> IO StepResult
Base.step Statement
stmt
  case StepResult
statRes of
    Base.Row -> do
      [SQLData]
rowRes <- Statement -> IO [SQLData]
Base.columns Statement
stmt
      let nCols :: Int
nCols = [SQLData] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SQLData]
rowRes
      r
row <- RowParser r -> [SQLData] -> Int -> IO r
forall r. RowParser r -> [SQLData] -> Int -> IO r
convertRow RowParser r
fromRow_ [SQLData]
rowRes Int
nCols
      Maybe r -> IO (Maybe r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe r -> IO (Maybe r)) -> Maybe r -> IO (Maybe r)
forall a b. (a -> b) -> a -> b
$ r -> Maybe r
forall a. a -> Maybe a
Just r
row
    Base.Done -> Maybe r -> IO (Maybe r)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe r
forall a. Maybe a
Nothing

convertRow :: RowParser r -> [Base.SQLData] -> Int -> IO r
convertRow :: RowParser r -> [SQLData] -> Int -> IO r
convertRow fromRow_ :: RowParser r
fromRow_ rowRes :: [SQLData]
rowRes ncols :: Int
ncols = do
  let rw :: RowParseRO
rw = Int -> RowParseRO
RowParseRO Int
ncols
  case StateT (Int, [SQLData]) Ok r
-> (Int, [SQLData]) -> Ok (r, (Int, [SQLData]))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) r
-> RowParseRO -> StateT (Int, [SQLData]) Ok r
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (RowParser r -> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) r
forall a.
RowParser a -> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a
unRP RowParser r
fromRow_) RowParseRO
rw) (0, [SQLData]
rowRes) of
    Ok (val :: r
val,(col :: Int
col,_))
       | Int
col Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ncols -> r -> IO r
forall (m :: * -> *) a. Monad m => a -> m a
return r
val
       | Bool
otherwise -> ColumnOutOfBounds -> IO r
forall r. ColumnOutOfBounds -> IO r
errorColumnMismatch (Int -> ColumnOutOfBounds
ColumnOutOfBounds Int
col)
    Errors []  -> ResultError -> IO r
forall e a. Exception e => e -> IO a
throwIO (ResultError -> IO r) -> ResultError -> IO r
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> ResultError
ConversionFailed "" "" "unknown error"
    Errors [x :: SomeException
x] ->
      SomeException -> IO r
forall a e. Exception e => e -> a
throw SomeException
x IO r -> (ColumnOutOfBounds -> IO r) -> IO r
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`Control.Exception.catch` (\e :: ColumnOutOfBounds
e -> ColumnOutOfBounds -> IO r
forall r. ColumnOutOfBounds -> IO r
errorColumnMismatch (ColumnOutOfBounds
e :: ColumnOutOfBounds))
    Errors xs :: [SomeException]
xs  -> ManyErrors -> IO r
forall e a. Exception e => e -> IO a
throwIO (ManyErrors -> IO r) -> ManyErrors -> IO r
forall a b. (a -> b) -> a -> b
$ [SomeException] -> ManyErrors
ManyErrors [SomeException]
xs
  where
    errorColumnMismatch :: ColumnOutOfBounds -> IO r
    errorColumnMismatch :: ColumnOutOfBounds -> IO r
errorColumnMismatch (ColumnOutOfBounds c :: Int
c) = do
      let vals :: [(ByteString, Text)]
vals = (SQLData -> (ByteString, Text))
-> [SQLData] -> [(ByteString, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\f :: SQLData
f -> (SQLData -> ByteString
gettypename SQLData
f, SQLData -> Text
ellipsis SQLData
f)) [SQLData]
rowRes
      ResultError -> IO r
forall e a. Exception e => e -> IO a
throwIO (String -> String -> String -> ResultError
ConversionFailed
               (Int -> String
forall a. Show a => a -> String
show Int
ncols String -> ShowS
forall a. [a] -> [a] -> [a]
++ " values: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(ByteString, Text)] -> String
forall a. Show a => a -> String
show [(ByteString, Text)]
vals)
               ("at least " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ " slots in target type")
               "mismatch between number of columns to convert and number in target type")

    ellipsis :: Base.SQLData -> T.Text
    ellipsis :: SQLData -> Text
ellipsis sql :: SQLData
sql
      | Text -> Int
T.length Text
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 20 = Int -> Text -> Text
T.take 15 Text
bs Text -> Text -> Text
`T.append` "[...]"
      | Bool
otherwise        = Text
bs
      where
        bs :: Text
bs = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SQLData -> String
forall a. Show a => a -> String
show SQLData
sql

withTransactionPrivate :: Connection -> IO a -> TransactionType -> IO a
withTransactionPrivate :: Connection -> IO a -> TransactionType -> IO a
withTransactionPrivate conn :: Connection
conn action :: IO a
action ttype :: TransactionType
ttype =
  ((forall a. IO a -> IO a) -> IO a) -> IO a
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO a) -> IO a)
-> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. IO a -> IO a
restore -> do
    IO ()
begin
    a
r <- IO a -> IO a
forall a. IO a -> IO a
restore IO a
action IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`onException` IO ()
rollback
    IO ()
commit
    a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
  where
    begin :: IO ()
begin    = case TransactionType
ttype of
                 Deferred  -> Connection -> Query -> IO ()
execute_ Connection
conn "BEGIN TRANSACTION"
                 Immediate -> Connection -> Query -> IO ()
execute_ Connection
conn "BEGIN IMMEDIATE TRANSACTION"
                 Exclusive -> Connection -> Query -> IO ()
execute_ Connection
conn "BEGIN EXCLUSIVE TRANSACTION"
    commit :: IO ()
commit   = Connection -> Query -> IO ()
execute_ Connection
conn "COMMIT TRANSACTION"
    rollback :: IO ()
rollback = Connection -> Query -> IO ()
execute_ Connection
conn "ROLLBACK TRANSACTION"


-- | Run an IO action inside a SQL transaction started with @BEGIN IMMEDIATE
-- TRANSACTION@, which immediately blocks all other database connections from
-- writing.  The default SQLite3 @BEGIN TRANSACTION@ does not acquire the write
-- lock on @BEGIN@ nor on @SELECT@ but waits until you try to change data.  If
-- the action throws any kind of an exception, the transaction will be rolled
-- back with @ROLLBACK TRANSACTION@.  Otherwise the results are committed with
-- @COMMIT TRANSACTION@.
withImmediateTransaction :: Connection -> IO a -> IO a
withImmediateTransaction :: Connection -> IO a -> IO a
withImmediateTransaction conn :: Connection
conn action :: IO a
action =
  Connection -> IO a -> TransactionType -> IO a
forall a. Connection -> IO a -> TransactionType -> IO a
withTransactionPrivate Connection
conn IO a
action TransactionType
Immediate

-- | Run an IO action inside a SQL transaction started with @BEGIN EXCLUSIVE
-- TRANSACTION@, which immediately blocks all other database connections from
-- writing, and other connections from reading (exception: read_uncommitted
-- connections are allowed to read.) If the action throws any kind of an
-- exception, the transaction will be rolled back with @ROLLBACK TRANSACTION@.
-- Otherwise the results are committed with @COMMIT TRANSACTION@.
withExclusiveTransaction :: Connection -> IO a -> IO a
withExclusiveTransaction :: Connection -> IO a -> IO a
withExclusiveTransaction conn :: Connection
conn action :: IO a
action =
  Connection -> IO a -> TransactionType -> IO a
forall a. Connection -> IO a -> TransactionType -> IO a
withTransactionPrivate Connection
conn IO a
action TransactionType
Exclusive

-- | Returns the rowid of the most recent successful INSERT on the
-- given database connection.
--
-- See also <http://www.sqlite.org/c3ref/last_insert_rowid.html>.
lastInsertRowId :: Connection -> IO Int64
lastInsertRowId :: Connection -> IO Int64
lastInsertRowId (Connection c :: Database
c) = Database -> IO Int64
BaseD.lastInsertRowId Database
c

-- | <http://www.sqlite.org/c3ref/changes.html>
--
-- Return the number of rows that were changed, inserted, or deleted
-- by the most recent @INSERT@, @DELETE@, or @UPDATE@ statement.
changes :: Connection -> IO Int
changes :: Connection -> IO Int
changes (Connection c :: Database
c) = Database -> IO Int
BaseD.changes Database
c

-- | <http://www.sqlite.org/c3ref/total_changes.html>
--
-- Return the total number of row changes caused by @INSERT@, @DELETE@,
-- or @UPDATE@ statements since the 'Database' was opened.
totalChanges :: Connection -> IO Int
totalChanges :: Connection -> IO Int
totalChanges (Connection c :: Database
c) = Database -> IO Int
BaseD.totalChanges Database
c

-- | Run an IO action inside a SQL transaction started with @BEGIN
-- TRANSACTION@.  If the action throws any kind of an exception, the
-- transaction will be rolled back with @ROLLBACK TRANSACTION@.
-- Otherwise the results are committed with @COMMIT TRANSACTION@.
withTransaction :: Connection -> IO a -> IO a
withTransaction :: Connection -> IO a -> IO a
withTransaction conn :: Connection
conn action :: IO a
action =
  Connection -> IO a -> TransactionType -> IO a
forall a. Connection -> IO a -> TransactionType -> IO a
withTransactionPrivate Connection
conn IO a
action TransactionType
Deferred

fmtError :: Show v => String -> Query -> [v] -> a
fmtError :: String -> Query -> [v] -> a
fmtError msg :: String
msg q :: Query
q xs :: [v]
xs =
  FormatError -> a
forall a e. Exception e => e -> a
throw FormatError :: String -> Query -> [String] -> FormatError
FormatError {
      fmtMessage :: String
fmtMessage  = String
msg
    , fmtQuery :: Query
fmtQuery    = Query
q
    , fmtParams :: [String]
fmtParams   = (v -> String) -> [v] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map v -> String
forall a. Show a => a -> String
show [v]
xs
    }

getQuery :: Base.Statement -> IO Query
getQuery :: Statement -> IO Query
getQuery stmt :: Statement
stmt =
  Maybe Utf8 -> Query
toQuery (Maybe Utf8 -> Query) -> IO (Maybe Utf8) -> IO Query
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Statement -> IO (Maybe Utf8)
BaseD.statementSql Statement
stmt
  where
    toQuery :: Maybe Utf8 -> Query
toQuery =
      Text -> Query
Query (Text -> Query) -> (Maybe Utf8 -> Text) -> Maybe Utf8 -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Utf8 -> Text) -> Maybe Utf8 -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "no query string" (\(BaseD.Utf8 s :: ByteString
s) -> ByteString -> Text
TE.decodeUtf8 ByteString
s)

-- $use
-- An example that creates a table 'test', inserts a couple of rows
-- and proceeds to showcase how to update or delete rows.  This
-- example also demonstrates the use of 'lastInsertRowId' (how to
-- refer to a previously inserted row) and 'executeNamed' (an easier
-- to maintain form of query parameter naming).
--
-- >{-# LANGUAGE OverloadedStrings #-}
-- >
-- >import           Control.Applicative
-- >import qualified Data.Text as T
-- >import           Database.SQLite.Simple
-- >import           Database.SQLite.Simple.FromRow
-- >
-- >data TestField = TestField Int T.Text deriving (Show)
-- >
-- >instance FromRow TestField where
-- >  fromRow = TestField <$> field <*> field
-- >
-- >instance ToRow TestField where
-- >  toRow (TestField id_ str) = toRow (id_, str)
-- >
-- >main :: IO ()
-- >main = do
-- >  conn <- open "test.db"
-- >  execute_ conn "CREATE TABLE IF NOT EXISTS test (id INTEGER PRIMARY KEY, str TEXT)"
-- >  execute conn "INSERT INTO test (str) VALUES (?)" (Only ("test string 2" :: String))
-- >  execute conn "INSERT INTO test (id, str) VALUES (?,?)" (TestField 13 "test string 3")
-- >  rowId <- lastInsertRowId conn
-- >  executeNamed conn "UPDATE test SET str = :str WHERE id = :id" [":str" := ("updated str" :: T.Text), ":id" := rowId]
-- >  r <- query_ conn "SELECT * from test" :: IO [TestField]
-- >  mapM_ print r
-- >  execute conn "DELETE FROM test WHERE id = ?" (Only rowId)
-- >  close conn

-- $querytype
--
-- SQL-based applications are somewhat notorious for their
-- susceptibility to attacks through the injection of maliciously
-- crafted data. The primary reason for widespread vulnerability to
-- SQL injections is that many applications are sloppy in handling
-- user data when constructing SQL queries.
--
-- This library provides a 'Query' type and a parameter substitution
-- facility to address both ease of use and security.  A 'Query' is a
-- @newtype@-wrapped 'Text'. It intentionally exposes a tiny API that
-- is not compatible with the 'Text' API; this makes it difficult to
-- construct queries from fragments of strings.  The 'query' and
-- 'execute' functions require queries to be of type 'Query'.
--
-- To most easily construct a query, enable GHC's @OverloadedStrings@
-- language extension and write your query as a normal literal string.
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- >
-- > import Database.SQLite.Simple
-- >
-- > hello = do
-- >   conn <- open "test.db"
-- >   [[x]] <- query_ conn "select 2 + 2"
-- >   print x
--
-- A 'Query' value does not represent the actual query that will be
-- executed, but is a template for constructing the final query.

-- $subst
--
-- Since applications need to be able to construct queries with
-- parameters that change, this library uses SQLite's parameter
-- binding query substitution capability.
--
-- This library restricts parameter substitution to work only with
-- named parameters and positional arguments with the \"@?@\" syntax.
-- The API does not support for mixing these two types of bindings.
-- Unsupported parameters will be rejected and a 'FormatError' will be
-- thrown.
--
-- You should always use parameter substitution instead of inlining
-- your dynamic parameters into your queries with messy string
-- concatenation.  SQLite will automatically quote and escape your
-- data into these placeholder parameters; this defeats the single
-- most common injection vector for malicious data.

-- $substpos
--
-- The 'Query' template accepted by 'query', 'execute' and 'fold' can
-- contain any number of \"@?@\" characters.  Both 'query' and
-- 'execute' accept a third argument, typically a tuple. When the
-- query executes, the first \"@?@\" in the template will be replaced
-- with the first element of the tuple, the second \"@?@\" with the
-- second element, and so on.  This substitution happens inside the
-- native SQLite implementation.
--
-- For example, given the following 'Query' template:
--
-- > select * from user where first_name = ? and age > ?
--
-- And a tuple of this form:
--
-- > ("Boris" :: String, 37 :: Int)
--
-- The query to be executed will look like this after substitution:
--
-- > select * from user where first_name = 'Boris' and age > 37
--
-- If there is a mismatch between the number of \"@?@\" characters in
-- your template and the number of elements in your tuple, a
-- 'FormatError' will be thrown.
--
-- Note that the substitution functions do not attempt to parse or
-- validate your query. It's up to you to write syntactically valid
-- SQL, and to ensure that each \"@?@\" in your query template is
-- matched with the right tuple element.

-- $substnamed
--
-- Named parameters are accepted by 'queryNamed', 'executeNamed' and
-- 'foldNamed'.  These functions take a list of 'NamedParam's which
-- are key-value pairs binding a value to an argument name.  As is the
-- case with \"@?@\" parameters, named parameters are automatically
-- escaped by the SQLite library.  The parameter names are prefixed
-- with either @:@ or @\@@, e.g. @:foo@ or @\@foo@.
--
-- Example:
--
-- @
-- r \<- 'queryNamed' c \"SELECT id,text FROM posts WHERE id = :id AND date >= :date\" [\":id\" ':=' postId, \":date\" ':=' afterDate]
-- @
--
-- Note that you can mix different value types in the same list.
-- E.g., the following is perfectly legal:
--
-- @
-- [\":id\" ':=' (3 :: Int), \":str\" ':=' (\"foo\" :: String)]
-- @
--
-- The parameter name (or key) in the 'NamedParam' must match exactly
-- the name written in the SQL query.  E.g., if you used @:foo@ in
-- your SQL statement, you need to use @\":foo\"@ as the parameter
-- key, not @\"foo\"@.  Some libraries like Python's sqlite3
-- automatically drop the @:@ character from the name.

-- $inference
--
-- Automated type inference means that you will often be able to avoid
-- supplying explicit type signatures for the elements of a tuple.
-- However, sometimes the compiler will not be able to infer your
-- types. Consider a case where you write a numeric literal in a
-- parameter tuple:
--
-- > query conn "select ? + ?" (40,2)
--
-- The above query will be rejected by the compiler, because it does
-- not know the specific numeric types of the literals @40@ and @2@.
-- This is easily fixed:
--
-- > query conn "select ? + ?" (40 :: Double, 2 :: Double)
--
-- The same kind of problem can arise with string literals if you have
-- the @OverloadedStrings@ language extension enabled.  Again, just
-- use an explicit type signature if this happens.

-- $only_param
--
-- Haskell lacks a single-element tuple type, so if you have just one
-- value you want substituted into a query, what should you do?
--
-- To represent a single value @val@ as a parameter, write a singleton
-- list @[val]@, use 'Just' @val@, or use 'Only' @val@.
--
-- Here's an example using a singleton list:
--
-- > execute conn "insert into users (first_name) values (?)"
-- >              ["Nuala"]
--
-- Or you can use named parameters which do not have this restriction.

-- $result
--
-- The 'query' and 'query_' functions return a list of values in the
-- 'FromRow' typeclass. This class performs automatic extraction
-- and type conversion of rows from a query result.
--
-- Here is a simple example of how to extract results:
--
-- > import qualified Data.Text as T
-- >
-- > xs <- query_ conn "select name,age from users"
-- > forM_ xs $ \(name,age) ->
-- >   putStrLn $ T.unpack name ++ " is " ++ show (age :: Int)
--
-- Notice two important details about this code:
--
-- * The number of columns we ask for in the query template must
--   exactly match the number of elements we specify in a row of the
--   result tuple.  If they do not match, a 'ResultError' exception
--   will be thrown.
--
-- * Sometimes, the compiler needs our help in specifying types. It
--   can infer that @name@ must be a 'Text', due to our use of the
--   @unpack@ function. However, we have to tell it the type of @age@,
--   as it has no other information to determine the exact type.

-- $null
--
-- The type of a result tuple will look something like this:
--
-- > (Text, Int, Int)
--
-- Although SQL can accommodate @NULL@ as a value for any of these
-- types, Haskell cannot. If your result contains columns that may be
-- @NULL@, be sure that you use 'Maybe' in those positions of of your
-- tuple.
--
-- > (Text, Maybe Int, Int)
--
-- If 'query' encounters a @NULL@ in a row where the corresponding
-- Haskell type is not 'Maybe', it will throw a 'ResultError'
-- exception.

-- $only_result
--
-- To specify that a query returns a single-column result, use the
-- 'Only' type.
--
-- > xs <- query_ conn "select id from users"
-- > forM_ xs $ \(Only dbid) -> {- ... -}

-- $types
--
-- Conversion of SQL values to Haskell values is somewhat
-- permissive. Here are the rules.
--
-- * For numeric types, any Haskell type that can accurately represent
--   an SQLite INTEGER is considered \"compatible\".
--
-- * If a numeric incompatibility is found, 'query' will throw a
--   'ResultError'.
--
-- * SQLite's TEXT type is always encoded in UTF-8.  Thus any text
--   data coming from an SQLite database should always be compatible
--   with Haskell 'String' and 'Text' types.
--
-- * SQLite's BLOB type will only be conversible to a Haskell
--   'ByteString'.
--
-- You can extend conversion support to your own types be adding your
-- own 'FromField' / 'ToField' instances.

-- $utctime
--
-- SQLite's datetime allows for multiple string representations of UTC
-- time.  The following formats are supported for reading SQLite times
-- into Haskell UTCTime values:
--
-- * YYYY-MM-DD HH:MM
--
-- * YYYY-MM-DD HH:MM:SS
--
-- * YYYY-MM-DD HH:MM:SS.SSS
--
-- * YYYY-MM-DDTHH:MM
--
-- * YYYY-MM-DDTHH:MM:SS
--
-- * YYYY-MM-DDTHH:MM:SS.SSS
--
-- The above may also be optionally followed by a timezone indicator
-- of the form \"[+-]HH:MM\" or just \"Z\".
--
-- When Haskell UTCTime values are converted into SQLite values (e.g.,
-- parameters for a 'query'), the following format is used:
--
-- * YYYY-MM-DD HH:MM:SS.SSS
--
-- The last \".SSS\" subsecond part is dropped if it's zero.  No
-- timezone indicator is used when converting from a UTCTime value
-- into an SQLite string.  SQLite assumes all datetimes are in UTC
-- time.
--
-- The parser and printers are implemented in <Database-SQLite-Simple-Time.html Database.SQLite.Simple.Time>.
--
-- Read more about SQLite's time strings in <http://sqlite.org/lang_datefunc.html>