{-# language RecordWildCards #-}
{-# language DerivingVia #-}
{-# language OverloadedStrings #-}
{-# language ScopedTypeVariables #-}

-- | The implementation of sqlite-easy.
--
-- This module is unstable and may change at any time.
module Database.Sqlite.Easy.Internal where

import Database.SQLite3 (Database, SQLData, Statement)
import qualified Database.SQLite3 as Direct
import Data.String (IsString, fromString)
import Data.Text (Text)
import Data.Typeable
import Data.Pool
import Control.Monad.Reader
import Control.Exception
import Control.Monad.IO.Unlift

-- * Connection

-- | A SQLite3 connection string
newtype ConnectionString
  = ConnectionString
    { ConnectionString -> Text
unConnectionString :: Text
    }
  deriving String -> ConnectionString
(String -> ConnectionString) -> IsString ConnectionString
forall a. (String -> a) -> IsString a
$cfromString :: String -> ConnectionString
fromString :: String -> ConnectionString
IsString via Text
  deriving Int -> ConnectionString -> ShowS
[ConnectionString] -> ShowS
ConnectionString -> String
(Int -> ConnectionString -> ShowS)
-> (ConnectionString -> String)
-> ([ConnectionString] -> ShowS)
-> Show ConnectionString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnectionString -> ShowS
showsPrec :: Int -> ConnectionString -> ShowS
$cshow :: ConnectionString -> String
show :: ConnectionString -> String
$cshowList :: [ConnectionString] -> ShowS
showList :: [ConnectionString] -> ShowS
Show

-- | Create a pool of a sqlite3 db with a specific connection string.
createSqlitePool :: ConnectionString -> IO (Pool Database)
createSqlitePool :: ConnectionString -> IO (Pool Database)
createSqlitePool (ConnectionString Text
connStr) =
  PoolConfig Database -> IO (Pool Database)
forall a. PoolConfig a -> IO (Pool a)
newPool (PoolConfig Database -> IO (Pool Database))
-> PoolConfig Database -> IO (Pool Database)
forall a b. (a -> b) -> a -> b
$ IO Database
-> (Database -> IO ()) -> Double -> Int -> PoolConfig Database
forall a. IO a -> (a -> IO ()) -> Double -> Int -> PoolConfig a
defaultPoolConfig
    (Text -> IO Database
Direct.open Text
connStr)
    Database -> IO ()
Direct.close
    Double
180
    Int
50

-- | Open a database, run some stuff, close the database.
withDb :: ConnectionString -> SQLite a -> IO a
withDb :: forall a. ConnectionString -> SQLite a -> IO a
withDb (ConnectionString Text
connStr) =
  IO Database -> (Database -> IO ()) -> (Database -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Text -> IO Database
Direct.open Text
connStr) Database -> IO ()
Direct.close ((Database -> IO a) -> IO a)
-> (SQLite a -> Database -> IO a) -> SQLite a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Database -> SQLite a -> IO a) -> SQLite a -> Database -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Database -> SQLite a -> IO a
forall a. Database -> SQLite a -> IO a
runSQLite

-- | Use an active database connection to run some stuff on a database.
withDatabase :: Database -> SQLite a -> IO a
withDatabase :: forall a. Database -> SQLite a -> IO a
withDatabase = Database -> SQLite a -> IO a
forall a. Database -> SQLite a -> IO a
runSQLite

-- | Use a resource pool to run some stuff on a database.
withPool :: Pool Database -> SQLite a -> IO a
withPool :: forall a. Pool Database -> SQLite a -> IO a
withPool Pool Database
pool = Pool Database -> (Database -> IO a) -> IO a
forall a r. Pool a -> (a -> IO r) -> IO r
withResource Pool Database
pool ((Database -> IO a) -> IO a)
-> (SQLite a -> Database -> IO a) -> SQLite a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Database -> SQLite a -> IO a) -> SQLite a -> Database -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Database -> SQLite a -> IO a
forall a. Database -> SQLite a -> IO a
runSQLite

-- * Execution

-- | A SQL statement
newtype SQL
  = SQL
    { SQL -> Text
unSQL :: Text
    }
  deriving (NonEmpty SQL -> SQL
SQL -> SQL -> SQL
(SQL -> SQL -> SQL)
-> (NonEmpty SQL -> SQL)
-> (forall b. Integral b => b -> SQL -> SQL)
-> Semigroup SQL
forall b. Integral b => b -> SQL -> SQL
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: SQL -> SQL -> SQL
<> :: SQL -> SQL -> SQL
$csconcat :: NonEmpty SQL -> SQL
sconcat :: NonEmpty SQL -> SQL
$cstimes :: forall b. Integral b => b -> SQL -> SQL
stimes :: forall b. Integral b => b -> SQL -> SQL
Semigroup, String -> SQL
(String -> SQL) -> IsString SQL
forall a. (String -> a) -> IsString a
$cfromString :: String -> SQL
fromString :: String -> SQL
IsString) via Text
  deriving Int -> SQL -> ShowS
[SQL] -> ShowS
SQL -> String
(Int -> SQL -> ShowS)
-> (SQL -> String) -> ([SQL] -> ShowS) -> Show SQL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SQL -> ShowS
showsPrec :: Int -> SQL -> ShowS
$cshow :: SQL -> String
show :: SQL -> String
$cshowList :: [SQL] -> ShowS
showList :: [SQL] -> ShowS
Show

-- | Run a SQL statement on a database and fetch the results.
run :: SQL -> SQLite [[SQLData]]
run :: SQL -> SQLite [[SQLData]]
run (SQL Text
stmt) = do
  Database
db <- SQLite Database
getDB
  IO [[SQLData]] -> SQLite [[SQLData]]
forall a. IO a -> SQLite a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[SQLData]] -> SQLite [[SQLData]])
-> IO [[SQLData]] -> SQLite [[SQLData]]
forall a b. (a -> b) -> a -> b
$ IO Statement
-> (Statement -> IO ())
-> (Statement -> IO [[SQLData]])
-> IO [[SQLData]]
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Database -> Text -> IO Statement
Direct.prepare Database
db Text
stmt) Statement -> IO ()
Direct.finalize Statement -> IO [[SQLData]]
fetchAll

-- | Run a SQL statement with certain parameters on a database and fetch the results.
runWith :: SQL -> [SQLData] -> SQLite [[SQLData]]
runWith :: SQL -> [SQLData] -> SQLite [[SQLData]]
runWith (SQL Text
stmt) [SQLData]
params = do
  Database
db <- SQLite Database
getDB
  IO [[SQLData]] -> SQLite [[SQLData]]
forall a. IO a -> SQLite a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[SQLData]] -> SQLite [[SQLData]])
-> IO [[SQLData]] -> SQLite [[SQLData]]
forall a b. (a -> b) -> a -> b
$ do
    IO Statement
-> (Statement -> IO ())
-> (Statement -> IO [[SQLData]])
-> IO [[SQLData]]
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Database -> Text -> IO Statement
Direct.prepare Database
db Text
stmt) Statement -> IO ()
Direct.finalize ((Statement -> IO [[SQLData]]) -> IO [[SQLData]])
-> (Statement -> IO [[SQLData]]) -> IO [[SQLData]]
forall a b. (a -> b) -> a -> b
$ \Statement
preparedStmt -> do
      Statement -> [SQLData] -> IO ()
Direct.bind Statement
preparedStmt [SQLData]
params
      Statement -> IO [[SQLData]]
fetchAll Statement
preparedStmt

-- | Run a statement and fetch all of the data.
fetchAll :: Statement -> IO [[SQLData]]
fetchAll :: Statement -> IO [[SQLData]]
fetchAll Statement
stmt = do
  StepResult
res <- Statement -> IO StepResult
Direct.step Statement
stmt
  case StepResult
res of
    StepResult
Direct.Row -> do
      [SQLData]
row <- Statement -> IO [SQLData]
Direct.columns Statement
stmt
      [[SQLData]]
rows <- Statement -> IO [[SQLData]]
fetchAll Statement
stmt
      [[SQLData]] -> IO [[SQLData]]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([SQLData]
row [SQLData] -> [[SQLData]] -> [[SQLData]]
forall a. a -> [a] -> [a]
: [[SQLData]]
rows)
    StepResult
Direct.Done ->
      [[SQLData]] -> IO [[SQLData]]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- * Transaction

-- | The type of actions to run on a SQLite database.
--   In essence, it is almost the same as @Database -> IO a@.
--
--   'SQLite' actions can be created with the 'run' and 'runWith'
--   functions, and can be composed using the type class instances.
--
--   'SQLite' actions can be run with the 'withDb', 'withDatabase',
--   and 'withPool' functions.
newtype SQLite a
  = SQLite
    { forall a. SQLite a -> SQLiteStuff -> IO a
unSQLite :: SQLiteStuff -> IO a
    }
  deriving ((forall a b. (a -> b) -> SQLite a -> SQLite b)
-> (forall a b. a -> SQLite b -> SQLite a) -> Functor SQLite
forall a b. a -> SQLite b -> SQLite a
forall a b. (a -> b) -> SQLite a -> SQLite b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> SQLite a -> SQLite b
fmap :: forall a b. (a -> b) -> SQLite a -> SQLite b
$c<$ :: forall a b. a -> SQLite b -> SQLite a
<$ :: forall a b. a -> SQLite b -> SQLite a
Functor, Functor SQLite
Functor SQLite =>
(forall a. a -> SQLite a)
-> (forall a b. SQLite (a -> b) -> SQLite a -> SQLite b)
-> (forall a b c.
    (a -> b -> c) -> SQLite a -> SQLite b -> SQLite c)
-> (forall a b. SQLite a -> SQLite b -> SQLite b)
-> (forall a b. SQLite a -> SQLite b -> SQLite a)
-> Applicative SQLite
forall a. a -> SQLite a
forall a b. SQLite a -> SQLite b -> SQLite a
forall a b. SQLite a -> SQLite b -> SQLite b
forall a b. SQLite (a -> b) -> SQLite a -> SQLite b
forall a b c. (a -> b -> c) -> SQLite a -> SQLite b -> SQLite c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> SQLite a
pure :: forall a. a -> SQLite a
$c<*> :: forall a b. SQLite (a -> b) -> SQLite a -> SQLite b
<*> :: forall a b. SQLite (a -> b) -> SQLite a -> SQLite b
$cliftA2 :: forall a b c. (a -> b -> c) -> SQLite a -> SQLite b -> SQLite c
liftA2 :: forall a b c. (a -> b -> c) -> SQLite a -> SQLite b -> SQLite c
$c*> :: forall a b. SQLite a -> SQLite b -> SQLite b
*> :: forall a b. SQLite a -> SQLite b -> SQLite b
$c<* :: forall a b. SQLite a -> SQLite b -> SQLite a
<* :: forall a b. SQLite a -> SQLite b -> SQLite a
Applicative, Applicative SQLite
Applicative SQLite =>
(forall a b. SQLite a -> (a -> SQLite b) -> SQLite b)
-> (forall a b. SQLite a -> SQLite b -> SQLite b)
-> (forall a. a -> SQLite a)
-> Monad SQLite
forall a. a -> SQLite a
forall a b. SQLite a -> SQLite b -> SQLite b
forall a b. SQLite a -> (a -> SQLite b) -> SQLite b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. SQLite a -> (a -> SQLite b) -> SQLite b
>>= :: forall a b. SQLite a -> (a -> SQLite b) -> SQLite b
$c>> :: forall a b. SQLite a -> SQLite b -> SQLite b
>> :: forall a b. SQLite a -> SQLite b -> SQLite b
$creturn :: forall a. a -> SQLite a
return :: forall a. a -> SQLite a
Monad, Monad SQLite
Monad SQLite => (forall a. IO a -> SQLite a) -> MonadIO SQLite
forall a. IO a -> SQLite a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> SQLite a
liftIO :: forall a. IO a -> SQLite a
MonadIO, Monad SQLite
Monad SQLite => (forall a. String -> SQLite a) -> MonadFail SQLite
forall a. String -> SQLite a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
$cfail :: forall a. String -> SQLite a
fail :: forall a. String -> SQLite a
MonadFail, MonadIO SQLite
MonadIO SQLite =>
(forall b. ((forall a. SQLite a -> IO a) -> IO b) -> SQLite b)
-> MonadUnliftIO SQLite
forall b. ((forall a. SQLite a -> IO a) -> IO b) -> SQLite b
forall (m :: * -> *).
MonadIO m =>
(forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
$cwithRunInIO :: forall b. ((forall a. SQLite a -> IO a) -> IO b) -> SQLite b
withRunInIO :: forall b. ((forall a. SQLite a -> IO a) -> IO b) -> SQLite b
MonadUnliftIO)
  via ReaderT SQLiteStuff IO

instance Semigroup a => Semigroup (SQLite a) where
  SQLite a
a <> :: SQLite a -> SQLite a -> SQLite a
<> SQLite a
b = a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) (a -> a -> a) -> SQLite a -> SQLite (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SQLite a
a SQLite (a -> a) -> SQLite a -> SQLite a
forall a b. SQLite (a -> b) -> SQLite a -> SQLite b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SQLite a
b

instance Monoid a => Monoid (SQLite a) where
  mempty :: SQLite a
mempty = a -> SQLite a
forall a. a -> SQLite a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty

data SQLiteStuff
  = SQLiteStuff
    { SQLiteStuff -> Database
dbConn :: Database
    , SQLiteStuff -> Maybe Int
transactionNumber :: Maybe Int
    }

getDB :: SQLite Database
getDB :: SQLite Database
getDB = (SQLiteStuff -> IO Database) -> SQLite Database
forall a. (SQLiteStuff -> IO a) -> SQLite a
SQLite (\(SQLiteStuff Database
dbConn Maybe Int
_) -> Database -> IO Database
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Database
dbConn)

runSQLite :: Database -> SQLite a -> IO a
runSQLite :: forall a. Database -> SQLite a -> IO a
runSQLite Database
db SQLite a
t = (SQLite a -> SQLiteStuff -> IO a
forall a. SQLite a -> SQLiteStuff -> IO a
unSQLite SQLite a
t) (Database -> Maybe Int -> SQLiteStuff
SQLiteStuff Database
db Maybe Int
forall a. Maybe a
Nothing)

-- | Run operations as a transaction.
--   If the action throws an error, the transaction is rolled back.
--   For more information, visit: <https://www.sqlite.org/lang_transaction.html>
transaction :: forall a. Typeable a => SQLite a -> SQLite a
transaction :: forall a. Typeable a => SQLite a -> SQLite a
transaction SQLite a
action = do
  SQLiteStuff {Maybe Int
Database
dbConn :: SQLiteStuff -> Database
transactionNumber :: SQLiteStuff -> Maybe Int
dbConn :: Database
transactionNumber :: Maybe Int
..} <- (SQLiteStuff -> IO SQLiteStuff) -> SQLite SQLiteStuff
forall a. (SQLiteStuff -> IO a) -> SQLite a
SQLite ((SQLiteStuff -> IO SQLiteStuff) -> SQLite SQLiteStuff)
-> (SQLiteStuff -> IO SQLiteStuff) -> SQLite SQLiteStuff
forall a b. (a -> b) -> a -> b
$ \SQLiteStuff
stuff -> SQLiteStuff -> IO SQLiteStuff
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SQLiteStuff
stuff
  case Maybe Int
transactionNumber of
    Maybe Int
Nothing -> do
      let
        runIO :: SQL -> IO [[SQLData]]
runIO SQL
sql = (SQLite [[SQLData]] -> SQLiteStuff -> IO [[SQLData]]
forall a. SQLite a -> SQLiteStuff -> IO a
unSQLite (SQL -> SQLite [[SQLData]]
run SQL
sql)) (Database -> Maybe Int -> SQLiteStuff
SQLiteStuff Database
dbConn Maybe Int
forall a. Maybe a
Nothing)
        commit :: IO [[SQLData]]
commit = SQL -> IO [[SQLData]]
runIO SQL
"COMMIT"
        rollback' :: IO [[SQLData]]
rollback' = SQL -> IO [[SQLData]]
runIO SQL
"ROLLBACK"
      [] <- SQL -> SQLite [[SQLData]]
run SQL
"BEGIN"
      IO a -> SQLite a
forall a. IO a -> SQLite a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> SQLite a) -> IO a -> SQLite a
forall a b. (a -> b) -> a -> b
$ IO a -> [Handler a] -> IO a
forall a. IO a -> [Handler a] -> IO a
catches
        ((SQLite a -> SQLiteStuff -> IO a
forall a. SQLite a -> SQLiteStuff -> IO a
unSQLite SQLite a
action) (Database -> Maybe Int -> SQLiteStuff
SQLiteStuff Database
dbConn (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)) IO a -> IO [[SQLData]] -> IO a
forall a b. IO a -> IO b -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* IO [[SQLData]]
commit)
        [ (RollbackCurrent a -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((RollbackCurrent a -> IO a) -> Handler a)
-> (RollbackCurrent a -> IO a) -> Handler a
forall a b. (a -> b) -> a -> b
$ \(RollbackCurrent a
a) -> IO [[SQLData]]
rollback' IO [[SQLData]] -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
        , (RollbackAll a -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((RollbackAll a -> IO a) -> Handler a)
-> (RollbackAll a -> IO a) -> Handler a
forall a b. (a -> b) -> a -> b
$ \(RollbackAll a
a) -> IO [[SQLData]]
rollback' IO [[SQLData]] -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
        , (SomeException -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((SomeException -> IO a) -> Handler a)
-> (SomeException -> IO a) -> Handler a
forall a b. (a -> b) -> a -> b
$ \(SomeException
ex :: SomeException) -> IO [[SQLData]]
rollback' IO [[SQLData]] -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SomeException -> IO a
forall e a. Exception e => e -> IO a
throwIO SomeException
ex
        ]
    Just Int
n -> do
      let
        runIO :: SQL -> IO [[SQLData]]
runIO SQL
sql = (SQLite [[SQLData]] -> SQLiteStuff -> IO [[SQLData]]
forall a. SQLite a -> SQLiteStuff -> IO a
unSQLite (SQL -> SQLite [[SQLData]]
run SQL
sql)) (Database -> Maybe Int -> SQLiteStuff
SQLiteStuff Database
dbConn Maybe Int
forall a. Maybe a
Nothing)
        transactionName :: SQL
transactionName = SQL
"'sqlite_easy_transaction_" SQL -> SQL -> SQL
forall a. Semigroup a => a -> a -> a
<> String -> SQL
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
n) SQL -> SQL -> SQL
forall a. Semigroup a => a -> a -> a
<> SQL
"'"
        release :: IO [[SQLData]]
release = SQL -> IO [[SQLData]]
runIO (SQL -> IO [[SQLData]]) -> SQL -> IO [[SQLData]]
forall a b. (a -> b) -> a -> b
$ SQL
"RELEASE SAVEPOINT " SQL -> SQL -> SQL
forall a. Semigroup a => a -> a -> a
<> SQL
transactionName
        rollbackCurrent :: IO [[SQLData]]
rollbackCurrent = SQL -> IO [[SQLData]]
runIO (SQL -> IO [[SQLData]]) -> SQL -> IO [[SQLData]]
forall a b. (a -> b) -> a -> b
$ SQL
"ROLLBACK TRANSACTION TO SAVEPOINT " SQL -> SQL -> SQL
forall a. Semigroup a => a -> a -> a
<> SQL
transactionName
      [] <- SQL -> SQLite [[SQLData]]
run (SQL -> SQLite [[SQLData]]) -> SQL -> SQLite [[SQLData]]
forall a b. (a -> b) -> a -> b
$ SQL
"SAVEPOINT " SQL -> SQL -> SQL
forall a. Semigroup a => a -> a -> a
<> SQL
transactionName
      IO a -> SQLite a
forall a. IO a -> SQLite a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> SQLite a) -> IO a -> SQLite a
forall a b. (a -> b) -> a -> b
$ IO a -> [Handler a] -> IO a
forall a. IO a -> [Handler a] -> IO a
catches
        ((SQLite a -> SQLiteStuff -> IO a
forall a. SQLite a -> SQLiteStuff -> IO a
unSQLite SQLite a
action) (Database -> Maybe Int -> SQLiteStuff
SQLiteStuff Database
dbConn (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))) IO a -> IO [[SQLData]] -> IO a
forall a b. IO a -> IO b -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* IO [[SQLData]]
release)
        [ (RollbackCurrent a -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((RollbackCurrent a -> IO a) -> Handler a)
-> (RollbackCurrent a -> IO a) -> Handler a
forall a b. (a -> b) -> a -> b
$ \(RollbackCurrent a
a) -> IO [[SQLData]]
rollbackCurrent IO [[SQLData]] -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
        , (RollbackAll a -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((RollbackAll a -> IO a) -> Handler a)
-> (RollbackAll a -> IO a) -> Handler a
forall a b. (a -> b) -> a -> b
$ \(RollbackAll a
ex :: RollbackAll a) -> IO [[SQLData]]
rollbackCurrent IO [[SQLData]] -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RollbackAll a -> IO a
forall e a. Exception e => e -> IO a
throwIO RollbackAll a
ex
        , (SomeException -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((SomeException -> IO a) -> Handler a)
-> (SomeException -> IO a) -> Handler a
forall a b. (a -> b) -> a -> b
$ \(SomeException
ex :: SomeException) -> IO [[SQLData]]
rollbackCurrent IO [[SQLData]] -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SomeException -> IO a
forall e a. Exception e => e -> IO a
throwIO SomeException
ex
        ]

asTransaction' :: Database -> IO a -> IO a
asTransaction' :: forall a. Database -> IO a -> IO a
asTransaction' Database
db IO a
action = do
  let
    runIO :: SQL -> IO [[SQLData]]
runIO SQL
sql = (SQLite [[SQLData]] -> SQLiteStuff -> IO [[SQLData]]
forall a. SQLite a -> SQLiteStuff -> IO a
unSQLite (SQL -> SQLite [[SQLData]]
run SQL
sql)) (Database -> Maybe Int -> SQLiteStuff
SQLiteStuff Database
db Maybe Int
forall a. Maybe a
Nothing)
  [] <- SQL -> IO [[SQLData]]
runIO SQL
"BEGIN"
  IO a -> [Handler a] -> IO a
forall a. IO a -> [Handler a] -> IO a
catches
    (IO a
action IO a -> IO [[SQLData]] -> IO a
forall a b. IO a -> IO b -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* SQL -> IO [[SQLData]]
runIO SQL
"COMMIT")
    [ (SomeException -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((SomeException -> IO a) -> Handler a)
-> (SomeException -> IO a) -> Handler a
forall a b. (a -> b) -> a -> b
$ \(SomeException
ex :: SomeException) -> SQL -> IO [[SQLData]]
runIO SQL
"ROLLBACK" IO [[SQLData]] -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SomeException -> IO a
forall e a. Exception e => e -> IO a
throwIO SomeException
ex
    ]

-- | Rollback the current (inner-most) transaction by supplying the return value.
--   To be used inside transactions.
rollback :: Typeable a => a -> SQLite a
rollback :: forall a. Typeable a => a -> SQLite a
rollback = IO a -> SQLite a
forall a. IO a -> SQLite a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> SQLite a) -> (a -> IO a) -> a -> SQLite a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RollbackCurrent a -> IO a
forall e a. Exception e => e -> IO a
throwIO (RollbackCurrent a -> IO a)
-> (a -> RollbackCurrent a) -> a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> RollbackCurrent a
forall a. a -> RollbackCurrent a
RollbackCurrent

-- | Rollback all transaction structure by supplying the return value.
--   To be used inside transactions.
rollbackAll :: Typeable a => a -> SQLite a
rollbackAll :: forall a. Typeable a => a -> SQLite a
rollbackAll = IO a -> SQLite a
forall a. IO a -> SQLite a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> SQLite a) -> (a -> IO a) -> a -> SQLite a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RollbackAll a -> IO a
forall e a. Exception e => e -> IO a
throwIO (RollbackAll a -> IO a) -> (a -> RollbackAll a) -> a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> RollbackAll a
forall a. a -> RollbackAll a
RollbackAll

data RollbackCurrent a
  = RollbackCurrent a

instance Show (RollbackCurrent a) where
  show :: RollbackCurrent a -> String
show RollbackCurrent{} = String
"RollbackCurrent"

instance (Typeable a) => Exception (RollbackCurrent a)

data RollbackAll a
  = RollbackAll a

instance Show (RollbackAll a) where
  show :: RollbackAll a -> String
show RollbackAll{} = String
"RollbackAll"

instance (Typeable a) => Exception (RollbackAll a)