packages feed

hasql-th 0.4.1.1 → 0.5.1.1

raw patch · 12 files changed

Files

+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# v0.5.1.1++- Conform to the new `hasql` API (v2.0)
+ README.md view
@@ -0,0 +1,178 @@+# Summary++An extension library for the ["hasql"](https://github.com/nikita-volkov/hasql) Postgres driver, bringing compile-time syntax checking of queries atop of a great simplification of declaration of statements. All the user needs to do is just specify SQL.++Here's a brief example of how it works:++> **Note:** these quasiquoters require the `QuasiQuotes` language extension.+> In a Haskell module, add `{-# LANGUAGE QuasiQuotes #-}`; in GHCi, run+> `:set -XQuasiQuotes`.++```haskell+{-# LANGUAGE QuasiQuotes #-}++selectUserDetails :: Statement Int32 (Maybe (Text, Text, Maybe Text))+selectUserDetails =+  [maybeStatement|+    select name :: text, email :: text, phone :: text?+    from "user"+    where id = $1 :: int4+    |]+```++As you can see, it completely eliminates the need to deal with codecs. The quasiquoters directly produce `Statement`, which you can then [`dimap`](https://hackage.haskell.org/package/profunctors-5.5.1/docs/Data-Profunctor.html#v:dimap) over using its `Profunctor` instance to get to your domain types.++<details>+<summary>Examples of mapping to custom types</summary>++```haskell+newtype UserId = UserId Int32++data UserDetails = UserDetails {+  _name :: Text,+  _email :: Text,+  _phone :: Maybe Text+}++selectUserDetails :: Statement UserId (Maybe UserDetails)+selectUserDetails =+  dimap+    (\ (UserId a) -> a)+    (\ case+      Just (a, b, c) -> Just (UserDetails a b c)+      Nothing -> Nothing)+    [maybeStatement|+      select name :: text, email :: text, phone :: text?+      from "user"+      where id = $1 :: int4+      |]+```++Using some Haskell's advanced techniques and the ["tuple"](http://hackage.haskell.org/package/tuple) library we can reduce the boilerplate in the previous definition:++```haskell+import Data.Tuple.Curry -- from the "tuple" library++selectUserDetails :: Statement UserId (Maybe UserDetails)+selectUserDetails =+  dimap coerce (fmap (uncurryN UserDetails))+    [maybeStatement|+      select name :: text, email :: text, phone :: text?+      from "user"+      where id = $1 :: int4+      |]+```++</details>++# Status++The library supports almost all of Postgresql syntax available for preparable statements. This includes Select, Insert, Update and Delete among others. The only thing that is not supported yet is some of its very rarely used XML-related features.++## Quality++The parser and renderer get heavily tested using the following property: rendering a random AST then parsing it should produce the same AST. This pretty much covers most possible reasons for bugs in the library.++# Implementation++This library internally implements a port of the original Postgres SQL syntax parser. It might sound like an overkill, but there really were no better options.++Unfortunately Postgres doesn't export it's own parser in any of its distributions, so there's no C-library to link to and wrap.++Isolating the original C-code and including it in a Haskell project is also not an option, because it's heavily based on code generators and complex make-file instructions. Maintaining such a codebase also seems like a non-viable option.++Fortunately the original parser is implemented using a declarative notation (the one which the mentioned code generators work with). It being declarative makes the process of porting to Haskell quite straight-forward. ++Also for the purposes of this library we need access to the full syntax tree for extracting data on placeholders and statement results. Quick and dirty hacks won't do.++For these reasons it's been decided to port the original parser and AST as close as possible to Haskell using the "megaparsec" library.++# Error messages++The parser turns out to be actually better than the one in Postgres in terms of error-reporting. That's because of Haskell's superabilities in the area of parsing compared to C. The library uses the ["megaparsec"](http://hackage.haskell.org/package/megaparsec) library and the ["headed-megaparsec"](http://hackage.haskell.org/package/headed-megaparsec) extension for it. As the result of that, the error messages produced by this parser are more informative than the ones in Postgres. Following are a few examples.++## Error example 1++Consider the following broken statement:++```sql+select 1 from a where b >= 3 && b < 4+```++It is incorrect, because it uses `&&` instead of `and`. But here's what Postgres' original parser says about it:++```+ERROR:  syntax error at or near "<"+LINE 1: select 1 from a where b >= 3 && b < 4;+                                          ^+```++Here's what "hasql-th" says:++```+  |+2 |     select 1 from a where b >= 3 && b < 4;+  |                                  ^+unexpected '&'+```++## Error example 2++It's not obvious what is wrong in the following statement either:++```sql+insert into user (name) values ($1)+```++The Postgres parser doesn't help much:++```+ERROR:  syntax error at or near "user"+LINE 1: insert into user (name) values ($1);+                    ^+```++Here's what "hasql-th" says though:++```+  |+2 |       insert into user (name) values ($1)+  |                       ^+Reserved keyword "user" used as an identifier. If that's what you intend, you have to wrap it in double quotes.+```++## Error example 3++It turns out that the original Postgres parser never produces any other messages than the opaque "syntax error at or near". "hasql-th" on the other hand is quite descriptive. E.g., here's how it gradually guides to insert the missing expected pieces.++Input:++```haskell+[resultlessStatement|insert into |]+```++Error:++```+  |+1 | insert into +  |             ^+unexpected end of input+expecting identifier or white space+```++Input:++```haskell+[resultlessStatement|insert into a |]+```++Error:++```+  |+1 | insert into a +  |               ^+unexpected end of input+expecting "default", "overriding", "select", "values", '(', white space, or with clause+```
hasql-th.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: hasql-th-version: 0.4.1.1+version: 0.5.1.1 category: Hasql, Database, PostgreSQL, Template Haskell synopsis: Template Haskell utilities for Hasql description:@@ -18,13 +18,16 @@ copyright: (c) 2015, Nikita Volkov license: MIT license-file: LICENSE+extra-doc-files:+  CHANGELOG.md+  README.md  source-repository head   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 +68,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 +99,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,+    hasql >=1.10 && <1.11 || >=2.0 && <2.1,+    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 @@ -313,18 +314,15 @@  joinedTable = \case   InParensJoinedTable a -> joinedTable a-  MethJoinedTable a b c -> joinMeth a <> tableRef b <> tableRef c--joinMeth = \case-  CrossJoinMeth -> []-  QualJoinMeth _ a -> joinQual a-  NaturalJoinMeth _ -> []+  CrossJoinedTable a b -> tableRef a <> tableRef b+  QualJoinedTable a _ b c -> tableRef a <> tableRef b <> joinQual c+  NaturalJoinedTable a _ b -> tableRef a <> tableRef b  joinQual = \case   UsingJoinQual _ -> []   OnJoinQual a -> aExpr a -exprList = fmap AChildExpr . toList+exprList (ExprList a) = fmap AChildExpr (toList a)  aExpr = pure . AChildExpr @@ -403,8 +401,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 +412,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 +482,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 +556,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 +585,7 @@  typeFunctionName = ident -attrs = foldMap attrName+attrs (Attrs a) = foldMap attrName a  attrName _ = [] @@ -597,7 +597,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,7 +68,9 @@ 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 Prelude as Exports hiding (all, and, any, concat, concatMap, elem, fail, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.)) import System.Environment as Exports import System.Exit as Exports import System.IO as Exports@@ -80,7 +82,6 @@ import Text.Printf as Exports (hPrintf, printf) import Text.Read as Exports (Read (..), readEither, readMaybe) import Unsafe.Coerce as Exports-import Prelude as Exports hiding (all, and, any, concat, concatMap, elem, fail, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.))  showAsText :: (Show a) => a -> Text showAsText = show >>> fromString