diff options
author | AlekseyUymanov <> | 2021-01-12 20:19:00 (GMT) |
---|---|---|
committer | hdiff <hdiff@hdiff.luite.com> | 2021-01-12 20:19:00 (GMT) |
commit | cdb98d5fc2b5108fac8d66e45873ff98265976ea (patch) | |
tree | 08f15158201554255864f5c525ec7d033483e62d | |
parent | 3a82e51a8bbc27aa55cb3de7d3d4a13989741c94 (diff) |
-rw-r--r-- | CHANGELOG.md | 2 | ||||
-rw-r--r-- | postgresql-query.cabal | 2 | ||||
-rw-r--r-- | src/Database/PostgreSQL/Query/Entity/Functions.hs | 3 | ||||
-rw-r--r-- | src/Database/PostgreSQL/Query/TH/Entity.hs | 8 |
4 files changed, 11 insertions, 4 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md index 7c59ed3..e738d1e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,6 @@ # CHANGELOG -## 3.8.0 +## 3.8.1 ### Changed * Compatibility with ghc-8.8.3 diff --git a/postgresql-query.cabal b/postgresql-query.cabal index 59179de..efecef4 100644 --- a/postgresql-query.cabal +++ b/postgresql-query.cabal @@ -1,5 +1,5 @@ name: postgresql-query -version: 3.8.0 +version: 3.8.1 synopsis: Sql interpolating quasiquote plus some kind of primitive ORM using it diff --git a/src/Database/PostgreSQL/Query/Entity/Functions.hs b/src/Database/PostgreSQL/Query/Entity/Functions.hs index 6109d8c..108a1c9 100644 --- a/src/Database/PostgreSQL/Query/Entity/Functions.hs +++ b/src/Database/PostgreSQL/Query/Entity/Functions.hs @@ -27,6 +27,7 @@ import Database.PostgreSQL.Simple import Database.PostgreSQL.Simple.FromField import Database.PostgreSQL.Simple.ToField +import qualified Control.Monad.Fail as F import qualified Data.List as L import qualified Data.List.NonEmpty as NL @@ -35,7 +36,7 @@ import qualified Data.List.NonEmpty as NL pgInsertEntity :: forall a m . ( MonadPostgres m, MonadLogger m, Entity a - , ToRow a, FromField (EntityId a) ) + , ToRow a, FromField (EntityId a), F.MonadFail m ) => a -> m (EntityId a) pgInsertEntity a = do diff --git a/src/Database/PostgreSQL/Query/TH/Entity.hs b/src/Database/PostgreSQL/Query/TH/Entity.hs index d5ea954..83519e8 100644 --- a/src/Database/PostgreSQL/Query/TH/Entity.hs +++ b/src/Database/PostgreSQL/Query/TH/Entity.hs @@ -87,12 +87,18 @@ deriveEntity opts tname = do [a] -> return a x -> fail $ "expected exactly 1 data constructor, but " ++ show (length x) ++ " got" econt <- [t|Entity $(conT tname)|] + eidcont <- [t|EntityId $(conT tname)|] ConT entityIdName <- [t|EntityId|] let tnames = nameBase tname idname = tnames ++ "Id" unidname = "get" ++ idname idtype = ConT (eoIdType opts) -#if MIN_VERSION_template_haskell(2,12,0) +#if MIN_VERSION_template_haskell(2,15,0) + idcon = RecC (mkName idname) + [(mkName unidname, Bang NoSourceUnpackedness NoSourceStrictness, idtype)] + iddec = NewtypeInstD [] Nothing eidcont Nothing + idcon [DerivClause Nothing (map ConT $ eoDeriveClasses opts)] +#elif MIN_VERSION_template_haskell(2,12,0) idcon = RecC (mkName idname) [(mkName unidname, Bang NoSourceUnpackedness NoSourceStrictness, idtype)] iddec = NewtypeInstD [] entityIdName [ConT tname] Nothing |