hasql-th 0.4.1.1 → 0.5
raw patch · 5 files changed
+77/−73 lines, 5 filesdep −bytestringPVP ok
version bump matches the API change (PVP)
Dependencies removed: bytestring
API changes (from Hackage documentation)
Files
- hasql-th.cabal +21/−5
- src/library/Hasql/TH.hs +16/−19
- src/library/Hasql/TH/Construction/Exp.hs +28/−38
- src/library/Hasql/TH/Extraction/Exp.hs +10/−10
- src/library/Hasql/TH/Prelude.hs +2/−1
hasql-th.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: hasql-th-version: 0.4.1.1+version: 0.5 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,7 +96,6 @@ 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,
src/library/Hasql/TH.hs view
@@ -93,19 +93,16 @@ 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)@@ -118,18 +115,18 @@ 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 <- first fromString $ Parsing.run (Parsing.atEnd Parsing.preparableStmt) input+ parser ast -- * Statement @@ -242,33 +239,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/Exp.hs view
@@ -12,20 +12,20 @@ import qualified PostgresqlSyntax.Rendering as Rendering 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 . Rendering.toText . Rendering.preparableStmt) 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 . Rendering.toText . Rendering.preparableStmt) 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
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