diff --git a/hasql-th.cabal b/hasql-th.cabal --- a/hasql-th.cabal +++ b/hasql-th.cabal @@ -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, diff --git a/src/library/Hasql/TH.hs b/src/library/Hasql/TH.hs --- a/src/library/Hasql/TH.hs +++ b/src/library/Hasql/TH.hs @@ -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 |] -- ... diff --git a/src/library/Hasql/TH/Construction/Exp.hs b/src/library/Hasql/TH/Construction/Exp.hs --- a/src/library/Hasql/TH/Construction/Exp.hs +++ b/src/library/Hasql/TH/Construction/Exp.hs @@ -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 = diff --git a/src/library/Hasql/TH/Extraction/ChildExprList.hs b/src/library/Hasql/TH/Extraction/ChildExprList.hs --- a/src/library/Hasql/TH/Extraction/ChildExprList.hs +++ b/src/library/Hasql/TH/Extraction/ChildExprList.hs @@ -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 diff --git a/src/library/Hasql/TH/Extraction/Exp.hs b/src/library/Hasql/TH/Extraction/Exp.hs --- a/src/library/Hasql/TH/Extraction/Exp.hs +++ b/src/library/Hasql/TH/Extraction/Exp.hs @@ -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 diff --git a/src/library/Hasql/TH/Extraction/InputTypeList.hs b/src/library/Hasql/TH/Extraction/InputTypeList.hs --- a/src/library/Hasql/TH/Extraction/InputTypeList.hs +++ b/src/library/Hasql/TH/Extraction/InputTypeList.hs @@ -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" diff --git a/src/library/Hasql/TH/Extraction/OutputTypeList.hs b/src/library/Hasql/TH/Extraction/OutputTypeList.hs --- a/src/library/Hasql/TH/Extraction/OutputTypeList.hs +++ b/src/library/Hasql/TH/Extraction/OutputTypeList.hs @@ -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 diff --git a/src/library/Hasql/TH/Extraction/PlaceholderTypeMap.hs b/src/library/Hasql/TH/Extraction/PlaceholderTypeMap.hs --- a/src/library/Hasql/TH/Extraction/PlaceholderTypeMap.hs +++ b/src/library/Hasql/TH/Extraction/PlaceholderTypeMap.hs @@ -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 diff --git a/src/library/Hasql/TH/Extraction/PrimitiveType.hs b/src/library/Hasql/TH/Extraction/PrimitiveType.hs --- a/src/library/Hasql/TH/Extraction/PrimitiveType.hs +++ b/src/library/Hasql/TH/Extraction/PrimitiveType.hs @@ -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 diff --git a/src/library/Hasql/TH/Prelude.hs b/src/library/Hasql/TH/Prelude.hs --- a/src/library/Hasql/TH/Prelude.hs +++ b/src/library/Hasql/TH/Prelude.hs @@ -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