postgresql-query 3.0.0 → 3.0.1

raw patch · 6 files changed

+47/−22 lines, 6 filesdep ~template-haskell

Dependency ranges changed: template-haskell

Files

CHANGELOG.md +3/−0
postgresql-query.cabal +1/−1
src/Database/PostgreSQL/Query/TH/Common.hs +13/−0
src/Database/PostgreSQL/Query/TH/Entity.hs +19/−3
src/Database/PostgreSQL/Query/TH/Enum.hs +5/−16
src/Database/PostgreSQL/Query/TH/Row.hs +6/−2

CHANGELOG.md view

@@ -1,5 +1,8 @@ # CHANGELOG +## 3.0.1+### Changed+* Buildability with ghc-8.0.1 ## 3.0.0 ### Added * Ability to mask some sensitive query arguments in query logs. In case you dont

postgresql-query.cabal view

@@ -1,5 +1,5 @@ name:                postgresql-query-version:             3.0.0+version:             3.0.1  synopsis: Sql interpolating quasiquote plus some kind of primitive ORM           using it

src/Database/PostgreSQL/Query/TH/Common.hs view

@@ -3,6 +3,7 @@   , cArgs   , cFieldNames   , lookupVNameErr+  , dataConstructors   ) where  import Prelude@@ -32,3 +33,15 @@     lookupValueName name >>=     maybe (error $ "could not find identifier: " ++ name)           return+++dataConstructors :: Info -> [Con]+dataConstructors = \case+  TyConI d ->+#if MIN_VERSION_template_haskell(2,11,0)+    let DataD _ _ _ _ cs _ = d+#else+    let DataD _ _ _ cs _ = d+#endif+    in cs+  x -> error $ "Expected type constructor, " ++ show x ++ " got"

src/Database/PostgreSQL/Query/TH/Entity.hs view

@@ -17,6 +17,10 @@ import Language.Haskell.TH.Syntax import Text.Inflections +#if !MIN_VERSION_base(4,8,0)+import Control.Applicative+#endif+ -- | Options for deriving `Entity` data EntityOptions = EntityOptions     { eoTableName      :: String -> String -- ^ Type name to table name converter@@ -74,17 +78,26 @@  deriveEntity :: EntityOptions -> Name -> Q [Dec] deriveEntity opts tname = do-    TyConI (DataD _ _ _ [tcon] _) <- reify tname+    tcon <- dataConstructors <$> reify tname >>= \case+      [a] -> return a+      x -> fail $ "expected exactly 1 data constructor, but " ++ show (length x) ++ " got"     econt <- [t|Entity $(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,11,0)         idcon = RecC (mkName idname)+                [(mkName unidname, Bang NoSourceUnpackedness NoSourceStrictness, idtype)]+        iddec = NewtypeInstD [] entityIdName [ConT tname] Nothing+                idcon (map ConT $ eoDeriveClasses opts)+#else+        idcon = RecC (mkName idname)                 [(mkName unidname, NotStrict, idtype)]         iddec = NewtypeInstD [] entityIdName [ConT tname]                 idcon (eoDeriveClasses opts)+#endif         tblName = fromString $ eoTableName opts tnames         fldNames = map (fromString . eoColumnNames opts . nameBase)                    $ cFieldNames tcon@@ -94,7 +107,10 @@     fldExp <- mapM lift (fldNames :: [FN])     let tbldec = FunD ntableName  [Clause [WildP] (NormalB tblExp) []]         flddec = FunD nfieldNames [Clause [WildP] (NormalB $ ListE fldExp) []]-        ret = InstanceD [] econt-              [ iddec, tbldec, flddec ]+#if MIN_VERSION_template_haskell(2,11,0)+        ret = InstanceD Nothing [] econt [ iddec, tbldec, flddec ]+#else+        ret = InstanceD [] econt [ iddec, tbldec, flddec ]+#endif         syndec = TySynD (mkName idname) [] (AppT (ConT entityIdName) (ConT tname))     return [ret, syndec]

src/Database/PostgreSQL/Query/TH/Enum.hs view

@@ -6,6 +6,7 @@   ) where  import Data.FileEmbed+import Database.PostgreSQL.Query.TH.Common import Database.PostgreSQL.Simple.FromField import Database.PostgreSQL.Simple.ToField import Language.Haskell.TH@@ -34,22 +35,10 @@      -- ^ type to derive instances for   -> DecsQ derivePgEnum infl typeName = do-  info <- reify typeName-  case info of-    TyConI dec ->-      case dec of-        DataD _ _ _ constructors _ -> do-          tfInstance <- makeToField infl typeName constructors-          ffInstance <- makeFromField infl typeName constructors-          pure [tfInstance, ffInstance]-        node  -> error-               $ "unsupported constructor type "-              ++ show node-              ++ "in makePgEnumExplicit"-    node       -> error-                $ "unsupported type "-               ++ show node-               ++ " in makePgEnumExplicit"+  constructors <- dataConstructors <$> reify typeName+  tfInstance <- makeToField infl typeName constructors+  ffInstance <- makeFromField infl typeName constructors+  pure [tfInstance, ffInstance]  makeToField :: InflectorFunc             -> Name

src/Database/PostgreSQL/Query/TH/Row.hs view

@@ -39,7 +39,9 @@  deriveFromRow :: Name -> Q [Dec] deriveFromRow t = do-    TyConI (DataD _ _ _ [con] _) <- reify t+    con <- dataConstructors <$> reify t >>= \case+      [a] -> return a+      x -> fail $ "expected exactly 1 data constructor, but " ++ show (length x) ++ " got"     cname <- cName con     cargs <- cArgs con     [d|instance FromRow $(return $ ConT t) where@@ -77,7 +79,9 @@  deriveToRow :: Name -> Q [Dec] deriveToRow t = do-    TyConI (DataD _ _ _ [con] _) <- reify t+    con <- dataConstructors <$> reify t >>= \case+      [a] -> return a+      x -> fail $ "expected exactly 1 data constructor, but " ++ show (length x) ++ " got"     cname <- cName con     cargs <- cArgs con     cvars <- sequence