{-# LANGUAGE GeneralizedNewtypeDeriving, CPP, TypeFamilies #-}
module Database.Selda.Backend.Internal
( StmtID (..), BackendID (..)
, QueryRunner, SeldaBackend (..), SeldaConnection (..), SeldaStmt (..)
, MonadSelda (..), SeldaT (..), SeldaM
, SeldaError (..)
, Param (..), Lit (..), ColAttr (..), AutoIncType (..)
, SqlType (..), SqlValue (..), SqlTypeRep (..)
, PPConfig (..), defPPConfig
, TableInfo (..), ColumnInfo (..), tableInfo, fromColInfo
, isAutoPrimary, isPrimary, isUnique
, sqlDateTimeFormat, sqlDateFormat, sqlTimeFormat
, freshStmtId
, newConnection, allStmts
, runSeldaT, withBackend
) where
import Data.List (nub)
import Database.Selda.SQL (Param (..))
import Database.Selda.SqlType
( SqlValue(..),
Lit(..),
SqlType(..),
SqlTypeRep(..),
sqlDateTimeFormat,
sqlDateFormat,
sqlTimeFormat )
import Database.Selda.Table.Type
( ColAttr(..),
AutoIncType(..),
Table(Table, tableAttrs, tableName, tableCols),
isAutoPrimary,
isPrimary,
isUnique )
import qualified Database.Selda.Table.Type as Table ( ColInfo(..) )
import Database.Selda.SQL.Print.Config
( PPConfig(..), defPPConfig )
import Database.Selda.Types (TableName, ColName)
import Data.Int (Int64)
import Control.Concurrent ( newMVar, putMVar, takeMVar, MVar )
import Control.Monad.Catch
( Exception, bracket, MonadCatch, MonadMask, MonadThrow(..) )
import Control.Monad.IO.Class ( MonadIO(..) )
import Control.Monad.Reader
( MonadTrans(..), when, ReaderT(..), MonadReader(ask) )
import Data.Dynamic ( Typeable, Dynamic )
import qualified Data.IntMap as M
import Data.IORef
( IORef, atomicModifyIORef', newIORef, readIORef )
import Data.Text (Text)
import System.IO.Unsafe (unsafePerformIO)
data BackendID = SQLite | PostgreSQL | Other Text
deriving (Int -> BackendID -> ShowS
[BackendID] -> ShowS
BackendID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BackendID] -> ShowS
$cshowList :: [BackendID] -> ShowS
show :: BackendID -> String
$cshow :: BackendID -> String
showsPrec :: Int -> BackendID -> ShowS
$cshowsPrec :: Int -> BackendID -> ShowS
Show, BackendID -> BackendID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BackendID -> BackendID -> Bool
$c/= :: BackendID -> BackendID -> Bool
== :: BackendID -> BackendID -> Bool
$c== :: BackendID -> BackendID -> Bool
Eq, Eq BackendID
BackendID -> BackendID -> Bool
BackendID -> BackendID -> Ordering
BackendID -> BackendID -> BackendID
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 :: BackendID -> BackendID -> BackendID
$cmin :: BackendID -> BackendID -> BackendID
max :: BackendID -> BackendID -> BackendID
$cmax :: BackendID -> BackendID -> BackendID
>= :: BackendID -> BackendID -> Bool
$c>= :: BackendID -> BackendID -> Bool
> :: BackendID -> BackendID -> Bool
$c> :: BackendID -> BackendID -> Bool
<= :: BackendID -> BackendID -> Bool
$c<= :: BackendID -> BackendID -> Bool
< :: BackendID -> BackendID -> Bool
$c< :: BackendID -> BackendID -> Bool
compare :: BackendID -> BackendID -> Ordering
$ccompare :: BackendID -> BackendID -> Ordering
Ord)
data SeldaError
= DbError String
| SqlError String
| UnsafeError String
deriving (Int -> SeldaError -> ShowS
[SeldaError] -> ShowS
SeldaError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SeldaError] -> ShowS
$cshowList :: [SeldaError] -> ShowS
show :: SeldaError -> String
$cshow :: SeldaError -> String
showsPrec :: Int -> SeldaError -> ShowS
$cshowsPrec :: Int -> SeldaError -> ShowS
Show, SeldaError -> SeldaError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SeldaError -> SeldaError -> Bool
$c/= :: SeldaError -> SeldaError -> Bool
== :: SeldaError -> SeldaError -> Bool
$c== :: SeldaError -> SeldaError -> Bool
Eq, Typeable)
instance Exception SeldaError
newtype StmtID = StmtID Int
deriving (Int -> StmtID -> ShowS
[StmtID] -> ShowS
StmtID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StmtID] -> ShowS
$cshowList :: [StmtID] -> ShowS
show :: StmtID -> String
$cshow :: StmtID -> String
showsPrec :: Int -> StmtID -> ShowS
$cshowsPrec :: Int -> StmtID -> ShowS
Show, StmtID -> StmtID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StmtID -> StmtID -> Bool
$c/= :: StmtID -> StmtID -> Bool
== :: StmtID -> StmtID -> Bool
$c== :: StmtID -> StmtID -> Bool
Eq, Eq StmtID
StmtID -> StmtID -> Bool
StmtID -> StmtID -> Ordering
StmtID -> StmtID -> StmtID
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 :: StmtID -> StmtID -> StmtID
$cmin :: StmtID -> StmtID -> StmtID
max :: StmtID -> StmtID -> StmtID
$cmax :: StmtID -> StmtID -> StmtID
>= :: StmtID -> StmtID -> Bool
$c>= :: StmtID -> StmtID -> Bool
> :: StmtID -> StmtID -> Bool
$c> :: StmtID -> StmtID -> Bool
<= :: StmtID -> StmtID -> Bool
$c<= :: StmtID -> StmtID -> Bool
< :: StmtID -> StmtID -> Bool
$c< :: StmtID -> StmtID -> Bool
compare :: StmtID -> StmtID -> Ordering
$ccompare :: StmtID -> StmtID -> Ordering
Ord)
newtype ConnID = ConnID Int
deriving (Int -> ConnID -> ShowS
[ConnID] -> ShowS
ConnID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnID] -> ShowS
$cshowList :: [ConnID] -> ShowS
show :: ConnID -> String
$cshow :: ConnID -> String
showsPrec :: Int -> ConnID -> ShowS
$cshowsPrec :: Int -> ConnID -> ShowS
Show, ConnID -> ConnID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnID -> ConnID -> Bool
$c/= :: ConnID -> ConnID -> Bool
== :: ConnID -> ConnID -> Bool
$c== :: ConnID -> ConnID -> Bool
Eq, Eq ConnID
ConnID -> ConnID -> Bool
ConnID -> ConnID -> Ordering
ConnID -> ConnID -> ConnID
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 :: ConnID -> ConnID -> ConnID
$cmin :: ConnID -> ConnID -> ConnID
max :: ConnID -> ConnID -> ConnID
$cmax :: ConnID -> ConnID -> ConnID
>= :: ConnID -> ConnID -> Bool
$c>= :: ConnID -> ConnID -> Bool
> :: ConnID -> ConnID -> Bool
$c> :: ConnID -> ConnID -> Bool
<= :: ConnID -> ConnID -> Bool
$c<= :: ConnID -> ConnID -> Bool
< :: ConnID -> ConnID -> Bool
$c< :: ConnID -> ConnID -> Bool
compare :: ConnID -> ConnID -> Ordering
$ccompare :: ConnID -> ConnID -> Ordering
Ord)
{-# NOINLINE nextStmtId #-}
nextStmtId :: IORef Int
nextStmtId :: IORef Int
nextStmtId = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef Int
1
freshStmtId :: MonadIO m => m StmtID
freshStmtId :: forall (m :: * -> *). MonadIO m => m StmtID
freshStmtId = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef Int
nextStmtId forall a b. (a -> b) -> a -> b
$ \Int
n -> (Int
nforall a. Num a => a -> a -> a
+Int
1, Int -> StmtID
StmtID Int
n)
type QueryRunner a = Text -> [Param] -> IO a
data SeldaStmt = SeldaStmt
{
SeldaStmt -> Dynamic
stmtHandle :: !Dynamic
, SeldaStmt -> Text
stmtText :: !Text
, SeldaStmt -> [Either Int Param]
stmtParams :: ![Either Int Param]
}
data SeldaConnection b = SeldaConnection
{
forall b. SeldaConnection b -> SeldaBackend b
connBackend :: !(SeldaBackend b)
, forall b. SeldaConnection b -> Text
connDbId :: Text
, forall b. SeldaConnection b -> IORef (IntMap SeldaStmt)
connStmts :: !(IORef (M.IntMap SeldaStmt))
, forall b. SeldaConnection b -> IORef Bool
connClosed :: !(IORef Bool)
, forall b. SeldaConnection b -> MVar ()
connLock :: !(MVar ())
}
newConnection :: MonadIO m => SeldaBackend b -> Text -> m (SeldaConnection b)
newConnection :: forall (m :: * -> *) b.
MonadIO m =>
SeldaBackend b -> Text -> m (SeldaConnection b)
newConnection SeldaBackend b
back Text
dbid =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall b.
SeldaBackend b
-> Text
-> IORef (IntMap SeldaStmt)
-> IORef Bool
-> MVar ()
-> SeldaConnection b
SeldaConnection SeldaBackend b
back Text
dbid forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef forall a. IntMap a
M.empty
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef Bool
False
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (MVar a)
newMVar ()
allStmts :: SeldaConnection b -> IO [(StmtID, Dynamic)]
allStmts :: forall b. SeldaConnection b -> IO [(StmtID, Dynamic)]
allStmts = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map (\(Int
k, SeldaStmt
v) -> (Int -> StmtID
StmtID Int
k, SeldaStmt -> Dynamic
stmtHandle SeldaStmt
v)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> [(Int, a)]
M.toList)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IORef a -> IO a
readIORef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. SeldaConnection b -> IORef (IntMap SeldaStmt)
connStmts
data TableInfo = TableInfo
{
TableInfo -> TableName
tableInfoName :: TableName
, TableInfo -> [ColumnInfo]
tableColumnInfos :: [ColumnInfo]
, TableInfo -> [[ColName]]
tableUniqueGroups :: [[ColName]]
, TableInfo -> [ColName]
tablePrimaryKey :: [ColName]
} deriving (Int -> TableInfo -> ShowS
[TableInfo] -> ShowS
TableInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableInfo] -> ShowS
$cshowList :: [TableInfo] -> ShowS
show :: TableInfo -> String
$cshow :: TableInfo -> String
showsPrec :: Int -> TableInfo -> ShowS
$cshowsPrec :: Int -> TableInfo -> ShowS
Show, TableInfo -> TableInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableInfo -> TableInfo -> Bool
$c/= :: TableInfo -> TableInfo -> Bool
== :: TableInfo -> TableInfo -> Bool
$c== :: TableInfo -> TableInfo -> Bool
Eq)
data ColumnInfo = ColumnInfo
{
ColumnInfo -> ColName
colName :: ColName
, ColumnInfo -> Either Text SqlTypeRep
colType :: Either Text SqlTypeRep
, ColumnInfo -> Bool
colIsAutoPrimary :: Bool
, ColumnInfo -> Bool
colIsNullable :: Bool
, ColumnInfo -> Bool
colHasIndex :: Bool
, ColumnInfo -> [(TableName, ColName)]
colFKs :: [(TableName, ColName)]
} deriving (Int -> ColumnInfo -> ShowS
[ColumnInfo] -> ShowS
ColumnInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnInfo] -> ShowS
$cshowList :: [ColumnInfo] -> ShowS
show :: ColumnInfo -> String
$cshow :: ColumnInfo -> String
showsPrec :: Int -> ColumnInfo -> ShowS
$cshowsPrec :: Int -> ColumnInfo -> ShowS
Show, ColumnInfo -> ColumnInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnInfo -> ColumnInfo -> Bool
$c/= :: ColumnInfo -> ColumnInfo -> Bool
== :: ColumnInfo -> ColumnInfo -> Bool
$c== :: ColumnInfo -> ColumnInfo -> Bool
Eq)
fromColInfo :: Table.ColInfo -> ColumnInfo
fromColInfo :: ColInfo -> ColumnInfo
fromColInfo ColInfo
ci = ColumnInfo
{ colName :: ColName
colName = ColInfo -> ColName
Table.colName ColInfo
ci
, colType :: Either Text SqlTypeRep
colType = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ ColInfo -> SqlTypeRep
Table.colType ColInfo
ci
, colIsAutoPrimary :: Bool
colIsAutoPrimary = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ColAttr -> Bool
isAutoPrimary (ColInfo -> [ColAttr]
Table.colAttrs ColInfo
ci)
, colIsNullable :: Bool
colIsNullable = ColAttr
Optional forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ColInfo -> [ColAttr]
Table.colAttrs ColInfo
ci
, colHasIndex :: Bool
colHasIndex = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [() | Indexed Maybe IndexMethod
_ <- ColInfo -> [ColAttr]
Table.colAttrs ColInfo
ci]
, colFKs :: [(TableName, ColName)]
colFKs = forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b}. (Table a, b) -> (TableName, b)
fk (ColInfo -> [(Table (), ColName)]
Table.colFKs ColInfo
ci)
}
where
fk :: (Table a, b) -> (TableName, b)
fk (Table TableName
tbl [ColInfo]
_ Bool
_ [([Int], ColAttr)]
_, b
col) = (TableName
tbl, b
col)
tableInfo :: Table a -> TableInfo
tableInfo :: forall a. Table a -> TableInfo
tableInfo Table a
t = TableInfo
{ tableInfoName :: TableName
tableInfoName = forall a. Table a -> TableName
tableName Table a
t
, tableColumnInfos :: [ColumnInfo]
tableColumnInfos = forall a b. (a -> b) -> [a] -> [b]
map ColInfo -> ColumnInfo
fromColInfo (forall a. Table a -> [ColInfo]
tableCols Table a
t)
, tableUniqueGroups :: [[ColName]]
tableUniqueGroups = [[ColName]]
uniqueGroups
, tablePrimaryKey :: [ColName]
tablePrimaryKey = [ColName]
pkGroup
}
where
uniqueGroups :: [[ColName]]
uniqueGroups =
[ forall a b. (a -> b) -> [a] -> [b]
map (ColInfo -> ColName
Table.colName forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((forall a. Table a -> [ColInfo]
tableCols Table a
t) forall a. [a] -> Int -> a
!!)) [Int]
ixs
| ([Int]
ixs, ColAttr
Unique) <- forall a. Table a -> [([Int], ColAttr)]
tableAttrs Table a
t
]
pkGroup :: [ColName]
pkGroup = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ 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 (ColInfo -> ColName
Table.colName forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((forall a. Table a -> [ColInfo]
tableCols Table a
t) forall a. [a] -> Int -> a
!!)) [Int]
ixs
| ([Int]
ixs, ColAttr
attr) <- forall a. Table a -> [([Int], ColAttr)]
tableAttrs Table a
t
, ColAttr -> Bool
isPrimary ColAttr
attr
]
, [ ColInfo -> ColName
Table.colName ColInfo
col
| ColInfo
col <- forall a. Table a -> [ColInfo]
tableCols Table a
t
, ColAttr
attr <- ColInfo -> [ColAttr]
Table.colAttrs ColInfo
col
, ColAttr -> Bool
isPrimary ColAttr
attr
]
]
data SeldaBackend b = SeldaBackend
{
forall b.
SeldaBackend b -> Text -> [Param] -> IO (Int, [[SqlValue]])
runStmt :: Text -> [Param] -> IO (Int, [[SqlValue]])
, forall b. SeldaBackend b -> Text -> [Param] -> IO Int64
runStmtWithPK :: Text -> [Param] -> IO Int64
, forall b.
SeldaBackend b -> StmtID -> [SqlTypeRep] -> Text -> IO Dynamic
prepareStmt :: StmtID -> [SqlTypeRep] -> Text -> IO Dynamic
, forall b.
SeldaBackend b -> Dynamic -> [Param] -> IO (Int, [[SqlValue]])
runPrepared :: Dynamic -> [Param] -> IO (Int, [[SqlValue]])
, forall b. SeldaBackend b -> TableName -> IO TableInfo
getTableInfo :: TableName -> IO TableInfo
, forall b. SeldaBackend b -> PPConfig
ppConfig :: PPConfig
, forall b. SeldaBackend b -> SeldaConnection b -> IO ()
closeConnection :: SeldaConnection b -> IO ()
, forall b. SeldaBackend b -> BackendID
backendId :: BackendID
, forall b. SeldaBackend b -> Bool -> IO ()
disableForeignKeys :: Bool -> IO ()
}
class MonadIO m => MonadSelda m where
{-# MINIMAL withConnection #-}
type Backend m
withConnection :: (SeldaConnection (Backend m) -> m a) -> m a
transact :: m a -> m a
transact = forall a. a -> a
id
withBackend :: MonadSelda m => (SeldaBackend (Backend m) -> m a) -> m a
withBackend :: forall (m :: * -> *) a.
MonadSelda m =>
(SeldaBackend (Backend m) -> m a) -> m a
withBackend SeldaBackend (Backend m) -> m a
m = forall (m :: * -> *) a.
MonadSelda m =>
(SeldaConnection (Backend m) -> m a) -> m a
withConnection (SeldaBackend (Backend m) -> m a
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. SeldaConnection b -> SeldaBackend b
connBackend)
newtype SeldaT b m a = S {forall b (m :: * -> *) a.
SeldaT b m a -> ReaderT (SeldaConnection b) m a
unS :: ReaderT (SeldaConnection b) m a}
deriving ( forall a b. a -> SeldaT b m b -> SeldaT b m a
forall a b. (a -> b) -> SeldaT b m a -> SeldaT b m b
forall b (m :: * -> *) a b.
Functor m =>
a -> SeldaT b m b -> SeldaT b m a
forall b (m :: * -> *) a b.
Functor m =>
(a -> b) -> SeldaT b m a -> SeldaT b m 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 -> SeldaT b m b -> SeldaT b m a
$c<$ :: forall b (m :: * -> *) a b.
Functor m =>
a -> SeldaT b m b -> SeldaT b m a
fmap :: forall a b. (a -> b) -> SeldaT b m a -> SeldaT b m b
$cfmap :: forall b (m :: * -> *) a b.
Functor m =>
(a -> b) -> SeldaT b m a -> SeldaT b m b
Functor, forall a. a -> SeldaT b m a
forall a b. SeldaT b m a -> SeldaT b m b -> SeldaT b m a
forall a b. SeldaT b m a -> SeldaT b m b -> SeldaT b m b
forall a b. SeldaT b m (a -> b) -> SeldaT b m a -> SeldaT b m b
forall a b c.
(a -> b -> c) -> SeldaT b m a -> SeldaT b m b -> SeldaT b m c
forall {b} {m :: * -> *}. Applicative m => Functor (SeldaT b m)
forall b (m :: * -> *) a. Applicative m => a -> SeldaT b m a
forall b (m :: * -> *) a b.
Applicative m =>
SeldaT b m a -> SeldaT b m b -> SeldaT b m a
forall b (m :: * -> *) a b.
Applicative m =>
SeldaT b m a -> SeldaT b m b -> SeldaT b m b
forall b (m :: * -> *) a b.
Applicative m =>
SeldaT b m (a -> b) -> SeldaT b m a -> SeldaT b m b
forall b (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> SeldaT b m a -> SeldaT b m b -> SeldaT b m 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. SeldaT b m a -> SeldaT b m b -> SeldaT b m a
$c<* :: forall b (m :: * -> *) a b.
Applicative m =>
SeldaT b m a -> SeldaT b m b -> SeldaT b m a
*> :: forall a b. SeldaT b m a -> SeldaT b m b -> SeldaT b m b
$c*> :: forall b (m :: * -> *) a b.
Applicative m =>
SeldaT b m a -> SeldaT b m b -> SeldaT b m b
liftA2 :: forall a b c.
(a -> b -> c) -> SeldaT b m a -> SeldaT b m b -> SeldaT b m c
$cliftA2 :: forall b (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> SeldaT b m a -> SeldaT b m b -> SeldaT b m c
<*> :: forall a b. SeldaT b m (a -> b) -> SeldaT b m a -> SeldaT b m b
$c<*> :: forall b (m :: * -> *) a b.
Applicative m =>
SeldaT b m (a -> b) -> SeldaT b m a -> SeldaT b m b
pure :: forall a. a -> SeldaT b m a
$cpure :: forall b (m :: * -> *) a. Applicative m => a -> SeldaT b m a
Applicative, forall a. a -> SeldaT b m a
forall a b. SeldaT b m a -> SeldaT b m b -> SeldaT b m b
forall a b. SeldaT b m a -> (a -> SeldaT b m b) -> SeldaT b m b
forall {b} {m :: * -> *}. Monad m => Applicative (SeldaT b m)
forall b (m :: * -> *) a. Monad m => a -> SeldaT b m a
forall b (m :: * -> *) a b.
Monad m =>
SeldaT b m a -> SeldaT b m b -> SeldaT b m b
forall b (m :: * -> *) a b.
Monad m =>
SeldaT b m a -> (a -> SeldaT b m b) -> SeldaT b m 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 -> SeldaT b m a
$creturn :: forall b (m :: * -> *) a. Monad m => a -> SeldaT b m a
>> :: forall a b. SeldaT b m a -> SeldaT b m b -> SeldaT b m b
$c>> :: forall b (m :: * -> *) a b.
Monad m =>
SeldaT b m a -> SeldaT b m b -> SeldaT b m b
>>= :: forall a b. SeldaT b m a -> (a -> SeldaT b m b) -> SeldaT b m b
$c>>= :: forall b (m :: * -> *) a b.
Monad m =>
SeldaT b m a -> (a -> SeldaT b m b) -> SeldaT b m b
Monad, forall a. IO a -> SeldaT b m a
forall {b} {m :: * -> *}. MonadIO m => Monad (SeldaT b m)
forall b (m :: * -> *) a. MonadIO m => IO a -> SeldaT b m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> SeldaT b m a
$cliftIO :: forall b (m :: * -> *) a. MonadIO m => IO a -> SeldaT b m a
MonadIO
, forall e a. Exception e => e -> SeldaT b m a
forall {b} {m :: * -> *}. MonadThrow m => Monad (SeldaT b m)
forall b (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> SeldaT b m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> SeldaT b m a
$cthrowM :: forall b (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> SeldaT b m a
MonadThrow, forall e a.
Exception e =>
SeldaT b m a -> (e -> SeldaT b m a) -> SeldaT b m a
forall {b} {m :: * -> *}. MonadCatch m => MonadThrow (SeldaT b m)
forall b (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
SeldaT b m a -> (e -> SeldaT b m a) -> SeldaT b m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: forall e a.
Exception e =>
SeldaT b m a -> (e -> SeldaT b m a) -> SeldaT b m a
$ccatch :: forall b (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
SeldaT b m a -> (e -> SeldaT b m a) -> SeldaT b m a
MonadCatch, forall b.
((forall a. SeldaT b m a -> SeldaT b m a) -> SeldaT b m b)
-> SeldaT b m b
forall a b c.
SeldaT b m a
-> (a -> ExitCase b -> SeldaT b m c)
-> (a -> SeldaT b m b)
-> SeldaT b m (b, c)
forall {b} {m :: * -> *}. MonadMask m => MonadCatch (SeldaT b m)
forall b (m :: * -> *) b.
MonadMask m =>
((forall a. SeldaT b m a -> SeldaT b m a) -> SeldaT b m b)
-> SeldaT b m b
forall b (m :: * -> *) a b c.
MonadMask m =>
SeldaT b m a
-> (a -> ExitCase b -> SeldaT b m c)
-> (a -> SeldaT b m b)
-> SeldaT b m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: forall a b c.
SeldaT b m a
-> (a -> ExitCase b -> SeldaT b m c)
-> (a -> SeldaT b m b)
-> SeldaT b m (b, c)
$cgeneralBracket :: forall b (m :: * -> *) a b c.
MonadMask m =>
SeldaT b m a
-> (a -> ExitCase b -> SeldaT b m c)
-> (a -> SeldaT b m b)
-> SeldaT b m (b, c)
uninterruptibleMask :: forall b.
((forall a. SeldaT b m a -> SeldaT b m a) -> SeldaT b m b)
-> SeldaT b m b
$cuninterruptibleMask :: forall b (m :: * -> *) b.
MonadMask m =>
((forall a. SeldaT b m a -> SeldaT b m a) -> SeldaT b m b)
-> SeldaT b m b
mask :: forall b.
((forall a. SeldaT b m a -> SeldaT b m a) -> SeldaT b m b)
-> SeldaT b m b
$cmask :: forall b (m :: * -> *) b.
MonadMask m =>
((forall a. SeldaT b m a -> SeldaT b m a) -> SeldaT b m b)
-> SeldaT b m b
MonadMask , forall a. String -> SeldaT b m a
forall {b} {m :: * -> *}. MonadFail m => Monad (SeldaT b m)
forall b (m :: * -> *) a. MonadFail m => String -> SeldaT b m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: forall a. String -> SeldaT b m a
$cfail :: forall b (m :: * -> *) a. MonadFail m => String -> SeldaT b m a
MonadFail
)
instance (MonadIO m, MonadMask m) => MonadSelda (SeldaT b m) where
type Backend (SeldaT b m) = b
withConnection :: forall a.
(SeldaConnection (Backend (SeldaT b m)) -> SeldaT b m a)
-> SeldaT b m a
withConnection SeldaConnection (Backend (SeldaT b m)) -> SeldaT b m a
m = forall b (m :: * -> *) a.
ReaderT (SeldaConnection b) m a -> SeldaT b m a
S forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SeldaConnection (Backend (SeldaT b m)) -> SeldaT b m a
m
instance MonadTrans (SeldaT b) where
lift :: forall (m :: * -> *) a. Monad m => m a -> SeldaT b m a
lift = forall b (m :: * -> *) a.
ReaderT (SeldaConnection b) m a -> SeldaT b m a
S forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
type SeldaM b = SeldaT b IO
runSeldaT :: (MonadIO m, MonadMask m)
=> SeldaT b m a
-> SeldaConnection b
-> m a
runSeldaT :: forall (m :: * -> *) b a.
(MonadIO m, MonadMask m) =>
SeldaT b m a -> SeldaConnection b -> m a
runSeldaT SeldaT b m a
m SeldaConnection b
c =
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
takeMVar (forall b. SeldaConnection b -> MVar ()
connLock SeldaConnection b
c))
(forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO ()
putMVar (forall b. SeldaConnection b -> MVar ()
connLock SeldaConnection b
c) ())
(forall a b. a -> b -> a
const m a
go)
where
go :: m a
go = do
Bool
closed <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef (forall b. SeldaConnection b -> IORef Bool
connClosed SeldaConnection b
c)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
closed forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> SeldaError
DbError String
"runSeldaT called with a closed connection"
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall b (m :: * -> *) a.
SeldaT b m a -> ReaderT (SeldaConnection b) m a
unS SeldaT b m a
m) SeldaConnection b
c