{-# 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
forall a. (String -> a) -> IsString a
fromString :: String -> ConnectionString
$cfromString :: String -> ConnectionString
IsString via Text
deriving Int -> ConnectionString -> ShowS
[ConnectionString] -> ShowS
ConnectionString -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectionString] -> ShowS
$cshowList :: [ConnectionString] -> ShowS
show :: ConnectionString -> String
$cshow :: ConnectionString -> String
showsPrec :: Int -> ConnectionString -> ShowS
$cshowsPrec :: Int -> ConnectionString -> ShowS
Show
createSqlitePool :: ConnectionString -> IO (Pool Database)
createSqlitePool :: ConnectionString -> IO (Pool Database)
createSqlitePool (ConnectionString Text
connStr) =
forall a. PoolConfig a -> IO (Pool a)
newPool PoolConfig
{ createResource :: IO Database
createResource = Text -> IO Database
open Text
connStr
, freeResource :: Database -> IO ()
freeResource = Database -> IO ()
close
, poolCacheTTL :: Double
poolCacheTTL = Double
180
, poolMaxResources :: Int
poolMaxResources = Int
50
}
withDb :: ConnectionString -> SQLite a -> IO a
withDb :: forall a. ConnectionString -> SQLite a -> IO a
withDb (ConnectionString Text
connStr) =
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Text -> IO Database
open Text
connStr) Database -> IO ()
close forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Database -> SQLite a -> IO a
runSQLite
withDatabase :: Database -> SQLite a -> IO a
withDatabase :: forall a. Database -> SQLite a -> IO a
withDatabase = 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 = forall a r. Pool a -> (a -> IO r) -> IO r
withResource Pool Database
pool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Database -> SQLite a -> IO a
runSQLite
newtype SQL
= SQL
{ SQL -> Text
unSQL :: Text
}
deriving (NonEmpty SQL -> SQL
SQL -> SQL -> 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
stimes :: forall b. Integral b => b -> SQL -> SQL
$cstimes :: forall b. Integral b => b -> SQL -> SQL
sconcat :: NonEmpty SQL -> SQL
$csconcat :: NonEmpty SQL -> SQL
<> :: SQL -> SQL -> SQL
$c<> :: SQL -> SQL -> SQL
Semigroup, String -> SQL
forall a. (String -> a) -> IsString a
fromString :: String -> SQL
$cfromString :: String -> SQL
IsString) via Text
deriving Int -> SQL -> ShowS
[SQL] -> ShowS
SQL -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SQL] -> ShowS
$cshowList :: [SQL] -> ShowS
show :: SQL -> String
$cshow :: SQL -> String
showsPrec :: Int -> SQL -> ShowS
$cshowsPrec :: Int -> SQL -> ShowS
Show
run :: SQL -> SQLite [[SQLData]]
run :: SQL -> SQLite [[SQLData]]
run (SQL Text
stmt) = do
Database
db <- SQLite Database
getDB
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
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 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
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([SQLData]
row forall a. a -> [a] -> [a]
: [[SQLData]]
rows)
StepResult
Done ->
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 -> 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
<$ :: forall a b. a -> SQLite b -> SQLite a
$c<$ :: forall a b. a -> SQLite b -> SQLite a
fmap :: forall a b. (a -> b) -> SQLite a -> SQLite b
$cfmap :: forall a b. (a -> b) -> SQLite a -> SQLite b
Functor, Functor 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
<* :: forall a b. SQLite a -> SQLite b -> SQLite a
$c<* :: forall a b. SQLite a -> SQLite b -> SQLite a
*> :: forall a b. SQLite a -> SQLite b -> SQLite b
$c*> :: forall a b. SQLite a -> SQLite b -> SQLite b
liftA2 :: forall a b c. (a -> b -> c) -> SQLite a -> SQLite b -> SQLite c
$cliftA2 :: forall a b c. (a -> b -> c) -> SQLite a -> SQLite b -> SQLite c
<*> :: forall a b. SQLite (a -> b) -> SQLite a -> SQLite b
$c<*> :: forall a b. SQLite (a -> b) -> SQLite a -> SQLite b
pure :: forall a. a -> SQLite a
$cpure :: forall a. a -> SQLite a
Applicative, Applicative 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
return :: forall a. a -> SQLite a
$creturn :: forall a. a -> SQLite a
>> :: forall a b. SQLite a -> SQLite b -> SQLite b
$c>> :: forall a b. SQLite a -> SQLite b -> SQLite b
>>= :: forall a b. SQLite a -> (a -> SQLite b) -> SQLite b
$c>>= :: forall a b. SQLite a -> (a -> SQLite b) -> SQLite b
Monad, Monad SQLite
forall a. IO a -> SQLite a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> SQLite a
$cliftIO :: forall a. IO a -> SQLite a
MonadIO, Monad SQLite
forall a. String -> SQLite a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: forall a. String -> SQLite a
$cfail :: forall a. String -> SQLite a
MonadFail, MonadIO 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
withRunInIO :: forall b. ((forall a. SQLite a -> IO a) -> IO b) -> SQLite b
$cwithRunInIO :: 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 = forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SQLite a
a 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall a. (SQLiteStuff -> IO a) -> SQLite a
SQLite (\(SQLiteStuff Database
dbConn Maybe Int
_) -> 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 = (forall a. SQLite a -> SQLiteStuff -> IO a
unSQLite SQLite a
t) (Database -> Maybe Int -> SQLiteStuff
SQLiteStuff Database
db 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
transactionNumber :: Maybe Int
dbConn :: Database
transactionNumber :: SQLiteStuff -> Maybe Int
dbConn :: SQLiteStuff -> Database
..} <- forall a. (SQLiteStuff -> IO a) -> SQLite a
SQLite forall a b. (a -> b) -> a -> b
$ \SQLiteStuff
stuff -> 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 = (forall a. SQLite a -> SQLiteStuff -> IO a
unSQLite (SQL -> SQLite [[SQLData]]
run SQL
sql)) (Database -> Maybe Int -> SQLiteStuff
SQLiteStuff Database
dbConn 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"
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> [Handler a] -> IO a
catches
((forall a. SQLite a -> SQLiteStuff -> IO a
unSQLite SQLite a
action) (Database -> Maybe Int -> SQLiteStuff
SQLiteStuff Database
dbConn (forall a. a -> Maybe a
Just Int
1)) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* IO [[SQLData]]
commit)
[ forall a e. Exception e => (e -> IO a) -> Handler a
Handler forall a b. (a -> b) -> a -> b
$ \(RollbackCurrent a
a) -> IO [[SQLData]]
rollback' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
, forall a e. Exception e => (e -> IO a) -> Handler a
Handler forall a b. (a -> b) -> a -> b
$ \(RollbackAll a
a) -> IO [[SQLData]]
rollback' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
, forall a e. Exception e => (e -> IO a) -> Handler a
Handler forall a b. (a -> b) -> a -> b
$ \(SomeException
ex :: SomeException) -> IO [[SQLData]]
rollback' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e a. Exception e => e -> IO a
throwIO SomeException
ex
]
Just Int
n -> do
let
runIO :: SQL -> IO [[SQLData]]
runIO SQL
sql = (forall a. SQLite a -> SQLiteStuff -> IO a
unSQLite (SQL -> SQLite [[SQLData]]
run SQL
sql)) (Database -> Maybe Int -> SQLiteStuff
SQLiteStuff Database
dbConn forall a. Maybe a
Nothing)
transactionName :: SQL
transactionName = SQL
"'sqlite_easy_transaction_" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
n) forall a. Semigroup a => a -> a -> a
<> SQL
"'"
release :: IO [[SQLData]]
release = SQL -> IO [[SQLData]]
runIO forall a b. (a -> b) -> a -> b
$ SQL
"RELEASE SAVEPOINT " forall a. Semigroup a => a -> a -> a
<> SQL
transactionName
rollbackCurrent :: IO [[SQLData]]
rollbackCurrent = SQL -> IO [[SQLData]]
runIO forall a b. (a -> b) -> a -> b
$ SQL
"ROLLBACK TRANSACTION TO SAVEPOINT " forall a. Semigroup a => a -> a -> a
<> SQL
transactionName
[] <- SQL -> SQLite [[SQLData]]
run forall a b. (a -> b) -> a -> b
$ SQL
"SAVEPOINT " forall a. Semigroup a => a -> a -> a
<> SQL
transactionName
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> [Handler a] -> IO a
catches
((forall a. SQLite a -> SQLiteStuff -> IO a
unSQLite SQLite a
action) (Database -> Maybe Int -> SQLiteStuff
SQLiteStuff Database
dbConn (forall a. a -> Maybe a
Just (Int
n forall a. Num a => a -> a -> a
+ Int
1))) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* IO [[SQLData]]
release)
[ forall a e. Exception e => (e -> IO a) -> Handler a
Handler forall a b. (a -> b) -> a -> b
$ \(RollbackCurrent a
a) -> IO [[SQLData]]
rollbackCurrent forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
, forall a e. Exception e => (e -> IO a) -> Handler a
Handler forall a b. (a -> b) -> a -> b
$ \(RollbackAll a
ex :: RollbackAll a) -> IO [[SQLData]]
rollbackCurrent forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e a. Exception e => e -> IO a
throwIO RollbackAll a
ex
, forall a e. Exception e => (e -> IO a) -> Handler a
Handler forall a b. (a -> b) -> a -> b
$ \(SomeException
ex :: SomeException) -> IO [[SQLData]]
rollbackCurrent forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> 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 = (forall a. SQLite a -> SQLiteStuff -> IO a
unSQLite (SQL -> SQLite [[SQLData]]
run SQL
sql)) (Database -> Maybe Int -> SQLiteStuff
SQLiteStuff Database
db forall a. Maybe a
Nothing)
[] <- SQL -> IO [[SQLData]]
runIO SQL
"BEGIN"
forall a. IO a -> [Handler a] -> IO a
catches
(IO a
action forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* SQL -> IO [[SQLData]]
runIO SQL
"COMMIT")
[ forall a e. Exception e => (e -> IO a) -> Handler a
Handler forall a b. (a -> b) -> a -> b
$ \(SomeException
ex :: SomeException) -> SQL -> IO [[SQLData]]
runIO SQL
"ROLLBACK" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> RollbackCurrent a
RollbackCurrent
rollbackAll :: Typeable a => a -> SQLite a
rollbackAll :: forall a. Typeable a => a -> SQLite a
rollbackAll = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)