Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- newtype Only a = Only {
- fromOnly :: a
- newtype Oid = Oid CUInt
- pgSelectCount :: forall m a q. (Entity a, MonadPostgres m, MonadLogger m, MonadFail m, ToSqlBuilder q) => Proxy a -> q -> m Integer
- pgQueryEntities :: (ToSqlBuilder q, MonadPostgres m, MonadLogger m, Entity a, FromRow a, FromField (EntityId a)) => q -> m [Ent a]
- pgUpdateEntity :: forall a b m. (ToMarkedRow b, Entity a, MonadPostgres m, MonadLogger m, ToField (EntityId a), Functor m, Typeable a, Typeable b) => EntityId a -> b -> m Bool
- pgDeleteEntity :: (Entity a, MonadPostgres m, MonadLogger m, ToField (EntityId a), Functor m) => EntityId a -> m Bool
- pgInsertManyEntities :: (Entity a, MonadPostgres m, MonadLogger m, ToRow a) => [a] -> m Int64
- pgInsertManyEntitiesId :: (Entity a, MonadPostgres m, MonadLogger m, ToRow a, FromField (EntityId a)) => [a] -> m [EntityId a]
- pgGetEntityBy :: forall m a b. (Entity a, MonadPostgres m, MonadLogger m, ToMarkedRow b, FromField (EntityId a), FromRow a, Functor m) => b -> m (Maybe (Ent a))
- pgGetEntity :: forall m a. (ToField (EntityId a), Entity a, FromRow a, MonadPostgres m, MonadLogger m, Functor m) => EntityId a -> m (Maybe a)
- pgSelectEntitiesBy :: forall a m b. (Functor m, MonadPostgres m, MonadLogger m, Entity a, ToMarkedRow b, FromRow a, FromField (EntityId a)) => b -> m [Ent a]
- pgSelectJustEntities :: (Functor m, MonadPostgres m, MonadLogger m, Entity a, FromRow a, ToSqlBuilder q) => (FN -> FN) -> q -> m [a]
- pgSelectEntities :: (Functor m, MonadPostgres m, MonadLogger m, Entity a, FromRow a, ToSqlBuilder q, FromField (EntityId a)) => (FN -> FN) -> q -> m [Ent a]
- pgInsertEntity :: forall a m. (MonadPostgres m, MonadLogger m, MonadFail m, Entity a, ToRow a, FromField (EntityId a)) => a -> m (EntityId a)
- insertManyEntities :: (Entity a, ToRow a) => NonEmpty a -> SqlBuilder
- insertEntity :: (Entity a, ToRow a) => a -> SqlBuilder
- entityToMR :: (Entity a, ToRow a) => a -> MarkedRow
- selectEntitiesBy :: (Entity a, ToMarkedRow b) => ([FN] -> [FN]) -> Proxy a -> b -> SqlBuilder
- selectEntity :: Entity a => (Proxy a -> SqlBuilder) -> Proxy a -> SqlBuilder
- entityFieldsId :: Entity a => (FN -> FN) -> Proxy a -> SqlBuilder
- entityFields :: Entity a => ([FN] -> [FN]) -> (FN -> FN) -> Proxy a -> SqlBuilder
- pgRepsertRow :: (MonadPostgres m, MonadLogger m, ToMarkedRow wrow, ToMarkedRow urow) => FN -> wrow -> urow -> m ()
- deriveEverything :: EntityOptions -> Name -> Q [Dec]
- deriveEntity :: EntityOptions -> Name -> Q [Dec]
- data EntityOptions = EntityOptions {
- eoTableName :: Text -> FN
- eoColumnNames :: Text -> FN
- eoDeriveClasses :: [Name]
- eoIdType :: Name
- data family EntityId a
- class Entity a where
- type Ent a = (EntityId a, a)
- launchPG :: HasPostgres m => PgMonadT m a -> m a
- runPgMonadT :: Connection -> PgMonadT m a -> m a
- mrToBuilder :: SqlBuilder -> MarkedRow -> SqlBuilder
- textFN :: Text -> FN
- newtype MarkedRow = MR {
- unMR :: [(FN, SqlBuilder)]
- class ToMarkedRow a where
- toMarkedRow :: a -> MarkedRow
- type MonadPostgres (m :: Type -> Type) = (HasPostgres m, MonadLogger m)
- class MonadBase IO m => HasPostgres (m :: Type -> Type) where
- withPGConnection :: (Connection -> m a) -> m a
- class TransactionSafe (m :: Type -> Type)
- newtype PgMonadT (m :: Type -> Type) a = PgMonadT {
- unPgMonadT :: ReaderT Connection m a
- data Qp = ToRow row => Qp Query row
- newtype InetText = InetText {
- unInetText :: Text
- newtype FN = FN [Text]
- sqlExpFile :: String -> Q Exp
- sqlExpEmbed :: String -> Q Exp
- sqlQExp :: String -> Q Exp
- squashRope :: [Rope] -> [Rope]
- ropeParser :: Parser [Rope]
- parseRope :: String -> [Rope]
- sqlExp :: QuasiQuoter
- data Rope
- deriveToRow :: Name -> Q [Dec]
- deriveFromRow :: Name -> Q [Dec]
- derivePgEnum :: InflectorFunc -> Name -> DecsQ
- type InflectorFunc = String -> String
- class ToSqlBuilder a where
- toSqlBuilder :: a -> SqlBuilder
- sqlBuilderFromByteString :: ByteString -> SqlBuilder
- sqlBuilderPure :: Builder -> SqlBuilder
- sqlBuilderFromField :: ToField a => FieldOption -> a -> SqlBuilder
- mkMaskedValue :: ToField a => a -> SqlBuilder
- mkValue :: ToField a => a -> SqlBuilder
- emptyB :: SqlBuilder
- runSqlBuilder :: Connection -> LogMasker -> SqlBuilder -> IO (Query, ByteString)
- newtype SqlBuilder = SqlBuilder {
- sqlBuild :: Connection -> LogMasker -> IO SqlBuilderResult
- hugeFieldsMasker :: Int -> LogMasker
- defaultLogMasker :: LogMasker
- type LogMasker = FieldOption -> Builder -> Builder
- builderResultPure :: Builder -> SqlBuilderResult
- data SqlBuilderResult = SqlBuilderResult {}
- data FieldOption
- data Values a = Values [QualifiedIdentifier] [a]
- data h :. t = h :. t
- newtype PGArray a = PGArray {
- fromPGArray :: [a]
- newtype In a = In a
- newtype Query = Query {}
- class ToField a where
- class ToRow a where
- data ConnectInfo = ConnectInfo {}
- data Connection
- defaultConnectInfo :: ConnectInfo
- connect :: ConnectInfo -> IO Connection
- connectPostgreSQL :: ByteString -> IO Connection
- class FromField a where
- fromField :: FieldParser a
- class FromRow a where
- newtype HStoreMap = HStoreMap {
- fromHStoreMap :: Map Text Text
- newtype HStoreList = HStoreList {
- fromHStoreList :: [(Text, Text)]
- data HStoreText
- class ToHStoreText a where
- toHStoreText :: a -> HStoreText
- data HStoreBuilder
- class ToHStore a where
- toHStore :: a -> HStoreBuilder
- hstore :: (ToHStoreText a, ToHStoreText b) => a -> b -> HStoreBuilder
- parseHStoreList :: ByteString -> Either String HStoreList
- defaultTransactionMode :: TransactionMode
- data IsolationLevel
- data ReadWriteMode
- data TransactionMode = TransactionMode {}
Documentation
The 1-tuple type or single-value "collection".
This type is structurally equivalent to the
Identity
type, but its intent is more
about serving as the anonymous 1-tuple type missing from Haskell for attaching
typeclass instances.
Parameter usage example:
encodeSomething (Only
(42::Int))
Result usage example:
xs <- decodeSomething
forM_ xs $ \(Only
id) -> {- ... -}
Instances
Functor Only | |
Eq a => Eq (Only a) | |
Data a => Data (Only a) | |
Defined in Data.Tuple.Only gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Only a -> c (Only a) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Only a) # toConstr :: Only a -> Constr # dataTypeOf :: Only a -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Only a)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Only a)) # gmapT :: (forall b. Data b => b -> b) -> Only a -> Only a # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Only a -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Only a -> r # gmapQ :: (forall d. Data d => d -> u) -> Only a -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Only a -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Only a -> m (Only a) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Only a -> m (Only a) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Only a -> m (Only a) # | |
Ord a => Ord (Only a) | |
Read a => Read (Only a) | |
Show a => Show (Only a) | |
Generic (Only a) | |
NFData a => NFData (Only a) | |
Defined in Data.Tuple.Only | |
ToField a => ToRow (Only a) | |
Defined in Database.PostgreSQL.Simple.ToRow | |
FromField a => FromRow (Maybe (Only a)) | |
FromField a => FromRow (Only a) | |
Defined in Database.PostgreSQL.Simple.FromRow | |
type Rep (Only a) | |
Defined in Data.Tuple.Only |
pgSelectCount :: forall m a q. (Entity a, MonadPostgres m, MonadLogger m, MonadFail m, ToSqlBuilder q) => Proxy a -> q -> m Integer #
pgQueryEntities :: (ToSqlBuilder q, MonadPostgres m, MonadLogger m, Entity a, FromRow a, FromField (EntityId a)) => q -> m [Ent a] #
Select count of entities with given query
activeUsers :: Handler Integer activeUsers = do pgSelectCount (Proxy :: Proxy User) [sqlExp|WHERE active = #{True}|]
Executes arbitrary query and parses it as entities and their ids
pgUpdateEntity :: forall a b m. (ToMarkedRow b, Entity a, MonadPostgres m, MonadLogger m, ToField (EntityId a), Functor m, Typeable a, Typeable b) => EntityId a -> b -> m Bool #
Update entity using ToMarkedRow
instanced value. Requires Proxy
while EntityId
is not a data type.
fixUser :: Text -> EntityId User -> Handler () fixUser username uid = do pgGetEntity uid >>= maybe notFound run where run user = pgUpdateEntity uid $ MR [("active", mkValue True) ("name", mkValue username)]
Returns True
if record was actually updated and False
if there was
not row with such id (or was more than 1, in fact)
pgDeleteEntity :: (Entity a, MonadPostgres m, MonadLogger m, ToField (EntityId a), Functor m) => EntityId a -> m Bool #
Delete entity.
rmUser :: EntityId User -> Handler () rmUser uid = do pgDeleteEntity uid
Return True
if row was actually deleted.
pgInsertManyEntities :: (Entity a, MonadPostgres m, MonadLogger m, ToRow a) => [a] -> m Int64 #
Insert many entities without returning list of id like
pgInsertManyEntitiesId
does
pgInsertManyEntitiesId :: (Entity a, MonadPostgres m, MonadLogger m, ToRow a, FromField (EntityId a)) => [a] -> m [EntityId a] #
Same as pgInsertEntity
but insert many entities at one
action. Returns list of id's of inserted entities
:: forall m a b. (Entity a, MonadPostgres m, MonadLogger m, ToMarkedRow b, FromField (EntityId a), FromRow a, Functor m) | |
=> b | uniq constrained list of fields and values |
-> m (Maybe (Ent a)) |
pgGetEntity :: forall m a. (ToField (EntityId a), Entity a, FromRow a, MonadPostgres m, MonadLogger m, Functor m) => EntityId a -> m (Maybe a) #
Select entity by id
getUser :: EntityId User -> Handler User getUser uid = do pgGetEntity uid >>= maybe notFound return
pgSelectEntitiesBy :: forall a m b. (Functor m, MonadPostgres m, MonadLogger m, Entity a, ToMarkedRow b, FromRow a, FromField (EntityId a)) => b -> m [Ent a] #
Select entities by condition formed from MarkedRow
. Usefull function when
you know
pgSelectJustEntities :: (Functor m, MonadPostgres m, MonadLogger m, Entity a, FromRow a, ToSqlBuilder q) => (FN -> FN) -> q -> m [a] #
Same as pgSelectEntities
but do not select id
:: (Functor m, MonadPostgres m, MonadLogger m, Entity a, FromRow a, ToSqlBuilder q, FromField (EntityId a)) | |
=> (FN -> FN) | Entity fields name modifier, e.g. ("tablename"<>). Each field of entity will be processed by this modifier before pasting to the query |
-> q | part of query just after SELECT .. FROM table. |
-> m [Ent a] |
Select entities as pairs of (id, entity).
handler :: Handler [Ent a] handler = do now <- liftIO getCurrentTime let back = addUTCTime (days (-7)) now pgSelectEntities id [sqlExp|WHERE created BETWEEN #{now} AND #{back} ORDER BY created|] handler2 :: Text -> Handler [Ent Foo] handler2 fvalue = do pgSelectEntities ("t"<>) [sqlExp|AS t INNER JOIN table2 AS t2 ON t.t2_id = t2.id WHERE t.field = #{fvalue} ORDER BY t2.field2|] -- Here the query will be: SELECT ... FROM tbl AS t INNER JOIN ...
pgInsertEntity :: forall a m. (MonadPostgres m, MonadLogger m, MonadFail m, Entity a, ToRow a, FromField (EntityId a)) => a -> m (EntityId a) #
Insert new entity and return it's id
insertManyEntities :: (Entity a, ToRow a) => NonEmpty a -> SqlBuilder #
Same as insertEntity
but generates query to insert many queries at same time
>>>
data Foo = Foo { fName :: Text, fSize :: Int }
>>>
instance Entity Foo where {newtype EntityId Foo = FooId Int ; fieldNames _ = ["name", "size"] ; tableName _ = "foo"}
>>>
instance ToRow Foo where { toRow Foo{..} = [toField fName, toField fSize] }
>>>
runSqlBuilder con $ insertManyEntities $ NL.fromList [Foo "meter" 1, Foo "table" 2, Foo "earth" 151930000000]
"INSERT INTO \"foo\" (\"name\",\"size\") VALUES ('meter',1),('table',2),('earth',151930000000)"
insertEntity :: (Entity a, ToRow a) => a -> SqlBuilder #
Generates INSERT INTO query for any instance of Entity
and ToRow
>>>
data Foo = Foo { fName :: Text, fSize :: Int }
>>>
instance Entity Foo where {newtype EntityId Foo = FooId Int ; fieldNames _ = ["name", "size"] ; tableName _ = "foo"}
>>>
instance ToRow Foo where { toRow Foo{..} = [toField fName, toField fSize] }
>>>
runSqlBuilder con $ insertEntity $ Foo "Enterprise" 910
"INSERT INTO \"foo\" (\"name\", \"size\") VALUES ('Enterprise', 910)"
entityToMR :: (Entity a, ToRow a) => a -> MarkedRow #
Convert entity instance to marked row to perform inserts updates and same stuff
>>>
data Foo = Foo { fName :: Text, fSize :: Int }
>>>
instance Entity Foo where {newtype EntityId Foo = FooId Int ; fieldNames _ = ["name", "size"] ; tableName _ = "foo"}
>>>
instance ToRow Foo where { toRow Foo{..} = [toField fName, toField fSize] }
>>>
runSqlBuilder con $ mrToBuilder ", " $ entityToMR $ Foo "Enterprise" 610
" \"name\" = 'Enterprise' , \"size\" = 610 "
selectEntitiesBy :: (Entity a, ToMarkedRow b) => ([FN] -> [FN]) -> Proxy a -> b -> SqlBuilder #
Generates SELECT FROM WHERE query with most used conditions
>>>
data Foo = Foo { fName :: Text, fSize :: Int }
>>>
instance Entity Foo where {newtype EntityId Foo = FooId Int ; fieldNames _ = ["name", "size"] ; tableName _ = "foo"}
>>>
runSqlBuilder con $ selectEntitiesBy id (Proxy :: Proxy Foo) $ MR []
"SELECT \"name\", \"size\" FROM \"foo\""
>>>
runSqlBuilder con $ selectEntitiesBy id (Proxy :: Proxy Foo) $ MR [("name", mkValue "fooname")]
"SELECT \"name\", \"size\" FROM \"foo\" WHERE \"name\" = 'fooname' "
>>>
runSqlBuilder con $ selectEntitiesBy id (Proxy :: Proxy Foo) $ MR [("name", mkValue "fooname"), ("size", mkValue 10)]
"SELECT \"name\", \"size\" FROM \"foo\" WHERE \"name\" = 'fooname' AND \"size\" = 10 "
:: Entity a | |
=> (Proxy a -> SqlBuilder) | build fields part from proxy |
-> Proxy a | |
-> SqlBuilder |
Generate SELECT query string for entity
>>>
data Foo = Foo { fName :: Text, fSize :: Int }
>>>
instance Entity Foo where {newtype EntityId Foo = FooId Int ; fieldNames _ = ["name", "size"] ; tableName _ = "foo"}
>>>
runSqlBuilder con $ selectEntity (entityFieldsId id) (Proxy :: Proxy Foo)
"SELECT \"id\", \"name\", \"size\" FROM \"foo\""
>>>
runSqlBuilder con $ selectEntity (entityFieldsId ("f"<>)) (Proxy :: Proxy Foo)
"SELECT \"f\".\"id\", \"f\".\"name\", \"f\".\"size\" FROM \"foo\""
>>>
runSqlBuilder con $ selectEntity (entityFields id id) (Proxy :: Proxy Foo)
"SELECT \"name\", \"size\" FROM \"foo\""
entityFieldsId :: Entity a => (FN -> FN) -> Proxy a -> SqlBuilder #
Same as entityFields
but prefixes list of names with id
field. This is shorthand function for often usage.
>>>
data Foo = Foo { fName :: Text, fSize :: Int }
>>>
instance Entity Foo where {newtype EntityId Foo = FooId Int ; fieldNames _ = ["name", "size"] ; tableName _ = "foo"}
>>>
runSqlBuilder con $ entityFieldsId id (Proxy :: Proxy Foo)
"\"id\", \"name\", \"size\""
>>>
runSqlBuilder con $ entityFieldsId ("f"<>) (Proxy :: Proxy Foo)
"\"f\".\"id\", \"f\".\"name\", \"f\".\"size\""
:: Entity a | |
=> ([FN] -> [FN]) | modify list of fields. Applied second |
-> (FN -> FN) | modify each field name, e.g. prepend each field with prefix, like ("t"<>). Applied first |
-> Proxy a | |
-> SqlBuilder |
Build entity fields
>>>
data Foo = Foo { fName :: Text, fSize :: Int }
>>>
instance Entity Foo where {newtype EntityId Foo = FooId Int ; fieldNames _ = ["name", "size"] ; tableName _ = "foo"}
>>>
runSqlBuilder con $ entityFields id id (Proxy :: Proxy Foo)
"\"name\", \"size\""
>>>
runSqlBuilder con $ entityFields ("id":) id (Proxy :: Proxy Foo)
"\"id\", \"name\", \"size\""
>>>
runSqlBuilder con $ entityFields (\l -> ("id":l) ++ ["created"]) id (Proxy :: Proxy Foo)
"\"id\", \"name\", \"size\", \"created\""
>>>
runSqlBuilder con $ entityFields id ("f"<>) (Proxy :: Proxy Foo)
"\"f\".\"name\", \"f\".\"size\""
>>>
runSqlBuilder con $ entityFields ("f.id":) ("f"<>) (Proxy :: Proxy Foo)
"\"f\".\"id\", \"f\".\"name\", \"f\".\"size\""
:: (MonadPostgres m, MonadLogger m, ToMarkedRow wrow, ToMarkedRow urow) | |
=> FN | Table name |
-> wrow | where condition |
-> urow | update row |
-> m () |
Perform repsert of the same row, first trying "update where" then "insert" with concatenated fields. Which means that if you run
pgRepsertRow "emails" (MR [("user_id", mkValue uid)]) (MR [("email", mkValue email)])
Then firstly will be performed
UPDATE "emails" SET email = 'foo@bar.com' WHERE "user_id" = 1234
And if no one row is affected (which is returned by pgExecute
), then
INSERT INTO "emails" ("user_id", "email") VALUES (1234, 'foo@bar.com')
will be performed
deriveEverything :: EntityOptions -> Name -> Q [Dec] #
Calls sequently deriveFromRow
deriveToRow
deriveEntity
. E.g. code like this:
data Agent = Agent { aName :: !Text , aAttributes :: !HStoreMap , aLongWeirdName :: !Int } deriving (Ord, Eq, Show) $(deriveEverything def { eoIdType = ''Id , eoTableName = textFN . toUnderscore' , eoColumnNames = textFN . toUnderscore' . drop 1 , eoDeriveClasses = [''Show, ''Read, ''Ord, ''Eq , ''FromField, ''ToField, ''PathPiece] } ''Agent )
will generate that:
instance ToRow Agent where toRow (Agent a_aE3w a_aE3x a_aE3y) = [toField a_aE3w, toField a_aE3x, toField a_aE3y] instance FromRow Agent where fromRow = Agent $ Database.PostgreSQL.Simple.FromRow.field * Database.PostgreSQL.Simple.FromRow.field * Database.PostgreSQL.Simple.FromRow.field instance Database.PostgreSQL.Query.Entity Agent where newtype EntityId Agent = AgentId {getAgentId :: Id} deriving (Show, Read, Ord, Eq, FromField, ToField, PathPiece) tableName _ = "agent" fieldNames _ = ["name", "attributes", "long_weird_name"] type AgentId = EntityId Agent
deriveEntity :: EntityOptions -> Name -> Q [Dec] #
Derives instance for Entity
using type name and field names. Also
generates type synonim for ID. E.g. code like this:
data Agent = Agent { aName :: !Text , aAttributes :: !HStoreMap , aLongWeirdName :: !Int } deriving (Ord, Eq, Show) $(deriveEntity def { eoIdType = ''Id , eoTableName = textFN . toUnderscore' , eoColumnNames = textFN . toUnderscore' . drop 1 , eoDeriveClasses = [''Show, ''Read, ''Ord, ''Eq , ''FromField, ''ToField, ''PathPiece] } ''Agent )
Will generate code like this:
instance Database.PostgreSQL.Query.Entity Agent where newtype EntityId Agent = AgentId {getAgentId :: Id} deriving (Show, Read, Ord, Eq, FromField, ToField, PathPiece) tableName _ = "agent" fieldNames _ = ["name", "attributes", "long_weird_name"] type AgentId = EntityId Agent
So, you dont need to write it by hands any more.
NOTE: toUnderscore
is from package inflections
here
data EntityOptions #
Options for deriving Entity
EntityOptions | |
|
Instances
Generic EntityOptions | |
Defined in Database.PostgreSQL.Query.TH.Entity type Rep EntityOptions :: Type -> Type # from :: EntityOptions -> Rep EntityOptions x # to :: Rep EntityOptions x -> EntityOptions # | |
Default EntityOptions | |
Defined in Database.PostgreSQL.Query.TH.Entity def :: EntityOptions # | |
type Rep EntityOptions | |
Defined in Database.PostgreSQL.Query.TH.Entity type Rep EntityOptions = D1 ('MetaData "EntityOptions" "Database.PostgreSQL.Query.TH.Entity" "pstgrsql-qry-3.5.0-e8c68f8e" 'False) (C1 ('MetaCons "EntityOptions" 'PrefixI 'True) ((S1 ('MetaSel ('Just "eoTableName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Text -> FN)) :*: S1 ('MetaSel ('Just "eoColumnNames") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Text -> FN))) :*: (S1 ('MetaSel ('Just "eoDeriveClasses") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Name]) :*: S1 ('MetaSel ('Just "eoIdType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Name)))) |
Auxiliary typeclass for data types which can map to rows of some
table. This typeclass is used inside functions like pgSelectEntities
to
generate queries.
launchPG :: HasPostgres m => PgMonadT m a -> m a #
If your monad have instance of HasPostgres
you maybe dont need this
function, unless your instance use withPGPool
which acquires connection
from pool for each query. If you want to run sequence of queries using same
connection you need this function
runPgMonadT :: Connection -> PgMonadT m a -> m a #
:: SqlBuilder | Builder to intercalate with |
-> MarkedRow | |
-> SqlBuilder |
Turns marked row to query intercalating it with other builder
>>>
runSqlBuilder c $ mrToBuilder "AND" $ MR [("name", mkValue "petr"), ("email", mkValue "foo@bar.com")]
" \"name\" = 'petr' AND \"email\" = 'foo@bar.com' "
Marked row is list of pairs of field name and some sql expression. Used to generate queries like:
name = name
AND size = 10 AND length = 20
or
UPDATE tbl SET name = name
, size = 10, lenght = 20
MR | |
|
Instances
Generic MarkedRow | |
Semigroup MarkedRow | |
Monoid MarkedRow | |
ToMarkedRow MarkedRow | |
Defined in Database.PostgreSQL.Query.Types toMarkedRow :: MarkedRow -> MarkedRow # | |
type Rep MarkedRow | |
Defined in Database.PostgreSQL.Query.Types type Rep MarkedRow = D1 ('MetaData "MarkedRow" "Database.PostgreSQL.Query.Types" "pstgrsql-qry-3.5.0-e8c68f8e" 'True) (C1 ('MetaCons "MR" 'PrefixI 'True) (S1 ('MetaSel ('Just "unMR") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [(FN, SqlBuilder)]))) |
class ToMarkedRow a where #
toMarkedRow :: a -> MarkedRow #
generate list of pairs (field name, field value)
Instances
ToMarkedRow MarkedRow | |
Defined in Database.PostgreSQL.Query.Types toMarkedRow :: MarkedRow -> MarkedRow # |
type MonadPostgres (m :: Type -> Type) = (HasPostgres m, MonadLogger m) #
class MonadBase IO m => HasPostgres (m :: Type -> Type) where #
Instances of this typeclass can acquire connection and pass it to computation. It can be reader of pool of connections or just reader of connection
withPGConnection :: (Connection -> m a) -> m a #
Instances
class TransactionSafe (m :: Type -> Type) #
Empty typeclass signing monad in which transaction is
safe. i.e. PgMonadT
have this instance, but some other monad giving
connection from e.g. connection pool is not.
Instances
newtype PgMonadT (m :: Type -> Type) a #
Reader of connection. Has instance of HasPostgres
. So if you have a
connection you can run queries in this monad using runPgMonadT
. Or you
can use this transformer to run sequence of queries using same
connection with launchPG
.
PgMonadT | |
|
Instances
Special constructor to perform old-style query interpolation
Instances
ToSqlBuilder Qp | |
Defined in Database.PostgreSQL.Query.Types toSqlBuilder :: Qp -> SqlBuilder # |
type to put and get from db inet
and cidr
typed postgresql
fields. This should be in postgresql-simple in fact.
Instances
Eq InetText | |
Ord InetText | |
Defined in Database.PostgreSQL.Query.Types | |
Read InetText | |
Show InetText | |
IsString InetText | |
Defined in Database.PostgreSQL.Query.Types fromString :: String -> InetText # | |
Semigroup InetText | |
Monoid InetText | |
ToField InetText | |
Defined in Database.PostgreSQL.Query.Types | |
FromField InetText | |
Defined in Database.PostgreSQL.Query.Types |
Dot-separated field name. Each element in nested list will be
properly quoted and separated by dot. It also have instance of
ToSqlBuilder
and IsString
so you can:
>>>
let a = "hello" :: FN
>>>
a
FN ["hello"]
>>>
let b = "user.name" :: FN
>>>
b
FN ["user","name"]
>>>
let n = "u.name" :: FN
>>>
runSqlBuilder c $ toSqlBuilder n
"\"u\".\"name\""
>>>
("user" <> "name") :: FN
FN ["user","name"]
>>>
let a = "name" :: FN
>>>
let b = "email" :: FN
>>>
runSqlBuilder c [sqlExp|^{"u" <> a} = 'name', ^{"e" <> b} = 'email'|]
"\"u\".\"name\" = 'name', \"e\".\"email\" = 'email'"
Instances
Eq FN | |
Ord FN | |
Show FN | |
IsString FN | |
Defined in Database.PostgreSQL.Query.Types fromString :: String -> FN # | |
Generic FN | |
Semigroup FN | |
Monoid FN | |
Lift FN | |
ToSqlBuilder FN | |
Defined in Database.PostgreSQL.Query.Types toSqlBuilder :: FN -> SqlBuilder # | |
type Rep FN | |
Defined in Database.PostgreSQL.Query.Types |
sqlExpFile :: String -> Q Exp #
Just like sqlExpEmbed
but uses pattern instead of file
name. So, code
let query = $(sqlExpFile "foo/bar")
is just the same as
let query = $(sqlExpEmbed "sqlfoobar.sql")
This function inspired by Yesod's widgetFile
:: String | file path |
-> Q Exp | Expression of type |
Embed sql template and perform interpolation
let name = "name" foo = "bar" query = $(sqlExpEmbed "sqlfoobar.sql") -- usingfoo
andbar
inside
:: String | |
-> Q Exp | Expression of type |
Build expression of type SqlBuilder
from SQL query with interpolation
squashRope :: [Rope] -> [Rope] #
Removes sequential occurencies of RLit
constructors. Also
removes commentaries and squash sequences of spaces to single space
symbol
ropeParser :: Parser [Rope] #
sqlExp :: QuasiQuoter #
Maybe the main feature of all library. Quasiquoter which builds
SqlBuilder
from string query. Removes line comments and block
comments (even nested) and sequences of spaces. Correctly works
handles string literals and quoted identifiers. Here is examples of usage
>>>
let name = "name"
>>>
let val = "some 'value'"
>>>
runSqlBuilder c [sqlExp|SELECT * FROM tbl WHERE ^{mkIdent name} = #{val}|]
"SELECT * FROM tbl WHERE \"name\" = 'some ''value'''"
And more comples example:
>>>
let name = Just "name"
>>>
let size = Just 10
>>>
let active = Nothing :: Maybe Bool
>>>
let condlist = catMaybes [ fmap (\a -> [sqlExp|name = #{a}|]) name, fmap (\a -> [sqlExp|size = #{a}|]) size, fmap (\a -> [sqlExp|active = #{a}|]) active]
>>>
let cond = if L.null condlist then mempty else [sqlExp| WHERE ^{mconcat $ L.intersperse " AND " $ condlist} |]
>>>
runSqlBuilder c [sqlExp|SELECT * FROM tbl ^{cond} -- line comment|]
"SELECT * FROM tbl WHERE name = 'name' AND size = 10 "
Internal type. Result of parsing sql string
RLit Text | Part of raw sql |
RComment Text | Sql comment |
RSpaces Int | Sequence of spaces |
RInt FieldOption Text | String with haskell expression inside #{..} or #?{..} |
RPaste Text | String with haskell expression inside ^{..} |
deriveToRow :: Name -> Q [Dec] #
derives ToRow
instance for datatype like
data Entity = Entity { eField :: Text , eField2 :: Int , efield3 :: Bool }
it will derive instance like that:
instance ToRow Entity where toRow (Entity e1 e2 e3) = [ toField e1 , toField e2 , toField e3 ]
deriveFromRow :: Name -> Q [Dec] #
Derive FromRow
instance. i.e. you have type like that
data Entity = Entity { eField :: Text , eField2 :: Int , efield3 :: Bool }
then deriveFromRow
will generate this instance:
instance FromRow Entity where
instance FromRow Entity where fromRow = Entity <$> field <*> field <*> field
Datatype must have just one constructor with arbitrary count of fields
:: InflectorFunc | mapping function from haskell constructor name to PG enum label |
-> Name | type to derive instances for |
-> DecsQ |
type InflectorFunc = String -> String #
Function to transform constructor name into its PG enum conterpart.
class ToSqlBuilder a where #
Things which always can be transformed to SqlBuilder
toSqlBuilder :: a -> SqlBuilder #
Instances
ToSqlBuilder Qp | |
Defined in Database.PostgreSQL.Query.Types toSqlBuilder :: Qp -> SqlBuilder # | |
ToSqlBuilder FN | |
Defined in Database.PostgreSQL.Query.Types toSqlBuilder :: FN -> SqlBuilder # | |
ToSqlBuilder SqlBuilder | |
Defined in Database.PostgreSQL.Query.SqlBuilder.Class toSqlBuilder :: SqlBuilder -> SqlBuilder # | |
ToSqlBuilder Identifier | |
Defined in Database.PostgreSQL.Query.SqlBuilder.Class toSqlBuilder :: Identifier -> SqlBuilder # | |
ToSqlBuilder QualifiedIdentifier | |
Defined in Database.PostgreSQL.Query.SqlBuilder.Class |
sqlBuilderFromByteString :: ByteString -> SqlBuilder #
Unsafe function to make SqlBuilder from arbitrary ByteString. Does not perform any checks. Dont use it directly in your code unless you know what you are doing.
sqlBuilderPure :: Builder -> SqlBuilder #
Lift pure bytestring builder to SqlBuilder
. This is unsafe to use
directly in your code.
sqlBuilderFromField :: ToField a => FieldOption -> a -> SqlBuilder #
mkMaskedValue :: ToField a => a -> SqlBuilder #
Shorthand function to convert single masked field value (which should not be shown in log)
mkValue :: ToField a => a -> SqlBuilder #
Shorthand function to convert single field value to builder
emptyB :: SqlBuilder #
Typed synonym of mempty
runSqlBuilder :: Connection -> LogMasker -> SqlBuilder -> IO (Query, ByteString) #
Returns query string with log bytestring
newtype SqlBuilder #
Builder wich can be effectively concatenated. Requires Connection
inside for string quoting implemented in libpq. Builds two strings: query
string and log string which may differ.
SqlBuilder | |
|
Instances
hugeFieldsMasker :: Int -> LogMasker #
Masks fields which size is bigger than given argument in bytes.
defaultLogMasker :: LogMasker #
Simply replaces masked fields with placeholder.
type LogMasker = FieldOption -> Builder -> Builder #
Function modifying query parameter value before pasting it to log.
data SqlBuilderResult #
Result if SqlBuilder. Contains separated builder for query and log.
Instances
data FieldOption #
Option for field instructing LogMasker
what to do with field when logging
FieldDefault | Do nothing. Field should be pasted as is |
FieldMasked | Mask field in logs with placeholder. |
Instances
Represents a VALUES
table literal, usable as an alternative to
executeMany
and
returning
. The main advantage is that
you can parametrize more than just a single VALUES
expression.
For example, here's a query to insert a thing into one table
and some attributes of that thing into another, returning the
new id generated by the database:
query c [sql| WITH new_thing AS ( INSERT INTO thing (name) VALUES (?) RETURNING id ), new_attributes AS ( INSERT INTO thing_attributes SELECT new_thing.id, attrs.* FROM new_thing JOIN ? attrs ON TRUE ) SELECT * FROM new_thing |] ("foo", Values [ "int4", "text" ] [ ( 1 , "hello" ) , ( 2 , "world" ) ])
(Note this example uses writable common table expressions, which were added in PostgreSQL 9.1)
The second parameter gets expanded into the following SQL syntax:
(VALUES (1::"int4",'hello'::"text"),(2,'world'))
When the list of attributes is empty, the second parameter expands to:
(VALUES (null::"int4",null::"text") LIMIT 0)
By contrast, executeMany
and returning
don't issue the query
in the empty case, and simply return 0
and []
respectively.
This behavior is usually correct given their intended use cases,
but would certainly be wrong in the example above.
The first argument is a list of postgresql type names. Because this
is turned into a properly quoted identifier, the type name is case
sensitive and must be as it appears in the pg_type
table. Thus,
you must write timestamptz
instead of timestamp with time zone
,
int4
instead of integer
or serial
, _int8
instead of bigint[]
,
etcetera.
You may omit the type names, however, if you do so the list
of values must be non-empty, and postgresql must be able to infer
the types of the columns from the surrounding context. If the first
condition is not met, postgresql-simple will throw an exception
without issuing the query. In the second case, the postgres server
will return an error which will be turned into a SqlError
exception.
See https://www.postgresql.org/docs/9.5/static/sql-values.html for more information.
Values [QualifiedIdentifier] [a] |
A composite type to parse your custom data structures without having to define dummy newtype wrappers every time.
instance FromRow MyData where ...
instance FromRow MyData2 where ...
then I can do the following for free:
res <- query' c "..." forM res $ \(MyData{..} :. MyData2{..}) -> do ....
h :. t infixr 3 |
Instances
(Eq h, Eq t) => Eq (h :. t) | |
(Ord h, Ord t) => Ord (h :. t) | |
Defined in Database.PostgreSQL.Simple.Types | |
(Read h, Read t) => Read (h :. t) | |
(Show h, Show t) => Show (h :. t) | |
(ToRow a, ToRow b) => ToRow (a :. b) | |
Defined in Database.PostgreSQL.Simple.ToRow | |
(FromRow a, FromRow b) => FromRow (a :. b) | |
Defined in Database.PostgreSQL.Simple.FromRow |
Wrap a list for use as a PostgreSQL array.
PGArray | |
|
Instances
Functor PGArray | |
Eq a => Eq (PGArray a) | |
Ord a => Ord (PGArray a) | |
Defined in Database.PostgreSQL.Simple.Types | |
Read a => Read (PGArray a) | |
Show a => Show (PGArray a) | |
ToField a => ToField (PGArray a) | |
Defined in Database.PostgreSQL.Simple.ToField | |
(FromField a, Typeable a) => FromField (PGArray a) | any postgresql array whose elements are compatible with type |
Defined in Database.PostgreSQL.Simple.FromField fromField :: FieldParser (PGArray a) # |
Wrap a list of values for use in an IN
clause. Replaces a
single "?
" character with a parenthesized list of rendered
values.
Example:
query c "select * from whatever where id in ?" (Only (In [3,4,5]))
Note that In []
expands to (null)
, which works as expected in
the query above, but evaluates to the logical null value on every
row instead of TRUE
. This means that changing the query above
to ... id NOT in ?
and supplying the empty list as the parameter
returns zero rows, instead of all of them as one would expect.
Since postgresql doesn't seem to provide a syntax for actually specifying an empty list, which could solve this completely, there are two workarounds particularly worth mentioning, namely:
Use postgresql-simple's
Values
type instead, which can handle the empty case correctly. Note however that while specifying the postgresql type"int4"
is mandatory in the empty case, specifying the haskell typeValues (Only Int)
would not normally be needed in realistic use cases.query c "select * from whatever where id not in ?" (Only (Values ["int4"] [] :: Values (Only Int)))
Use sql's
COALESCE
operator to turn a logicalnull
into the correct boolean. Note however that the correct boolean depends on the use case:query c "select * from whatever where coalesce(id NOT in ?, TRUE)" (Only (In [] :: In [Int]))
query c "select * from whatever where coalesce(id IN ?, FALSE)" (Only (In [] :: In [Int]))
Note that at as of PostgreSQL 9.4, the query planner cannot see inside the
COALESCE
operator, so if you have an index onid
then you probably don't want to write the last example withCOALESCE
, which would result in a table scan. There are further caveats ifid
can be null or you want null treated sensibly as a component ofIN
orNOT IN
.
In a |
A query string. This type is intended to make it difficult to construct a SQL query by concatenating string fragments, as that is an extremely common way to accidentally introduce SQL injection vulnerabilities into an application.
This type is an instance of IsString
, so the easiest way to
construct a query is to enable the OverloadedStrings
language
extension and then simply write the query in double quotes.
{-# LANGUAGE OverloadedStrings #-} import Database.PostgreSQL.Simple q :: Query q = "select ?"
The underlying type is a ByteString
, and literal Haskell strings
that contain Unicode characters will be correctly transformed to
UTF-8.
A type that may be used as a single parameter to a SQL query.
Instances
A collection type that can be turned into a list of rendering
Action
s.
Instances should use the toField
method of the ToField
class
to perform conversion of each element of the collection.
You can derive ToRow
for your data type using GHC generics, like this:
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} import GHC.Generics (Generic
) import Database.PostgreSQL.Simple (ToRow
) data User = User { name :: String, fileQuota :: Int } deriving (Generic
,ToRow
)
Note that this only works for product types (e.g. records) and does not support sum types or recursive types.
Nothing
Instances
data ConnectInfo #
ConnectInfo | |
|
Instances
data Connection #
Instances
Eq Connection | |
Defined in Database.PostgreSQL.Simple.Internal (==) :: Connection -> Connection -> Bool # (/=) :: Connection -> Connection -> Bool # |
defaultConnectInfo :: ConnectInfo #
Default information for setting up a connection.
Defaults are as follows:
- Server on
localhost
- Port on
5432
- User
postgres
- No password
- Database
postgres
Use as in the following example:
connect defaultConnectInfo { connectHost = "db.example.com" }
connect :: ConnectInfo -> IO Connection #
Connect with the given username to the given database. Will throw an exception if it cannot connect.
connectPostgreSQL :: ByteString -> IO Connection #
Attempt to make a connection based on a libpq connection string. See https://www.postgresql.org/docs/9.5/static/libpq-connect.html#LIBPQ-CONNSTRING for more information. Also note that environment variables also affect parameters not provided, parameters provided as the empty string, and a few other things; see https://www.postgresql.org/docs/9.5/static/libpq-envars.html for details. Here is an example with some of the most commonly used parameters:
host='db.somedomain.com' port=5432 ...
This attempts to connect to db.somedomain.com:5432
. Omitting the port
will normally default to 5432.
On systems that provide unix domain sockets, omitting the host parameter
will cause libpq to attempt to connect via unix domain sockets.
The default filesystem path to the socket is constructed from the
port number and the DEFAULT_PGSOCKET_DIR
constant defined in the
pg_config_manual.h
header file. Connecting via unix sockets tends
to use the peer
authentication method, which is very secure and
does not require a password.
On Windows and other systems without unix domain sockets, omitting
the host will default to localhost
.
... dbname='postgres' user='postgres' password='secret \' \\ pw'
This attempts to connect to a database named postgres
with
user postgres
and password secret ' \ pw
. Backslash
characters will have to be double-quoted in literal Haskell strings,
of course. Omitting dbname
and user
will both default to the
system username that the client process is running as.
Omitting password
will default to an appropriate password found
in the pgpass
file, or no password at all if a matching line is
not found. The path of the pgpass
file may be specified by setting
the PGPASSFILE
environment variable. See
https://www.postgresql.org/docs/9.5/static/libpq-pgpass.html for
more information regarding this file.
As all parameters are optional and the defaults are sensible, the empty connection string can be useful for development and exploratory use, assuming your system is set up appropriately.
On Unix, such a setup would typically consist of a local postgresql server listening on port 5432, as well as a system user, database user, and database sharing a common name, with permissions granted to the user on the database.
On Windows, in addition you will either need pg_hba.conf
to specify the use of the trust
authentication method for
the connection, which may not be appropriate for multiuser
or production machines, or you will need to use a pgpass
file
with the password
or md5
authentication methods.
See https://www.postgresql.org/docs/9.5/static/client-authentication.html for more information regarding the authentication process.
SSL/TLS will typically "just work" if your postgresql server supports or
requires it. However, note that libpq is trivially vulnerable to a MITM
attack without setting additional SSL connection parameters. In
particular, sslmode
needs to be set to require
, verify-ca
, or
verify-full
in order to perform certificate validation. When sslmode
is require
, then you will also need to specify a sslrootcert
file,
otherwise no validation of the server's identity will be performed.
Client authentication via certificates is also possible via the
sslcert
and sslkey
parameters. See
https://www.postgresql.org/docs/9.5/static/libpq-ssl.html
for detailed information regarding libpq and SSL.
A type that may be converted from a SQL type.
fromField :: FieldParser a #
Convert a SQL value to a Haskell value.
Returns a list of exceptions if the conversion fails. In the case of
library instances, this will usually be a single ResultError
, but
may be a UnicodeException
.
Note that retaining any reference to the Field
argument causes
the entire LibPQ.
to be retained. Thus, implementations
of Result
fromField
should return results that do not refer to this value
after the result have been evaluated to WHNF.
Note that as of postgresql-simple-0.4.0.0
, the ByteString
value
has already been copied out of the LibPQ.
before it has
been passed to Result
fromField
. This is because for short strings, it's
cheaper to copy the string than to set up a finalizer.
Instances
A collection type that can be converted from a sequence of fields. Instances are provided for tuples up to 10 elements and lists of any length.
Note that instances can be defined outside of postgresql-simple, which is often useful. For example, here's an instance for a user-defined pair:
data User = User { name :: String, fileQuota :: Int } instanceFromRow
User where fromRow = User <$>field
<*>field
The number of calls to field
must match the number of fields returned
in a single row of the query result. Otherwise, a ConversionFailed
exception will be thrown.
You can also derive FromRow
for your data type using GHC generics, like
this:
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} import GHC.Generics (Generic
) import Database.PostgreSQL.Simple (FromRow
) data User = User { name :: String, fileQuota :: Int } deriving (Generic
,FromRow
)
Note that this only works for product types (e.g. records) and does not support sum types or recursive types.
Note that field
evaluates its result to WHNF, so the caveats listed in
mysql-simple and very early versions of postgresql-simple no longer apply.
Instead, look at the caveats associated with user-defined implementations
of fromField
.
Nothing
Instances
newtype HStoreList #
HStoreList | |
|
Instances
Show HStoreList | |
Defined in Database.PostgreSQL.Simple.HStore.Implementation showsPrec :: Int -> HStoreList -> ShowS # show :: HStoreList -> String # showList :: [HStoreList] -> ShowS # | |
ToField HStoreList | |
Defined in Database.PostgreSQL.Simple.HStore.Implementation toField :: HStoreList -> Action # | |
FromField HStoreList | hstore |
ToHStore HStoreList | hstore |
Defined in Database.PostgreSQL.Simple.HStore.Implementation toHStore :: HStoreList -> HStoreBuilder # |
data HStoreText #
Represents escape text, ready to be the key or value to a hstore value
Instances
Semigroup HStoreText | |
Defined in Database.PostgreSQL.Simple.HStore.Implementation (<>) :: HStoreText -> HStoreText -> HStoreText # sconcat :: NonEmpty HStoreText -> HStoreText # stimes :: Integral b => b -> HStoreText -> HStoreText # | |
Monoid HStoreText | |
Defined in Database.PostgreSQL.Simple.HStore.Implementation mempty :: HStoreText # mappend :: HStoreText -> HStoreText -> HStoreText # mconcat :: [HStoreText] -> HStoreText # | |
ToHStoreText HStoreText | |
Defined in Database.PostgreSQL.Simple.HStore.Implementation toHStoreText :: HStoreText -> HStoreText # |
class ToHStoreText a where #
toHStoreText :: a -> HStoreText #
Instances
ToHStoreText ByteString | Assumed to be UTF-8 encoded |
Defined in Database.PostgreSQL.Simple.HStore.Implementation toHStoreText :: ByteString -> HStoreText # | |
ToHStoreText ByteString | Assumed to be UTF-8 encoded |
Defined in Database.PostgreSQL.Simple.HStore.Implementation toHStoreText :: ByteString -> HStoreText # | |
ToHStoreText Text | |
Defined in Database.PostgreSQL.Simple.HStore.Implementation toHStoreText :: Text -> HStoreText # | |
ToHStoreText Text | |
Defined in Database.PostgreSQL.Simple.HStore.Implementation toHStoreText :: Text -> HStoreText # | |
ToHStoreText HStoreText | |
Defined in Database.PostgreSQL.Simple.HStore.Implementation toHStoreText :: HStoreText -> HStoreText # |
data HStoreBuilder #
Represents valid hstore syntax.
Instances
Semigroup HStoreBuilder | |
Defined in Database.PostgreSQL.Simple.HStore.Implementation (<>) :: HStoreBuilder -> HStoreBuilder -> HStoreBuilder # sconcat :: NonEmpty HStoreBuilder -> HStoreBuilder # stimes :: Integral b => b -> HStoreBuilder -> HStoreBuilder # | |
Monoid HStoreBuilder | |
Defined in Database.PostgreSQL.Simple.HStore.Implementation mempty :: HStoreBuilder # mappend :: HStoreBuilder -> HStoreBuilder -> HStoreBuilder # mconcat :: [HStoreBuilder] -> HStoreBuilder # | |
ToField HStoreBuilder | |
Defined in Database.PostgreSQL.Simple.HStore.Implementation toField :: HStoreBuilder -> Action # | |
ToHStore HStoreBuilder | |
Defined in Database.PostgreSQL.Simple.HStore.Implementation toHStore :: HStoreBuilder -> HStoreBuilder # |
toHStore :: a -> HStoreBuilder #
Instances
ToHStore HStoreMap | |
Defined in Database.PostgreSQL.Simple.HStore.Implementation toHStore :: HStoreMap -> HStoreBuilder # | |
ToHStore HStoreList | hstore |
Defined in Database.PostgreSQL.Simple.HStore.Implementation toHStore :: HStoreList -> HStoreBuilder # | |
ToHStore HStoreBuilder | |
Defined in Database.PostgreSQL.Simple.HStore.Implementation toHStore :: HStoreBuilder -> HStoreBuilder # |
hstore :: (ToHStoreText a, ToHStoreText b) => a -> b -> HStoreBuilder #
data IsolationLevel #
Of the four isolation levels defined by the SQL standard,
these are the three levels distinguished by PostgreSQL as of version 9.0.
See https://www.postgresql.org/docs/9.5/static/transaction-iso.html
for more information. Note that prior to PostgreSQL 9.0, RepeatableRead
was equivalent to Serializable
.
DefaultIsolationLevel | the isolation level will be taken from
PostgreSQL's per-connection
|
ReadCommitted | |
RepeatableRead | |
Serializable |
Instances
data ReadWriteMode #
DefaultReadWriteMode | the read-write mode will be taken from
PostgreSQL's per-connection
|
ReadWrite | |
ReadOnly |
Instances
data TransactionMode #
Instances
Eq TransactionMode | |
Defined in Database.PostgreSQL.Simple.Transaction (==) :: TransactionMode -> TransactionMode -> Bool # (/=) :: TransactionMode -> TransactionMode -> Bool # | |
Show TransactionMode | |
Defined in Database.PostgreSQL.Simple.Transaction showsPrec :: Int -> TransactionMode -> ShowS # show :: TransactionMode -> String # showList :: [TransactionMode] -> ShowS # |