{-# language RecordWildCards #-}
{-# language DerivingVia #-}
{-# language OverloadedStrings #-}
{-# language ScopedTypeVariables #-}
module Database.Sqlite.Easy.Internal where
import Database.SQLite3
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
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
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
open Text
connStr)
Database -> IO ()
close
Double
180
Int
50
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
open Text
connStr) Database -> IO ()
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
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
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
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 :: 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
prepare Database
db Text
stmt) Statement -> IO ()
finalize Statement -> IO [[SQLData]]
fetchAll
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
prepare Database
db Text
stmt) Statement -> IO ()
finalize ((Statement -> IO [[SQLData]]) -> IO [[SQLData]])
-> (Statement -> IO [[SQLData]]) -> IO [[SQLData]]
forall a b. (a -> b) -> a -> b
$ \Statement
preparedStmt -> do
Statement -> [SQLData] -> IO ()
bind Statement
preparedStmt [SQLData]
params
Statement -> IO [[SQLData]]
fetchAll Statement
preparedStmt
fetchAll :: Statement -> IO [[SQLData]]
fetchAll :: Statement -> IO [[SQLData]]
fetchAll Statement
stmt = do
StepResult
res <- Statement -> IO StepResult
step Statement
stmt
case StepResult
res of
StepResult
Row -> do
[SQLData]
row <- Statement -> IO [SQLData]
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
Done ->
[[SQLData]] -> IO [[SQLData]]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
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)
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 :: 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
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)