packages feed

hasql-th 0.4.1.1 → 0.5.1

raw patch · 10 files changed

Files

hasql-th.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: hasql-th-version: 0.4.1.1+version: 0.5.1 category: Hasql, Database, PostgreSQL, Template Haskell synopsis: Template Haskell utilities for Hasql description:@@ -23,8 +23,8 @@   type: git   location: https://github.com/nikita-volkov/hasql-th -library-  hs-source-dirs: src/library+common base+  default-language: Haskell2010   default-extensions:     ApplicativeDo     Arrows@@ -65,7 +65,24 @@     TypeOperators     UnboxedTuples -  default-language: Haskell2010+common executable+  import: base+  ghc-options:+    -O2+    -threaded+    -with-rtsopts=-N+    -rtsopts+    -funbox-strict-fields++common test+  import: base+  ghc-options:+    -threaded+    -with-rtsopts=-N++library+  import: base+  hs-source-dirs: src/library   exposed-modules: Hasql.TH   other-modules:     Hasql.TH.Construction.Exp@@ -79,12 +96,11 @@    build-depends:     base >=4.11 && <5,-    bytestring >=0.10 && <0.13,     containers >=0.6 && <0.9,     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,
src/library/Hasql/TH.hs view
@@ -10,6 +10,11 @@     --     --  Here's an example of how to use it:     --+    --  Enable the @QuasiQuotes@ language extension in any module that uses+    --  these quasiquoters:+    --+    --  >{-# LANGUAGE QuasiQuotes #-}+    --     --  >selectUserDetails :: Statement Int32 (Maybe (Text, Text, Maybe Text))     --  >selectUserDetails =     --  >  [maybeStatement|@@ -93,43 +98,44 @@     resultlessStatement,     rowsAffectedStatement, -    -- * SQL ByteStrings+    -- * SQL Strings      -- |-    --  ByteString-producing quasiquoters.-    ---    --  For now they perform no compile-time checking.+    -- Text-producing quasiquoters performing no compile-time checking.     uncheckedSql,     uncheckedSqlFile,   ) where  import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text import qualified Hasql.TH.Construction.Exp as Exp import qualified Hasql.TH.Extraction.Exp as ExpExtraction 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  exp :: (String -> Q Exp) -> QuasiQuoter exp =-  let _unsupported _ = fail "Unsupported"-   in \_exp -> QuasiQuoter _exp _unsupported _unsupported _unsupported+  let unsupported _ = fail "Unsupported"+   in \exp -> QuasiQuoter exp unsupported unsupported unsupported  expParser :: (Text -> Either Text Exp) -> QuasiQuoter-expParser _parser =-  exp $ \_inputString -> either (fail . Text.unpack) return $ _parser $ fromString _inputString+expParser parser =+  exp $ \inputString -> either (fail . Text.unpack) return $ parser $ fromString inputString  expPreparableStmtAstParser :: (Ast.PreparableStmt -> Either Text Exp) -> QuasiQuoter-expPreparableStmtAstParser _parser =-  expParser $ \_input -> do-    _ast <- first fromString $ Parsing.run (Parsing.atEnd Parsing.preparableStmt) _input-    _parser _ast+expPreparableStmtAstParser parser =+  expParser $ \input -> do+    ast <- Ast.parse settings input+    parser ast+  where+    settings =+      mconcat+        [ Ast.nullabilityMarkers True+        ]  -- * Statement @@ -164,7 +170,7 @@ -- ... --   | -- 1 | elect 1---   |      ^+--   | ^ -- ... singletonStatement :: QuasiQuoter singletonStatement = expPreparableStmtAstParser (ExpExtraction.undecodedStatement Exp.singleRowResultDecoder)@@ -242,33 +248,33 @@ rowsAffectedStatement :: QuasiQuoter rowsAffectedStatement = expPreparableStmtAstParser (ExpExtraction.undecodedStatement (const Exp.rowsAffectedResultDecoder)) --- * SQL ByteStrings+-- * SQL Strings  -- | -- Quoter of a multiline Unicode SQL string, -- which gets converted into a format ready to be used for declaration of statements. uncheckedSql :: QuasiQuoter-uncheckedSql = exp $ return . Exp.byteString . Text.encodeUtf8 . fromString+uncheckedSql = exp $ return . Exp.text . fromString  -- | -- Read an SQL-file, containing multiple statements,--- and produce an expression of type `ByteString`.+-- and produce an expression of type 'Text'. -- -- Allows to store plain SQL in external files and read it at compile time. -- -- E.g., -- -- >migration1 :: Hasql.Session.Session ()--- >migration1 = Hasql.Session.sql [uncheckedSqlFile|migrations/1.sql|]+-- >migration1 = Hasql.Session.script [uncheckedSqlFile|migrations/1.sql|] uncheckedSqlFile :: QuasiQuoter uncheckedSqlFile = quoteFile uncheckedSql  -- * Tests  -- $--- >>> :t [maybeStatement| select (password = $2 :: bytea) :: bool, id :: int4 from "user" where "email" = $1 :: text |]+-- >>> :t [maybeStatement| select (password = $2 :: text) :: bool, id :: int4 from "user" where "email" = $1 :: text |] -- ...--- ... Statement (Text, ByteString) (Maybe (Bool, Int32))+-- ... Statement (Text, Text) (Maybe (Bool, Int32)) -- -- >>> :t [maybeStatement| select id :: int4 from application where pub_key = $1 :: uuid and sec_key_pt1 = $2 :: int8 and sec_key_pt2 = $3 :: int8 |] -- ...
src/library/Hasql/TH/Construction/Exp.hs view
@@ -2,8 +2,7 @@ -- Expression construction. module Hasql.TH.Construction.Exp where -import qualified Data.ByteString as ByteString-import qualified Data.ByteString.Unsafe as ByteString+import qualified Data.Text as Text import qualified Data.Vector.Generic as Vector import qualified Hasql.Decoders as Decoders import qualified Hasql.Encoders as Encoders@@ -18,16 +17,8 @@ appList :: Exp -> [Exp] -> Exp appList = foldl' AppE -byteString :: ByteString -> Exp-byteString x =-  appList-    (VarE 'unsafeDupablePerformIO)-    [ appList-        (VarE 'ByteString.unsafePackAddressLen)-        [ LitE (IntegerL (fromIntegral (ByteString.length x))),-          LitE (StringPrimL (ByteString.unpack x))-        ]-    ]+text :: Text -> Exp+text x = AppE (VarE 'Text.pack) (LitE (StringL (Text.unpack x)))  integral :: (Integral a) => a -> Exp integral x = LitE (IntegerL (fromIntegral x))@@ -69,17 +60,16 @@ -- a single divisible functor, parameterized by a tuple of according arity. contrazip :: [Exp] -> Exp contrazip = \case-  _head : [] -> _head-  _head : _tail -> appList (VarE 'divide) [splitTupleAt (succ (length _tail)) 1, _head, contrazip _tail]+  hd : [] -> hd+  hd : tl -> appList (VarE 'divide) [splitTupleAt (succ (length tl)) 1, hd, contrazip tl]   [] ->     SigE       (VarE 'conquer)-      ( let _fName = mkName "f"-            _fVar = VarT _fName+      ( let fName = mkName "f"          in ForallT-              [Compat.specifiedPlainTV _fName]-              [AppT (ConT ''Divisible) (VarT _fName)]-              (AppT (VarT _fName) (TupleT 0))+              [Compat.specifiedPlainTV fName]+              [AppT (ConT ''Divisible) (VarT fName)]+              (AppT (VarT fName) (TupleT 0))       )  -- |@@ -94,37 +84,37 @@ -- Just (1,2,3) cozip :: [Exp] -> Exp cozip = \case-  _head : [] -> _head-  _head : _tail ->-    let _length = length _tail + 1+  hd : [] -> hd+  hd : tl ->+    let len = length tl + 1      in foldl'           (\a b -> AppE (AppE (VarE '(<*>)) a) b)-          (AppE (AppE (VarE 'fmap) (tuple _length)) _head)-          _tail+          (AppE (AppE (VarE 'fmap) (tuple len)) hd)+          tl   [] -> AppE (VarE 'pure) (TupE [])  -- | -- Lambda expression, which destructures 'Fold'. foldLam :: (Exp -> Exp -> Exp -> Exp) -> Exp-foldLam _body =-  let _stepVarName = mkName "progress"-      _initVarName = mkName "start"-      _extractVarName = mkName "finish"+foldLam body =+  let stepVarName = mkName "progress"+      initVarName = mkName "start"+      extractVarName = mkName "finish"    in LamE         [ Compat.conP             'Fold-            [ VarP _stepVarName,-              VarP _initVarName,-              VarP _extractVarName+            [ VarP stepVarName,+              VarP initVarName,+              VarP extractVarName             ]         ]-        (_body (VarE _stepVarName) (VarE _initVarName) (VarE _extractVarName))+        (body (VarE stepVarName) (VarE initVarName) (VarE extractVarName))  -- * Statement  statement :: Exp -> Exp -> Exp -> Exp-statement _sql _encoder _decoder =-  appList (VarE 'Statement.preparable) [_sql, _encoder, _decoder]+statement sql encoder decoder =+  appList (VarE 'Statement.preparable) [sql, encoder, decoder]  noResultResultDecoder :: Exp noResultResultDecoder = VarE 'Decoders.noResult@@ -142,12 +132,12 @@ rowVectorResultDecoder = AppE (VarE 'Decoders.rowVector)  foldStatement :: Exp -> Exp -> Exp -> Exp-foldStatement _sql _encoder _rowDecoder =-  foldLam (\_step _init _extract -> statement _sql _encoder (foldResultDecoder _step _init _extract _rowDecoder))+foldStatement sql encoder rowDecoder' =+  foldLam (\step init extract -> statement sql encoder (foldResultDecoder step init extract rowDecoder'))  foldResultDecoder :: Exp -> Exp -> Exp -> Exp -> Exp-foldResultDecoder _step _init _extract _rowDecoder =-  appList (VarE 'fmap) [_extract, appList (VarE 'Decoders.foldlRows) [_step, _init, _rowDecoder]]+foldResultDecoder step init extract rowDecoder' =+  appList (VarE 'fmap) [extract, appList (VarE 'Decoders.foldlRows) [step, init, rowDecoder']]  unidimensionalParamEncoder :: Bool -> Exp -> Exp unidimensionalParamEncoder nullable =
src/library/Hasql/TH/Extraction/ChildExprList.hs view
@@ -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
src/library/Hasql/TH/Extraction/Exp.hs view
@@ -8,24 +8,23 @@ 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.byteString . Rendering.toByteString . Rendering.preparableStmt) _ast+undecodedStatement decoderProj ast =+  let sql = (Exp.text . Ast.toText mempty) ast    in do-        _encoder <- paramsEncoder _ast-        _rowDecoder <- rowDecoder _ast-        return (Exp.statement _sql _encoder (_decoderProj _rowDecoder))+        encoder <- paramsEncoder ast+        rowDecoder' <- rowDecoder ast+        return (Exp.statement sql encoder (decoderProj rowDecoder'))  foldStatement :: Ast.PreparableStmt -> Either Text Exp-foldStatement _ast =-  let _sql = (Exp.byteString . Rendering.toByteString . Rendering.preparableStmt) _ast+foldStatement ast =+  let sql = (Exp.text . Ast.toText mempty) ast    in do-        _encoder <- paramsEncoder _ast-        _rowDecoder <- rowDecoder _ast-        return (Exp.foldStatement _sql _encoder _rowDecoder)+        encoder <- paramsEncoder ast+        rowDecoder' <- rowDecoder ast+        return (Exp.foldStatement sql encoder rowDecoder')  paramsEncoder :: Ast.PreparableStmt -> Either Text Exp paramsEncoder a = do@@ -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
src/library/Hasql/TH/Extraction/InputTypeList.hs view
@@ -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"
src/library/Hasql/TH/Extraction/OutputTypeList.hs view
@@ -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
src/library/Hasql/TH/Extraction/PlaceholderTypeMap.hs view
@@ -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
src/library/Hasql/TH/Extraction/PrimitiveType.hs view
@@ -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
src/library/Hasql/TH/Prelude.hs view
@@ -19,7 +19,6 @@ import Data.Bifunctor as Exports import Data.Bits as Exports import Data.Bool as Exports-import Data.ByteString as Exports (ByteString) import Data.Char as Exports import Data.Coerce as Exports import Data.Complex as Exports@@ -56,6 +55,7 @@ import Data.Tuple as Exports import Data.UUID as Exports (UUID) import Data.Unique as Exports+import Data.Vector as Exports (Vector) import Data.Version as Exports import Data.Void as Exports import Data.Word as Exports@@ -68,6 +68,7 @@ import GHC.Exts as Exports (IsList (Item, fromList), groupWith, inline, lazy, sortWith) import GHC.Generics as Exports (Generic, Generic1) import GHC.IO.Exception as Exports+import Hasql.Statement as Exports (Statement) import Numeric as Exports import System.Environment as Exports import System.Exit as Exports