hasql-th 0.5.0.1 → 0.5.1

raw patch · 8 files changed

+75/−66 lines, 8 filesdep ~postgresql-syntaxPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: postgresql-syntax

API changes (from Hackage documentation)

Files

• hasql-th.cabal +2/−2
• src/library/Hasql/TH.hs +8/−4
• src/library/Hasql/TH/Extraction/ChildExprList.hs +43/−40
• src/library/Hasql/TH/Extraction/Exp.hs +4/−5
• src/library/Hasql/TH/Extraction/InputTypeList.hs +6/−5
• src/library/Hasql/TH/Extraction/OutputTypeList.hs +9/−7
• src/library/Hasql/TH/Extraction/PlaceholderTypeMap.hs +1/−1
• src/library/Hasql/TH/Extraction/PrimitiveType.hs +2/−2

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: hasql-th-version: 0.5.0.1+version: 0.5.1 category: Hasql, Database, PostgreSQL, Template Haskell synopsis: Template Haskell utilities for Hasql description:@@ -100,7 +100,7 @@     contravariant >=1.5.2 && <2,     foldl >=1.4.5 && <2,     hasql >=1.10 && <1.11,-    postgresql-syntax >=0.4.1 && <0.5,+    postgresql-syntax >=0.5 && <0.6,     template-haskell >=2.8 && <3,     template-haskell-compat-v0208 >=0.1.9 && <0.2,     text >=1 && <3,

@@ -113,8 +113,7 @@ import Hasql.TH.Prelude hiding (exp) import Language.Haskell.TH.Quote import Language.Haskell.TH.Syntax-import qualified PostgresqlSyntax.Ast as Ast-import qualified PostgresqlSyntax.Parsing as Parsing+import qualified PostgresqlSyntax as Ast  -- * Helpers @@ -130,8 +129,13 @@ expPreparableStmtAstParser :: (Ast.PreparableStmt -> Either Text Exp) -> QuasiQuoter expPreparableStmtAstParser parser =   expParser $ \input -> do-    ast <- first fromString $ Parsing.run (Parsing.atEnd Parsing.preparableStmt) input+    ast <- Ast.parse settings input     parser ast+  where+    settings =+      mconcat+        [ Ast.nullabilityMarkers True+        ]  -- * Statement @@ -166,7 +170,7 @@ -- ... --   | -- 1 | elect 1---   |      ^+--   | ^ -- ... singletonStatement :: QuasiQuoter singletonStatement = expPreparableStmtAstParser (ExpExtraction.undecodedStatement Exp.singleRowResultDecoder)

@@ -3,7 +3,7 @@ module Hasql.TH.Extraction.ChildExprList where  import Hasql.TH.Prelude hiding (bit, fromList, sortBy)-import PostgresqlSyntax.Ast+import PostgresqlSyntax  -- * Types @@ -26,7 +26,6 @@   MinusAExpr a -> aExpr a   SymbolicBinOpAExpr a b c -> aExpr a <> symbolicExprBinOp b <> aExpr c   PrefixQualOpAExpr a b -> qualOp a <> aExpr b-  SuffixQualOpAExpr a b -> aExpr a <> qualOp b   AndAExpr a b -> aExpr a <> aExpr b   OrAExpr a b -> aExpr a <> aExpr b   NotAExpr a -> aExpr a@@ -90,21 +89,21 @@  overrideKind _ = [] -insertColumnList = foldMap insertColumnItem+insertColumnList (InsertColumnList a) = foldMap insertColumnItem a  insertColumnItem (InsertColumnItem a b) = colId a <> foldMap indirection b  onConflict (OnConflict a b) = foldMap confExpr a <> onConflictDo b  onConflictDo = \case-  UpdateOnConflictDo b c -> setClauseList b <> foldMap whereClause c+  UpdateOnConflictDo b c -> setClauseList b <> foldMap aExpr c   NothingOnConflictDo -> []  confExpr = \case-  WhereConfExpr a b -> indexParams a <> foldMap whereClause b+  WhereConfExpr a b -> indexParams a <> foldMap aExpr b   ConstraintConfExpr a -> name a -returningClause = targetList+returningClause (ReturningClause a) = targetList a  -- * Update @@ -116,7 +115,7 @@     <> foldMap whereOrCurrentClause e     <> foldMap returningClause f -setClauseList = foldMap setClause+setClauseList (SetClauseList a) = foldMap setClause a  setClause = \case   TargetSetClause a b -> setTarget a <> aExpr b@@ -124,7 +123,7 @@  setTarget (SetTarget a b) = colId a <> foldMap indirection b -setTargetList = foldMap setTarget+setTargetList (SetTargetList a) = foldMap setTarget a  -- * Delete @@ -135,13 +134,13 @@     <> foldMap whereOrCurrentClause d     <> foldMap returningClause e -usingClause = fromList+usingClause (UsingClause a) = fromList a  -- * Select  selectStmt = \case-  Left a -> selectNoParens a-  Right a -> selectWithParens a+  NoParensSelectStmt a -> selectNoParens a+  WithParensSelectStmt a -> selectWithParens a  selectNoParens (SelectNoParens a b c d e) =   foldMap withClause a@@ -165,7 +164,7 @@   OffsetSelectLimit a -> offsetClause a  limitClause = \case-  LimitLimitClause a b -> selectLimitValue a <> exprList b+  LimitLimitClause a b -> selectLimitValue a <> foldMap aExpr b   FetchOnlyLimitClause a b c -> foldMap selectFetchFirstValue b  offsetClause = \case@@ -187,7 +186,9 @@ forLockingItem (ForLockingItem a b c) =   foldMap (foldMap qualifiedName) b -selectClause = either simpleSelect selectWithParens+selectClause = \case+  SimpleSelectSelectClause a -> simpleSelect a+  WithParensSelectClause a -> selectWithParens a  simpleSelect = \case   NormalSimpleSelect a b c d e f g ->@@ -203,11 +204,11 @@   BinSimpleSelect _ a _ b -> selectClause a <> selectClause b  targeting = \case-  NormalTargeting a -> foldMap targetEl a-  AllTargeting a -> foldMap (foldMap targetEl) a-  DistinctTargeting a b -> foldMap exprList a <> foldMap targetEl b+  NormalTargeting a -> targetList a+  AllTargeting a -> foldMap targetList a+  DistinctTargeting a b -> foldMap exprList a <> targetList b -targetList = foldMap targetEl+targetList (TargetList a) = foldMap targetEl a  targetEl = \case   AliasedExprTargetEl a _ -> aExpr a@@ -215,25 +216,25 @@   ExprTargetEl a -> aExpr a   AsteriskTargetEl -> [] -intoClause = optTempTableName+intoClause (IntoClause a) = optTempTableName a -fromClause = fromList+fromClause (FromClause a) = fromList a -fromList = foldMap tableRef+fromList (FromList a) = foldMap tableRef a -whereClause = aExpr+whereClause (WhereClause a) = aExpr a  whereOrCurrentClause = \case   ExprWhereOrCurrentClause a -> aExpr a   CursorWhereOrCurrentClause a -> cursorName a -groupClause = foldMap groupByItem+groupClause (GroupClause a) = foldMap groupByItem a -havingClause = aExpr+havingClause (HavingClause a) = aExpr a -windowClause = foldMap windowDefinition+windowClause (WindowClause a) = foldMap windowDefinition a -valuesClause = foldMap exprList+valuesClause (ValuesClause a) = foldMap exprList a  optTempTableName _ = [] @@ -246,7 +247,7 @@  windowDefinition (WindowDefinition _ a) = windowSpecification a -windowSpecification (WindowSpecification _ a b c) = foldMap (foldMap aExpr) a <> foldMap sortClause b <> foldMap frameClause c+windowSpecification (WindowSpecification _ a b c) = foldMap exprList a <> foldMap sortClause b <> foldMap frameClause c  frameClause (FrameClause _ a _) = frameExtent a @@ -261,7 +262,7 @@   PrecedingFrameBound a -> aExpr a   FollowingFrameBound a -> aExpr a -sortClause = foldMap sortBy+sortClause (SortClause a) = foldMap sortBy a  sortBy = \case   UsingSortBy a b c -> aExpr a <> qualAllOp b <> foldMap nullsOrder c@@ -291,13 +292,13 @@  rowsfromItem (RowsfromItem a b) = funcExprWindowless a <> foldMap colDefList b -rowsfromList = foldMap rowsfromItem+rowsfromList (RowsfromList a) = foldMap rowsfromItem a  colDefList = tableFuncElementList  optOrdinality = const [] -tableFuncElementList = foldMap tableFuncElement+tableFuncElementList (TableFuncElementList a) = foldMap tableFuncElement a  tableFuncElement (TableFuncElement a b c) = colId a <> typename b <> foldMap collateClause c @@ -324,7 +325,7 @@   UsingJoinQual _ -> []   OnJoinQual a -> aExpr a -exprList = fmap AChildExpr . toList+exprList (ExprList a) = fmap AChildExpr (toList a)  aExpr = pure . AChildExpr @@ -403,8 +404,8 @@ funcApplication (FuncApplication a b) = funcName a <> foldMap funcApplicationParams b  funcApplicationParams = \case-  NormalFuncApplicationParams _ a b -> foldMap funcArgExpr a <> foldMap (foldMap sortBy) b-  VariadicFuncApplicationParams a b c -> foldMap (foldMap funcArgExpr) a <> funcArgExpr b <> foldMap (foldMap sortBy) c+  NormalFuncApplicationParams _ a b -> foldMap funcArgExpr a <> foldMap sortClause b+  VariadicFuncApplicationParams a b c -> foldMap (foldMap funcArgExpr) a <> funcArgExpr b <> foldMap sortClause c   StarFuncApplicationParams -> []  funcArgExpr = \case@@ -414,14 +415,14 @@  caseExpr (CaseExpr a b c) = foldMap aExpr a <> whenClauseList b <> foldMap aExpr c -whenClauseList = foldMap whenClause+whenClauseList (WhenClauseList a) = foldMap whenClause a  arrayExpr = \case   ExprListArrayExpr a -> exprList a   ArrayExprListArrayExpr a -> arrayExprList a   EmptyArrayExpr -> [] -arrayExprList = foldMap arrayExpr+arrayExprList (ArrayExprList a) = foldMap arrayExpr a  inExpr = \case   SelectInExpr a -> selectWithParens a@@ -484,7 +485,9 @@   ExplicitRowRow a -> explicitRow a   ImplicitRowRow a -> implicitRow a -explicitRow = foldMap exprList+explicitRow = \case+  EmptyExplicitRow -> []+  ExprListExplicitRow a -> exprList a  implicitRow (ImplicitRow a b) = exprList a <> aExpr b @@ -556,17 +559,17 @@   SimpleQualifiedName _ -> []   IndirectedQualifiedName _ a -> indirection a -indirection = foldMap indirectionEl+indirection (Indirection a) = foldMap indirectionEl a  indirectionEl = \case   AttrNameIndirectionEl _ -> []   AllIndirectionEl -> []   ExprIndirectionEl a -> aExpr a-  SliceIndirectionEl a b -> exprList a <> exprList b+  SliceIndirectionEl a b -> foldMap aExpr a <> foldMap aExpr b  -- * Types -typeList = foldMap typename+typeList (TypeList a) = foldMap typename a  typename (Typename a b c d) =   simpleTypename b@@ -585,7 +588,7 @@  typeFunctionName = ident -attrs = foldMap attrName+attrs (Attrs a) = foldMap attrName a  attrName _ = [] @@ -597,7 +600,7 @@  -- * Indexes -indexParams = foldMap indexElem+indexParams (IndexParams a) = foldMap indexElem a  indexElem (IndexElem a b c d e) = indexElemDef a <> foldMap anyName b <> foldMap anyName c 

@@ -8,12 +8,11 @@ import qualified Hasql.TH.Extraction.PrimitiveType as PrimitiveType import Hasql.TH.Prelude import Language.Haskell.TH-import qualified PostgresqlSyntax.Ast as Ast-import qualified PostgresqlSyntax.Rendering as Rendering+import qualified PostgresqlSyntax as Ast  undecodedStatement :: (Exp -> Exp) -> Ast.PreparableStmt -> Either Text Exp undecodedStatement decoderProj ast =-  let sql = (Exp.text . Rendering.toText . Rendering.preparableStmt) ast+  let sql = (Exp.text . Ast.toText mempty) ast    in do         encoder <- paramsEncoder ast         rowDecoder' <- rowDecoder ast@@ -21,7 +20,7 @@  foldStatement :: Ast.PreparableStmt -> Either Text Exp foldStatement ast =-  let sql = (Exp.text . Rendering.toText . Rendering.preparableStmt) ast+  let sql = (Exp.text . Ast.toText mempty) ast    in do         encoder <- paramsEncoder ast         rowDecoder' <- rowDecoder ast@@ -60,7 +59,7 @@       case d of         Nothing -> unidimensional e c         Just (f, g) -> case f of-          Ast.BoundsTypenameArrayDimensions h -> multidimensional e c (length h) g+          Ast.BoundsTypenameArrayDimensions (Ast.ArrayBounds h) -> multidimensional e c (length h) g           Ast.ExplicitTypenameArrayDimensions _ -> multidimensional e c 1 g  valueEncoder :: PrimitiveType.PrimitiveType -> Either Text Exp

@@ -5,11 +5,12 @@ import qualified Data.IntMap.Strict as IntMap import qualified Hasql.TH.Extraction.PlaceholderTypeMap as PlaceholderTypeMap import Hasql.TH.Prelude-import PostgresqlSyntax.Ast+import PostgresqlSyntax  -- |--- >>> import qualified PostgresqlSyntax.Parsing as P--- >>> test = either fail (return . preparableStmt) . P.run P.preparableStmt+-- >>> import qualified Data.Text as Text+-- >>> import qualified PostgresqlSyntax as P+-- >>> test = either (fail . Text.unpack) (return . preparableStmt) . P.parse (P.nullabilityMarkers True) -- -- >>> test "select $1 :: INT" -- Right [Typename False (NumericSimpleTypename IntNumeric) False Nothing]@@ -21,10 +22,10 @@ -- Right [Typename False (GenericTypeSimpleTypename (GenericType (UnquotedIdent "int4") Nothing Nothing)) False Nothing] -- -- >>> test "select $1 :: text[]?"--- Right [Typename False (GenericTypeSimpleTypename (GenericType (UnquotedIdent "text") Nothing Nothing)) False (Just (BoundsTypenameArrayDimensions (Nothing :| []),True))]+-- Right [Typename False (GenericTypeSimpleTypename (GenericType (UnquotedIdent "text") Nothing Nothing)) False (Just (BoundsTypenameArrayDimensions (ArrayBounds (Nothing :| [])),True))] -- -- >>> test "select $1 :: text?[]?"--- Right [Typename False (GenericTypeSimpleTypename (GenericType (UnquotedIdent "text") Nothing Nothing)) True (Just (BoundsTypenameArrayDimensions (Nothing :| []),True))]+-- Right [Typename False (GenericTypeSimpleTypename (GenericType (UnquotedIdent "text") Nothing Nothing)) True (Just (BoundsTypenameArrayDimensions (ArrayBounds (Nothing :| [])),True))] -- -- >>> test "select $1" -- Left "Placeholder $1 misses an explicit typecast"

@@ -5,7 +5,7 @@ module Hasql.TH.Extraction.OutputTypeList where  import Hasql.TH.Prelude-import PostgresqlSyntax.Ast+import PostgresqlSyntax  foldable :: (Foldable f) => (a -> Either Text [Typename]) -> f a -> Either Text [Typename] foldable fn = fmap join . traverse fn . toList@@ -26,7 +26,7 @@  insertStmt (InsertStmt a b c d e) = foldable returningClause e -returningClause = targetList+returningClause (ReturningClause a) = targetList a  -- * Update @@ -39,8 +39,8 @@ -- * Select  selectStmt = \case-  Left a -> selectNoParens a-  Right a -> selectWithParens a+  NoParensSelectStmt a -> selectNoParens a+  WithParensSelectStmt a -> selectWithParens a  selectNoParens (SelectNoParens _ a _ _ _) = selectClause a @@ -48,7 +48,9 @@   NoParensSelectWithParens a -> selectNoParens a   WithParensSelectWithParens a -> selectWithParens a -selectClause = either simpleSelect selectWithParens+selectClause = \case+  SimpleSelectSelectClause a -> simpleSelect a+  WithParensSelectClause a -> selectWithParens a  simpleSelect = \case   NormalSimpleSelect a _ _ _ _ _ _ -> foldable targeting a@@ -66,7 +68,7 @@   AllTargeting a -> foldable targetList a   DistinctTargeting _ b -> targetList b -targetList = foldable targetEl+targetList (TargetList a) = foldable targetEl a  targetEl = \case   AliasedExprTargetEl a _ -> aExpr a@@ -78,7 +80,7 @@       \because it leaves the output types unspecified. \       \You have to be specific." -valuesClause = foldable (foldable aExpr)+valuesClause (ValuesClause a) = foldable (\(ExprList b) -> foldable aExpr b) a  aExpr = \case   CExprAExpr a -> cExpr a

@@ -6,7 +6,7 @@ import Hasql.TH.Extraction.ChildExprList (ChildExpr (..)) import qualified Hasql.TH.Extraction.ChildExprList as ChildExprList import Hasql.TH.Prelude hiding (union)-import PostgresqlSyntax.Ast+import PostgresqlSyntax  preparableStmt :: PreparableStmt -> Either Text (IntMap Typename) preparableStmt = childExprList . ChildExprList.preparableStmt

@@ -3,7 +3,7 @@ module Hasql.TH.Extraction.PrimitiveType where  import Hasql.TH.Prelude hiding (bit, fromList, sortBy)-import PostgresqlSyntax.Ast+import PostgresqlSyntax  data PrimitiveType   = BoolPrimitiveType@@ -71,7 +71,7 @@   TimeConstDatetime _ a -> if tz a then Right TimetzPrimitiveType else Right TimePrimitiveType   where     tz = \case-      Just a -> a+      Just (Timezone a) -> a       Nothing -> False  ident = \case