module Database.Persist.Sql.Types
( module Database.Persist.Sql.Types
, SqlBackend, SqlReadBackend (..), SqlWriteBackend (..)
, Statement (..), LogFunc, InsertSqlResult (..)
, readToUnknown, readToWrite, writeToUnknown
, SqlBackendCanRead, SqlBackendCanWrite, SqlReadT, SqlWriteT, IsSqlBackend
, OverflowNatural(..)
, ConnectionPoolConfig(..)
) where
import Control.Exception (Exception(..))
import Control.Monad.Logger (NoLoggingT)
import Control.Monad.Trans.Reader (ReaderT(..))
import Control.Monad.Trans.Resource (ResourceT)
import Data.Pool (Pool)
import Data.Text (Text)
import Data.Time (NominalDiffTime)
import Database.Persist.Sql.Types.Internal
import Database.Persist.Types
data Column = Column
{ Column -> FieldNameDB
cName :: !FieldNameDB
, Column -> Bool
cNull :: !Bool
, Column -> SqlType
cSqlType :: !SqlType
, Column -> Maybe Text
cDefault :: !(Maybe Text)
, Column -> Maybe Text
cGenerated :: !(Maybe Text)
, Column -> Maybe ConstraintNameDB
cDefaultConstraintName :: !(Maybe ConstraintNameDB)
, Column -> Maybe Integer
cMaxLen :: !(Maybe Integer)
, Column -> Maybe ColumnReference
cReference :: !(Maybe ColumnReference)
}
deriving (Column -> Column -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Column -> Column -> Bool
$c/= :: Column -> Column -> Bool
== :: Column -> Column -> Bool
$c== :: Column -> Column -> Bool
Eq, Eq Column
Column -> Column -> Bool
Column -> Column -> Ordering
Column -> Column -> Column
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 :: Column -> Column -> Column
$cmin :: Column -> Column -> Column
max :: Column -> Column -> Column
$cmax :: Column -> Column -> Column
>= :: Column -> Column -> Bool
$c>= :: Column -> Column -> Bool
> :: Column -> Column -> Bool
$c> :: Column -> Column -> Bool
<= :: Column -> Column -> Bool
$c<= :: Column -> Column -> Bool
< :: Column -> Column -> Bool
$c< :: Column -> Column -> Bool
compare :: Column -> Column -> Ordering
$ccompare :: Column -> Column -> Ordering
Ord, Int -> Column -> ShowS
[Column] -> ShowS
Column -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Column] -> ShowS
$cshowList :: [Column] -> ShowS
show :: Column -> String
$cshow :: Column -> String
showsPrec :: Int -> Column -> ShowS
$cshowsPrec :: Int -> Column -> ShowS
Show)
data ColumnReference = ColumnReference
{ ColumnReference -> EntityNameDB
crTableName :: !EntityNameDB
, ColumnReference -> ConstraintNameDB
crConstraintName :: !ConstraintNameDB
, ColumnReference -> FieldCascade
crFieldCascade :: !FieldCascade
}
deriving (ColumnReference -> ColumnReference -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnReference -> ColumnReference -> Bool
$c/= :: ColumnReference -> ColumnReference -> Bool
== :: ColumnReference -> ColumnReference -> Bool
$c== :: ColumnReference -> ColumnReference -> Bool
Eq, Eq ColumnReference
ColumnReference -> ColumnReference -> Bool
ColumnReference -> ColumnReference -> Ordering
ColumnReference -> ColumnReference -> ColumnReference
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 :: ColumnReference -> ColumnReference -> ColumnReference
$cmin :: ColumnReference -> ColumnReference -> ColumnReference
max :: ColumnReference -> ColumnReference -> ColumnReference
$cmax :: ColumnReference -> ColumnReference -> ColumnReference
>= :: ColumnReference -> ColumnReference -> Bool
$c>= :: ColumnReference -> ColumnReference -> Bool
> :: ColumnReference -> ColumnReference -> Bool
$c> :: ColumnReference -> ColumnReference -> Bool
<= :: ColumnReference -> ColumnReference -> Bool
$c<= :: ColumnReference -> ColumnReference -> Bool
< :: ColumnReference -> ColumnReference -> Bool
$c< :: ColumnReference -> ColumnReference -> Bool
compare :: ColumnReference -> ColumnReference -> Ordering
$ccompare :: ColumnReference -> ColumnReference -> Ordering
Ord, Int -> ColumnReference -> ShowS
[ColumnReference] -> ShowS
ColumnReference -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnReference] -> ShowS
$cshowList :: [ColumnReference] -> ShowS
show :: ColumnReference -> String
$cshow :: ColumnReference -> String
showsPrec :: Int -> ColumnReference -> ShowS
$cshowsPrec :: Int -> ColumnReference -> ShowS
Show)
data PersistentSqlException = StatementAlreadyFinalized Text
| Couldn'tGetSQLConnection
deriving Int -> PersistentSqlException -> ShowS
[PersistentSqlException] -> ShowS
PersistentSqlException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PersistentSqlException] -> ShowS
$cshowList :: [PersistentSqlException] -> ShowS
show :: PersistentSqlException -> String
$cshow :: PersistentSqlException -> String
showsPrec :: Int -> PersistentSqlException -> ShowS
$cshowsPrec :: Int -> PersistentSqlException -> ShowS
Show
instance Exception PersistentSqlException
type SqlPersistT = ReaderT SqlBackend
type SqlPersistM = SqlPersistT (NoLoggingT (ResourceT IO))
type ConnectionPool = Pool SqlBackend
data ConnectionPoolConfig = ConnectionPoolConfig
{ ConnectionPoolConfig -> Int
connectionPoolConfigStripes :: Int
, ConnectionPoolConfig -> NominalDiffTime
connectionPoolConfigIdleTimeout :: NominalDiffTime
, ConnectionPoolConfig -> Int
connectionPoolConfigSize :: Int
}
deriving (Int -> ConnectionPoolConfig -> ShowS
[ConnectionPoolConfig] -> ShowS
ConnectionPoolConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectionPoolConfig] -> ShowS
$cshowList :: [ConnectionPoolConfig] -> ShowS
show :: ConnectionPoolConfig -> String
$cshow :: ConnectionPoolConfig -> String
showsPrec :: Int -> ConnectionPoolConfig -> ShowS
$cshowsPrec :: Int -> ConnectionPoolConfig -> ShowS
Show)
defaultConnectionPoolConfig :: ConnectionPoolConfig
defaultConnectionPoolConfig :: ConnectionPoolConfig
defaultConnectionPoolConfig = Int -> NominalDiffTime -> Int -> ConnectionPoolConfig
ConnectionPoolConfig Int
1 NominalDiffTime
600 Int
10
newtype Single a = Single {forall a. Single a -> a
unSingle :: a}
deriving (Single a -> Single a -> Bool
forall a. Eq a => Single a -> Single a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Single a -> Single a -> Bool
$c/= :: forall a. Eq a => Single a -> Single a -> Bool
== :: Single a -> Single a -> Bool
$c== :: forall a. Eq a => Single a -> Single a -> Bool
Eq, Single a -> Single a -> Bool
Single a -> Single a -> Ordering
Single a -> Single a -> Single a
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
forall {a}. Ord a => Eq (Single a)
forall a. Ord a => Single a -> Single a -> Bool
forall a. Ord a => Single a -> Single a -> Ordering
forall a. Ord a => Single a -> Single a -> Single a
min :: Single a -> Single a -> Single a
$cmin :: forall a. Ord a => Single a -> Single a -> Single a
max :: Single a -> Single a -> Single a
$cmax :: forall a. Ord a => Single a -> Single a -> Single a
>= :: Single a -> Single a -> Bool
$c>= :: forall a. Ord a => Single a -> Single a -> Bool
> :: Single a -> Single a -> Bool
$c> :: forall a. Ord a => Single a -> Single a -> Bool
<= :: Single a -> Single a -> Bool
$c<= :: forall a. Ord a => Single a -> Single a -> Bool
< :: Single a -> Single a -> Bool
$c< :: forall a. Ord a => Single a -> Single a -> Bool
compare :: Single a -> Single a -> Ordering
$ccompare :: forall a. Ord a => Single a -> Single a -> Ordering
Ord, Int -> Single a -> ShowS
forall a. Show a => Int -> Single a -> ShowS
forall a. Show a => [Single a] -> ShowS
forall a. Show a => Single a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Single a] -> ShowS
$cshowList :: forall a. Show a => [Single a] -> ShowS
show :: Single a -> String
$cshow :: forall a. Show a => Single a -> String
showsPrec :: Int -> Single a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Single a -> ShowS
Show, ReadPrec [Single a]
ReadPrec (Single a)
ReadS [Single a]
forall a. Read a => ReadPrec [Single a]
forall a. Read a => ReadPrec (Single a)
forall a. Read a => Int -> ReadS (Single a)
forall a. Read a => ReadS [Single a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Single a]
$creadListPrec :: forall a. Read a => ReadPrec [Single a]
readPrec :: ReadPrec (Single a)
$creadPrec :: forall a. Read a => ReadPrec (Single a)
readList :: ReadS [Single a]
$creadList :: forall a. Read a => ReadS [Single a]
readsPrec :: Int -> ReadS (Single a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Single a)
Read)