{-# LANGUAGE GADTs, CPP, OverloadedStrings #-}
-- | SQLite3 backend for Selda.
module Database.Selda.SQLite
  ( SQLite
  , withSQLite
  , sqliteOpen, seldaClose
  , sqliteBackend
  ) where
import Database.Selda
import Database.Selda.Backend
import Database.Selda.SQLite.Parser
import Data.Maybe (fromJust)
#ifndef __HASTE__
import Control.Monad (void, when, unless)
import Control.Monad.Catch
import Data.ByteString.Lazy (toStrict)
import Data.Dynamic
import Data.Int (Int64)
import Data.Text as Text (pack, toLower, take)
import Data.Time (FormatTime, formatTime, defaultTimeLocale)
import Data.UUID.Types (toByteString)
import Database.SQLite3
import System.Directory (makeAbsolute)
#endif

data SQLite

-- | Open a new connection to an SQLite database.
--   The connection is reusable across calls to `runSeldaT`, and must be
--   explicitly closed using 'seldaClose' when no longer needed.
sqliteOpen :: (MonadIO m, MonadMask m) => FilePath -> m (SeldaConnection SQLite)
#ifdef __HASTE__
sqliteOpen _ = error "sqliteOpen called in JS context"
#else
sqliteOpen :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
FilePath -> m (SeldaConnection SQLite)
sqliteOpen FilePath
file = do
  forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore -> do
    Either SQLError Database
edb <- forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Text -> IO Database
open (FilePath -> Text
pack FilePath
file)
    case Either SQLError Database
edb of
      Left e :: SQLError
e@(SQLError{}) -> do
        forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (FilePath -> SeldaError
DbError (forall a. Show a => a -> FilePath
show SQLError
e))
      Right Database
db -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
onException (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Database -> IO ()
close Database
db)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. m a -> m a
restore forall a b. (a -> b) -> a -> b
$ do
        Text
absFile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
makeAbsolute FilePath
file
        let backend :: SeldaBackend SQLite
backend = Database -> SeldaBackend SQLite
sqliteBackend Database
db
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall b.
SeldaBackend b -> Text -> [Param] -> IO (Int, [[SqlValue]])
runStmt SeldaBackend SQLite
backend Text
"PRAGMA foreign_keys = ON;" []
        forall (m :: * -> *) b.
MonadIO m =>
SeldaBackend b -> Text -> m (SeldaConnection b)
newConnection SeldaBackend SQLite
backend Text
absFile
#endif

-- | Perform the given computation over an SQLite database.
--   The database is guaranteed to be closed when the computation terminates.
withSQLite :: (MonadIO m, MonadMask m) => FilePath -> SeldaT SQLite m a -> m a
#ifdef __HASTE__
withSQLite _ _ = return $ error "withSQLite called in JS context"

sqliteBackend :: a -> SeldaBackend
sqliteBackend _ = error "sqliteBackend called in JS context"
#else
withSQLite :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> SeldaT SQLite m a -> m a
withSQLite FilePath
file SeldaT SQLite m a
m = forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
FilePath -> m (SeldaConnection SQLite)
sqliteOpen FilePath
file) forall (m :: * -> *) b. MonadIO m => SeldaConnection b -> m ()
seldaClose (forall (m :: * -> *) b a.
(MonadIO m, MonadMask m) =>
SeldaT b m a -> SeldaConnection b -> m a
runSeldaT SeldaT SQLite m a
m)

-- | Create a Selda backend using an already open database handle.
--   This is useful for situations where you want to use some SQLite-specific
--   functionality alongside Selda.
--
--   Note that manipulating the underlying database handle directly voids
--   any and all safety guarantees made by the Selda API.
--   Caching functionality in particular WILL break.
--   Proceed with extreme caution.
sqliteBackend :: Database -> SeldaBackend SQLite
sqliteBackend :: Database -> SeldaBackend SQLite
sqliteBackend Database
db = SeldaBackend
  { runStmt :: Text -> [Param] -> IO (Int, [[SqlValue]])
runStmt         = \Text
q [Param]
ps -> forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Database -> QueryRunner (Int64, (Int, [[SqlValue]]))
sqliteQueryRunner Database
db Text
q [Param]
ps
  , runStmtWithPK :: Text -> [Param] -> IO Int64
runStmtWithPK   = \Text
q [Param]
ps -> forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Database -> QueryRunner (Int64, (Int, [[SqlValue]]))
sqliteQueryRunner Database
db Text
q [Param]
ps
  , prepareStmt :: StmtID -> [SqlTypeRep] -> Text -> IO Dynamic
prepareStmt     = \StmtID
_ [SqlTypeRep]
_ -> Database -> Text -> IO Dynamic
sqlitePrepare Database
db
  , runPrepared :: Dynamic -> [Param] -> IO (Int, [[SqlValue]])
runPrepared     = Database -> Dynamic -> [Param] -> IO (Int, [[SqlValue]])
sqliteRunPrepared Database
db
  , getTableInfo :: TableName -> IO TableInfo
getTableInfo    = Database -> Text -> IO TableInfo
sqliteGetTableInfo Database
db forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName -> Text
fromTableName
  , ppConfig :: PPConfig
ppConfig        = PPConfig
defPPConfig {ppMaxInsertParams :: Maybe Int
ppMaxInsertParams = forall a. a -> Maybe a
Just Int
999}
  , backendId :: BackendID
backendId       = BackendID
SQLite
  , closeConnection :: SeldaConnection SQLite -> IO ()
closeConnection = \SeldaConnection SQLite
conn -> do
      [(StmtID, Dynamic)]
stmts <- forall b. SeldaConnection b -> IO [(StmtID, Dynamic)]
allStmts SeldaConnection SQLite
conn
      forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [(StmtID, Dynamic)]
stmts forall a b. (a -> b) -> a -> b
$ \(StmtID
_, Dynamic
stm) -> do
        Statement -> IO ()
finalize forall a b. (a -> b) -> a -> b
$ forall a. Typeable a => Dynamic -> a -> a
fromDyn Dynamic
stm (forall a. HasCallStack => FilePath -> a
error FilePath
"BUG: non-statement SQLite statement")
      Database -> IO ()
close Database
db
  , disableForeignKeys :: Bool -> IO ()
disableForeignKeys = Database -> Bool -> IO ()
disableFKs Database
db
  }

sqliteGetTableInfo :: Database -> Text -> IO TableInfo
sqliteGetTableInfo :: Database -> Text -> IO TableInfo
sqliteGetTableInfo Database
db Text
tbl = do
    [[SqlValue]]
cols <- (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Database -> QueryRunner (Int64, (Int, [[SqlValue]]))
sqliteQueryRunner Database
db Text
tblinfo []
    [[SqlValue]]
fks <- (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Database -> QueryRunner (Int64, (Int, [[SqlValue]]))
sqliteQueryRunner Database
db Text
fklist []
    [[SqlValue]]
createQuery <- (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Database -> QueryRunner (Int64, (Int, [[SqlValue]]))
sqliteQueryRunner Database
db Text
autos []
    let cs :: [(Text, (Text, Bool))]
cs = case [[SqlValue]]
createQuery of
          [[SqlString Text
q]] -> Text -> [(Text, (Text, Bool))]
colsFromQuery Text
q
          [[SqlValue]]
_               -> []
    [([Text], Text)]
ixs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [SqlValue] -> IO ([Text], Text)
indexInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Database -> QueryRunner (Int64, (Int, [[SqlValue]]))
sqliteQueryRunner Database
db Text
indexes []
    [ColumnInfo]
colInfos <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall {m :: * -> *} {t :: * -> *} {b} {a}.
(Foldable t, Eq b, IsString b, MonadThrow m) =>
[[SqlValue]]
-> t ([Text], b)
-> [(Text, (a, Bool))]
-> [SqlValue]
-> m ColumnInfo
describe [[SqlValue]]
fks [([Text], Text)]
ixs [(Text, (Text, Bool))]
cs) [[SqlValue]]
cols
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TableInfo
      { tableInfoName :: TableName
tableInfoName = Text -> TableName
mkTableName Text
tbl
      , tableColumnInfos :: [ColumnInfo]
tableColumnInfos = [ColumnInfo]
colInfos
      , tableUniqueGroups :: [[ColName]]
tableUniqueGroups =
        [ forall a b. (a -> b) -> [a] -> [b]
map Text -> ColName
mkColName [Text]
names
        | ([Text]
names, Text
"u") <- [([Text], Text)]
ixs
        ]
      , tablePrimaryKey :: [ColName]
tablePrimaryKey = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ forall a b. (a -> b) -> [a] -> [b]
map Text -> ColName
mkColName [Text]
names
          | ([Text]
names, Text
"pk") <- [([Text], Text)]
ixs
          ]
        , [ ColumnInfo -> ColName
colName ColumnInfo
ci
          | ColumnInfo
ci <- [ColumnInfo]
colInfos
          , ColumnInfo -> Bool
colIsAutoPrimary ColumnInfo
ci
          ]
        ]
      }
  where
    tblinfo :: Text
tblinfo = forall a. Monoid a => [a] -> a
mconcat [Text
"PRAGMA table_info(", Text
tbl, Text
");"]
    indexes :: Text
indexes = forall a. Monoid a => [a] -> a
mconcat [Text
"PRAGMA index_list(", Text
tbl, Text
");"]
    fklist :: Text
fklist = forall a. Monoid a => [a] -> a
mconcat [Text
"PRAGMA foreign_key_list(", Text
tbl, Text
");"]
    autos :: Text
autos = forall a. Monoid a => [a] -> a
mconcat [Text
"SELECT sql FROM sqlite_master WHERE name = ", Text
tbl, Text
";"]
    ixinfo :: a -> a
ixinfo a
name = forall a. Monoid a => [a] -> a
mconcat [a
"PRAGMA index_info(", a
name, a
");"]

    toTypeRep :: Bool -> Text -> Either Text SqlTypeRep
toTypeRep Bool
_ Text
"text"                      = forall a b. b -> Either a b
Right SqlTypeRep
TText
    toTypeRep Bool
_ Text
"double precision"          = forall a b. b -> Either a b
Right SqlTypeRep
TFloat
    toTypeRep Bool
_ Text
"double"                    = forall a b. b -> Either a b
Right SqlTypeRep
TFloat
    toTypeRep Bool
_ Text
"boolean"                   = forall a b. b -> Either a b
Right SqlTypeRep
TBool
    toTypeRep Bool
_ Text
"datetime"                  = forall a b. b -> Either a b
Right SqlTypeRep
TDateTime
    toTypeRep Bool
_ Text
"date"                      = forall a b. b -> Either a b
Right SqlTypeRep
TDate
    toTypeRep Bool
_ Text
"time"                      = forall a b. b -> Either a b
Right SqlTypeRep
TTime
    toTypeRep Bool
_ Text
"blob"                      = forall a b. b -> Either a b
Right SqlTypeRep
TBlob
    toTypeRep Bool
True Text
"integer"                = forall a b. b -> Either a b
Right SqlTypeRep
TRowID
    toTypeRep Bool
pk Text
s | Int -> Text -> Text
Text.take Int
6 Text
s forall a. Eq a => a -> a -> Bool
== Text
"bigint" = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ if Bool
pk then SqlTypeRep
TRowID else SqlTypeRep
TInt64
    toTypeRep Bool
pk Text
s | Int -> Text -> Text
Text.take Int
3 Text
s forall a. Eq a => a -> a -> Bool
== Text
"int" = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ if Bool
pk then SqlTypeRep
TRowID else SqlTypeRep
TInt32
    toTypeRep Bool
_ Text
typ                         = forall a b. a -> Either a b
Left Text
typ

    indexInfo :: [SqlValue] -> IO ([Text], Text)
indexInfo [SqlValue
_, SqlString Text
ixname, SqlValue
_, SqlString Text
itype, SqlValue
_] = do
      let q :: Text
q = forall {a}. (Monoid a, IsString a) => a -> a
ixinfo Text
ixname
      [[SqlValue]]
info <- (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Database -> QueryRunner (Int64, (Int, [[SqlValue]]))
sqliteQueryRunner Database
db Text
q []
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall a b. (a -> b) -> [a] -> [b]
map (\[SqlValue
_,SqlValue
_,SqlString Text
name] -> Text
name) [[SqlValue]]
info, Text
itype)
    indexInfo [SqlValue]
_ = do
      forall a. HasCallStack => FilePath -> a
error FilePath
"unreachable"

    describe :: [[SqlValue]]
-> t ([Text], b)
-> [(Text, (a, Bool))]
-> [SqlValue]
-> m ColumnInfo
describe [[SqlValue]]
fks t ([Text], b)
ixs [(Text, (a, Bool))]
cs [SqlValue
_, SqlString Text
name, SqlString Text
ty, SqlInt64 Int64
nonnull, SqlValue
_, SqlInt64 Int64
pk] = do
      let ty' :: Text
ty' = Text -> Text
Text.toLower Text
ty
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ColumnInfo
        { colName :: ColName
colName = Text -> ColName
mkColName Text
name
        , colType :: Either Text SqlTypeRep
colType = Bool -> Text -> Either Text SqlTypeRep
toTypeRep (Int64
pk forall a. Eq a => a -> a -> Bool
== Int64
1) Text
ty'
        , colIsAutoPrimary :: Bool
colIsAutoPrimary = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
name [(Text, (a, Bool))]
cs
        , colHasIndex :: Bool
colHasIndex = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== ([Text
name], b
"c")) t ([Text], b)
ixs
        , colIsNullable :: Bool
colIsNullable = Int64
nonnull forall a. Eq a => a -> a -> Bool
== Int64
0
        , colFKs :: [(TableName, ColName)]
colFKs =
            [ (Text -> TableName
mkTableName Text
reftbl, Text -> ColName
mkColName Text
refkey)
            | (SqlValue
_:SqlValue
_:SqlString Text
reftbl:SqlString Text
key:SqlString Text
refkey:[SqlValue]
_) <- [[SqlValue]]
fks
            , Text
key forall a. Eq a => a -> a -> Bool
== Text
name
            ]
        }
    describe [[SqlValue]]
_ t ([Text], b)
_ [(Text, (a, Bool))]
_ [SqlValue]
result = do
      forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ FilePath -> SeldaError
SqlError forall a b. (a -> b) -> a -> b
$ FilePath
"bad result from PRAGMA table_info: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show [SqlValue]
result

disableFKs :: Database -> Bool -> IO ()
disableFKs :: Database -> Bool -> IO ()
disableFKs Database
db Bool
disable = do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
disable forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Database -> QueryRunner (Int64, (Int, [[SqlValue]]))
sqliteQueryRunner Database
db Text
"COMMIT;" []
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Database -> QueryRunner (Int64, (Int, [[SqlValue]]))
sqliteQueryRunner Database
db Text
q []
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
disable forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Database -> QueryRunner (Int64, (Int, [[SqlValue]]))
sqliteQueryRunner Database
db Text
"BEGIN TRANSACTION;" []
  where
    q :: Text
q | Bool
disable   = Text
"PRAGMA foreign_keys = OFF;"
      | Bool
otherwise = Text
"PRAGMA foreign_keys = ON;"

sqlitePrepare :: Database -> Text -> IO Dynamic
sqlitePrepare :: Database -> Text -> IO Dynamic
sqlitePrepare Database
db Text
qry = do
  Either SQLError Statement
eres <- forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try forall a b. (a -> b) -> a -> b
$ Database -> Text -> IO Statement
prepare Database
db Text
qry
  case Either SQLError Statement
eres of
    Left e :: SQLError
e@(SQLError{}) -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (FilePath -> SeldaError
SqlError (forall a. Show a => a -> FilePath
show SQLError
e))
    Right Statement
r             -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Typeable a => a -> Dynamic
toDyn Statement
r

sqliteRunPrepared :: Database -> Dynamic -> [Param] -> IO (Int, [[SqlValue]])
sqliteRunPrepared :: Database -> Dynamic -> [Param] -> IO (Int, [[SqlValue]])
sqliteRunPrepared Database
db Dynamic
hdl [Param]
params = do
  Either SQLError (Int64, (Int, [[SqlValue]]))
eres <- forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try forall a b. (a -> b) -> a -> b
$ do
    let Just Statement
stm = forall a. Typeable a => Dynamic -> Maybe a
fromDynamic Dynamic
hdl
    Database -> Statement -> [Param] -> IO (Int64, (Int, [[SqlValue]]))
sqliteRunStmt Database
db Statement
stm [Param]
params forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
`finally` do
      Statement -> IO ()
clearBindings Statement
stm
      Statement -> IO ()
reset Statement
stm
  case Either SQLError (Int64, (Int, [[SqlValue]]))
eres of
    Left e :: SQLError
e@(SQLError{}) -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (FilePath -> SeldaError
SqlError (forall a. Show a => a -> FilePath
show SQLError
e))
    Right (Int64, (Int, [[SqlValue]]))
res           -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a, b) -> b
snd (Int64, (Int, [[SqlValue]]))
res)

sqliteQueryRunner :: Database -> QueryRunner (Int64, (Int, [[SqlValue]]))
sqliteQueryRunner :: Database -> QueryRunner (Int64, (Int, [[SqlValue]]))
sqliteQueryRunner Database
db Text
qry [Param]
params = do
    Either SQLError (Int64, (Int, [[SqlValue]]))
eres <- forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try forall a b. (a -> b) -> a -> b
$ do
      Statement
stm <- Database -> Text -> IO Statement
prepare Database
db Text
qry
      Database -> Statement -> [Param] -> IO (Int64, (Int, [[SqlValue]]))
sqliteRunStmt Database
db Statement
stm [Param]
params forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
`finally` do
        Statement -> IO ()
finalize Statement
stm
    case Either SQLError (Int64, (Int, [[SqlValue]]))
eres of
      Left e :: SQLError
e@(SQLError{}) -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (FilePath -> SeldaError
SqlError (forall a. Show a => a -> FilePath
show SQLError
e))
      Right (Int64, (Int, [[SqlValue]]))
res           -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int64, (Int, [[SqlValue]]))
res

sqliteRunStmt :: Database -> Statement -> [Param] -> IO (Int64, (Int, [[SqlValue]]))
sqliteRunStmt :: Database -> Statement -> [Param] -> IO (Int64, (Int, [[SqlValue]]))
sqliteRunStmt Database
db Statement
stm [Param]
params = do
  Statement -> [SQLData] -> IO ()
bind Statement
stm [forall a. Lit a -> SQLData
toSqlData Lit a
p | Param Lit a
p <- [Param]
params]
  [[SQLData]]
rows <- Statement -> [[SQLData]] -> IO [[SQLData]]
getRows Statement
stm []
  Int64
rid <- Database -> IO Int64
lastInsertRowId Database
db
  Int
cs <- Database -> IO Int
changes Database
db
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
rid, (Int
cs, [forall a b. (a -> b) -> [a] -> [b]
map SQLData -> SqlValue
fromSqlData [SQLData]
r | [SQLData]
r <- [[SQLData]]
rows]))

getRows :: Statement -> [[SQLData]] -> IO [[SQLData]]
getRows :: Statement -> [[SQLData]] -> IO [[SQLData]]
getRows Statement
s [[SQLData]]
acc = do
  StepResult
res <- Statement -> IO StepResult
step Statement
s
  case StepResult
res of
    StepResult
Row -> do
      [SQLData]
cs <- Statement -> IO [SQLData]
columns Statement
s
      Statement -> [[SQLData]] -> IO [[SQLData]]
getRows Statement
s ([SQLData]
cs forall a. a -> [a] -> [a]
: [[SQLData]]
acc)
    StepResult
_ -> do
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [[SQLData]]
acc

toSqlData :: Lit a -> SQLData
toSqlData :: forall a. Lit a -> SQLData
toSqlData (LInt32 Int32
i)    = Int64 -> SQLData
SQLInteger forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i
toSqlData (LInt64 Int64
i)    = Int64 -> SQLData
SQLInteger forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
toSqlData (LDouble Double
d)   = Double -> SQLData
SQLFloat Double
d
toSqlData (LText Text
s)     = Text -> SQLData
SQLText Text
s
toSqlData (LDateTime UTCTime
t) = Text -> SQLData
SQLText forall a b. (a -> b) -> a -> b
$ FilePath -> Text
pack forall a b. (a -> b) -> a -> b
$ forall t. FormatTime t => FilePath -> t -> FilePath
fmtTime FilePath
sqlDateTimeFormat UTCTime
t
toSqlData (LDate Day
d)     = Text -> SQLData
SQLText forall a b. (a -> b) -> a -> b
$ FilePath -> Text
pack forall a b. (a -> b) -> a -> b
$ forall t. FormatTime t => FilePath -> t -> FilePath
fmtTime FilePath
sqlDateFormat Day
d
toSqlData (LTime TimeOfDay
t)     = Text -> SQLData
SQLText forall a b. (a -> b) -> a -> b
$ FilePath -> Text
pack forall a b. (a -> b) -> a -> b
$ forall t. FormatTime t => FilePath -> t -> FilePath
fmtTime FilePath
sqlTimeFormat TimeOfDay
t
toSqlData (LBool Bool
b)     = Int64 -> SQLData
SQLInteger forall a b. (a -> b) -> a -> b
$ if Bool
b then Int64
1 else Int64
0
toSqlData (LBlob ByteString
b)     = ByteString -> SQLData
SQLBlob ByteString
b
toSqlData (Lit a
LNull)       = SQLData
SQLNull
toSqlData (LJust Lit a1
x)     = forall a. Lit a -> SQLData
toSqlData Lit a1
x
toSqlData (LCustom SqlTypeRep
_ Lit a1
l) = forall a. Lit a -> SQLData
toSqlData Lit a1
l
toSqlData (LUUID UUID
x)     = ByteString -> SQLData
SQLBlob (ByteString -> ByteString
toStrict forall a b. (a -> b) -> a -> b
$ UUID -> ByteString
toByteString UUID
x)

fromSqlData :: SQLData -> SqlValue
fromSqlData :: SQLData -> SqlValue
fromSqlData (SQLInteger Int64
i) = Int64 -> SqlValue
SqlInt64 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
fromSqlData (SQLFloat Double
f)   = Double -> SqlValue
SqlFloat Double
f
fromSqlData (SQLText Text
s)    = Text -> SqlValue
SqlString Text
s
fromSqlData (SQLBlob ByteString
b)    = ByteString -> SqlValue
SqlBlob ByteString
b
fromSqlData SQLData
SQLNull        = SqlValue
SqlNull

fmtTime :: FormatTime t => String -> t -> String
fmtTime :: forall t. FormatTime t => FilePath -> t -> FilePath
fmtTime = forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
formatTime TimeLocale
defaultTimeLocale
#endif