diff --git a/hasql-dynamic-statements.cabal b/hasql-dynamic-statements.cabal --- a/hasql-dynamic-statements.cabal +++ b/hasql-dynamic-statements.cabal @@ -1,57 +1,117 @@ -name: hasql-dynamic-statements -version: 0.3.1.2 -synopsis: Toolkit for constructing Hasql statements dynamically +name: hasql-dynamic-statements +version: 0.3.1.3 +synopsis: Toolkit for constructing Hasql statements dynamically description: This library introduces into the Hasql ecosystem a new abstraction named Snippet, which makes it trivial to construct SQL, while injecting values. It is intended to be used when the SQL of your statement depends on the parameters, that you want to pass in. -homepage: https://github.com/nikita-volkov/hasql-dynamic-statements -bug-reports: https://github.com/nikita-volkov/hasql-dynamic-statements/issues -author: Nikita Volkov -maintainer: Nikita Volkov -copyright: (c) 2019, Nikita Volkov -license: MIT -license-file: LICENSE -build-type: Simple + +homepage: https://github.com/nikita-volkov/hasql-dynamic-statements +bug-reports: + https://github.com/nikita-volkov/hasql-dynamic-statements/issues + +author: Nikita Volkov +maintainer: Nikita Volkov +copyright: (c) 2019, Nikita Volkov +license: MIT +license-file: LICENSE +build-type: Simple cabal-version: >=1.10 source-repository head - type: git + type: git location: git://github.com/nikita-volkov/hasql-dynamic-statements.git library - hs-source-dirs: library - default-extensions: BangPatterns, DeriveDataTypeable, DeriveGeneric, DeriveFunctor, DeriveTraversable, GeneralizedNewtypeDeriving, FlexibleContexts, FlexibleInstances, LambdaCase, NoImplicitPrelude, OverloadedStrings, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeFamilies - ghc-options: -funbox-strict-fields - default-language: Haskell2010 + hs-source-dirs: library + default-extensions: + NoImplicitPrelude + BangPatterns + DeriveDataTypeable + DeriveFunctor + DeriveGeneric + DeriveTraversable + FlexibleContexts + FlexibleInstances + GeneralizedNewtypeDeriving + LambdaCase + OverloadedStrings + RankNTypes + ScopedTypeVariables + StandaloneDeriving + TypeApplications + TypeFamilies + + ghc-options: -funbox-strict-fields + default-language: Haskell2010 exposed-modules: Hasql.DynamicStatements.Session Hasql.DynamicStatements.Snippet Hasql.DynamicStatements.Statement + other-modules: Hasql.DynamicStatements.Prelude Hasql.DynamicStatements.Snippet.Defs + build-depends: - base >=4.12 && <5, - bytestring >=0.10 && <0.12, - containers >=0.6 && <0.7, - hasql >=1.6 && <1.7, - hasql-implicits >=0.1 && <0.2, - ptr >=0.16.7.2 && <0.17 + base >=4.12 && <5 + , bytestring >=0.10 && <0.13 + , containers >=0.6 && <0.7 + , hasql >=1.6 && <1.7 + , hasql-implicits >=0.1.1.2 && <0.2 + , ptr >=0.16.7.2 && <0.17 test-suite test - type: exitcode-stdio-1.0 - hs-source-dirs: test - main-is: Main.hs - default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeApplications, TypeFamilies, TypeOperators, UnboxedTuples - default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + default-extensions: + NoImplicitPrelude + NoMonomorphismRestriction + Arrows + BangPatterns + ConstraintKinds + DataKinds + DefaultSignatures + DeriveDataTypeable + DeriveFoldable + DeriveFunctor + DeriveGeneric + DeriveTraversable + EmptyDataDecls + FlexibleContexts + FlexibleInstances + FunctionalDependencies + GADTs + GeneralizedNewtypeDeriving + LambdaCase + LiberalTypeSynonyms + MagicHash + MultiParamTypeClasses + MultiWayIf + OverloadedStrings + ParallelListComp + PatternGuards + QuasiQuotes + RankNTypes + RecordWildCards + ScopedTypeVariables + StandaloneDeriving + TemplateHaskell + TupleSections + TypeApplications + TypeFamilies + TypeOperators + UnboxedTuples + + default-language: Haskell2010 build-depends: - hasql, - hasql-dynamic-statements, - QuickCheck >=2.8.1 && <3, - quickcheck-instances >=0.3.11 && <0.4, - rerebase <2, - tasty >=0.12 && <2, - tasty-hunit >=0.9 && <0.11, - tasty-quickcheck >=0.9 && <0.11 + hasql + , hasql-dynamic-statements + , QuickCheck >=2.8.1 && <3 + , quickcheck-instances >=0.3.11 && <0.4 + , rerebase <2 + , tasty >=0.12 && <2 + , tasty-hunit >=0.9 && <0.11 + , tasty-quickcheck >=0.9 && <0.11 diff --git a/library/Hasql/DynamicStatements/Prelude.hs b/library/Hasql/DynamicStatements/Prelude.hs --- a/library/Hasql/DynamicStatements/Prelude.hs +++ b/library/Hasql/DynamicStatements/Prelude.hs @@ -1,24 +1,21 @@ module Hasql.DynamicStatements.Prelude -( - module Exports, -) + ( module Exports, + ) where - --- base -------------------------- import Control.Applicative as Exports import Control.Arrow as Exports import Control.Category as Exports import Control.Concurrent as Exports import Control.Exception as Exports -import Control.Monad as Exports hiding (fail, mapM_, sequence_, forM_, msum, mapM, sequence, forM) -import Control.Monad.IO.Class as Exports +import Control.Monad as Exports hiding (fail, forM, forM_, mapM, mapM_, msum, sequence, sequence_) import Control.Monad.Fail as Exports import Control.Monad.Fix as Exports hiding (fix) +import Control.Monad.IO.Class as Exports import Control.Monad.ST 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 @@ -28,20 +25,21 @@ import Data.Fixed as Exports import Data.Foldable as Exports hiding (toList) import Data.Function as Exports hiding (id, (.)) -import Data.Functor as Exports +import Data.Functor as Exports hiding (unzip) import Data.Functor.Contravariant as Exports import Data.Functor.Identity as Exports -import Data.Int as Exports import Data.IORef as Exports +import Data.Int as Exports import Data.Ix as Exports -import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl') +import Data.List as Exports hiding (all, and, any, concat, concatMap, elem, find, foldl, foldl', foldl1, foldr, foldr1, isSubsequenceOf, mapAccumL, mapAccumR, maximum, maximumBy, minimum, minimumBy, notElem, or, product, sortOn, sum, uncons) import Data.Maybe as Exports -import Data.Monoid as Exports hiding (Last(..), First(..), (<>)) +import Data.Monoid as Exports hiding (First (..), Last (..), (<>)) import Data.Ord as Exports import Data.Proxy as Exports import Data.Ratio as Exports -import Data.Semigroup as Exports import Data.STRef as Exports +import Data.Semigroup as Exports +import Data.Sequence as Exports (Seq) import Data.String as Exports import Data.Traversable as Exports import Data.Tuple as Exports @@ -52,13 +50,12 @@ import Foreign.ForeignPtr as Exports import Foreign.Ptr as Exports import Foreign.StablePtr as Exports -import Foreign.Storable as Exports hiding (sizeOf, alignment) -import GHC.Conc as Exports hiding (withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead) -import GHC.Exts as Exports (lazy, inline, sortWith, groupWith, IsList(..)) +import Foreign.Storable as Exports hiding (alignment, sizeOf) +import GHC.Conc as Exports hiding (threadWaitRead, threadWaitReadSTM, threadWaitWrite, threadWaitWriteSTM, withMVar) +import GHC.Exts as Exports (IsList (..), groupWith, inline, lazy, sortWith) import GHC.Generics as Exports (Generic, Generic1) import GHC.IO.Exception as Exports import Numeric as Exports -import Prelude as Exports hiding (fail, concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.)) import System.Environment as Exports import System.Exit as Exports import System.IO as Exports @@ -68,15 +65,8 @@ import System.Mem.StableName as Exports import System.Timeout as Exports import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S, readS_to_P) -import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec) -import Text.Printf as Exports (printf, hPrintf) -import Text.Read as Exports (Read(..), readMaybe, readEither) +import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readP_to_Prec, readPrec_to_P, readPrec_to_S, readS_to_Prec) +import Text.Printf as Exports (hPrintf, printf) +import Text.Read as Exports (Read (..), readEither, readMaybe) import Unsafe.Coerce as Exports - --- containers -------------------------- -import Data.Sequence as Exports (Seq) - --- bytestring -------------------------- -import Data.ByteString as Exports (ByteString) +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, (.)) diff --git a/library/Hasql/DynamicStatements/Session.hs b/library/Hasql/DynamicStatements/Session.hs --- a/library/Hasql/DynamicStatements/Session.hs +++ b/library/Hasql/DynamicStatements/Session.hs @@ -1,20 +1,19 @@ module Hasql.DynamicStatements.Session where +import qualified Hasql.Decoders as Decoders import Hasql.DynamicStatements.Prelude -import Hasql.Session import qualified Hasql.DynamicStatements.Snippet.Defs as SnippetDefs import qualified Hasql.DynamicStatements.Statement as Statement -import qualified Hasql.Decoders as Decoders +import Hasql.Session import qualified Hasql.Session as Session -{-| -Execute a dynamically parameterized statement, providing a result decoder. - -This is merely a shortcut, which immediately embeds -@Hasql.DynamicStatements.Statement.'Statement.dynamicallyParameterized'@ -in @Session@. -For details see the docs on that function. --} +-- | +-- Execute a dynamically parameterized statement, providing a result decoder. +-- +-- This is merely a shortcut, which immediately embeds +-- @Hasql.DynamicStatements.Statement.'Statement.dynamicallyParameterized'@ +-- in @Session@. +-- For details see the docs on that function. dynamicallyParameterizedStatement :: SnippetDefs.Snippet -> Decoders.Result result -> Bool -> Session result dynamicallyParameterizedStatement snippet decoder prepared = Session.statement () (Statement.dynamicallyParameterized snippet decoder prepared) diff --git a/library/Hasql/DynamicStatements/Snippet.hs b/library/Hasql/DynamicStatements/Snippet.hs --- a/library/Hasql/DynamicStatements/Snippet.hs +++ b/library/Hasql/DynamicStatements/Snippet.hs @@ -1,10 +1,9 @@ module Hasql.DynamicStatements.Snippet -( - Snippet, - param, - encoderAndParam, - sql, -) + ( Snippet, + param, + encoderAndParam, + sql, + ) where import Hasql.DynamicStatements.Snippet.Defs diff --git a/library/Hasql/DynamicStatements/Snippet/Defs.hs b/library/Hasql/DynamicStatements/Snippet/Defs.hs --- a/library/Hasql/DynamicStatements/Snippet/Defs.hs +++ b/library/Hasql/DynamicStatements/Snippet/Defs.hs @@ -4,56 +4,52 @@ import qualified Hasql.Encoders as Encoders import qualified Hasql.Implicits.Encoders as Encoders - -{-| -Composable SQL snippet with parameters injected. -Abstracts over placeholders and matching of encoders. - -It has an instance of `IsString`, so having the @OverloadedStrings@ extension enabled -you can construct it directly from string literals. - -Here's an example: - -@ -selectSubstring :: Text -> Maybe Int32 -> Maybe Int32 -> 'Snippet' -selectSubstring string from to = - "select substring(" <> 'param' string <> - 'foldMap' (\\ x -> " from " <> 'param' x) from <> - 'foldMap' (\\ x -> " for " <> 'param' x) to <> - ")" -@ - -Having a decoder you can lift it into 'Hasql.Statement.Statement' using -'Hasql.DynamicStatements.Statement.dynamicallyParameterized' or directly execute it in -'Hasql.Session.Session' using -'Hasql.DynamicStatements.Session.dynamicallyParameterizedStatement'. --} +-- | +-- Composable SQL snippet with parameters injected. +-- Abstracts over placeholders and matching of encoders. +-- +-- It has an instance of `IsString`, so having the @OverloadedStrings@ extension enabled +-- you can construct it directly from string literals. +-- +-- Here's an example: +-- +-- @ +-- selectSubstring :: Text -> Maybe Int32 -> Maybe Int32 -> 'Snippet' +-- selectSubstring string from to = +-- "select substring(" <> 'param' string <> +-- 'foldMap' (\\ x -> " from " <> 'param' x) from <> +-- 'foldMap' (\\ x -> " for " <> 'param' x) to <> +-- ")" +-- @ +-- +-- Having a decoder you can lift it into 'Hasql.Statement.Statement' using +-- 'Hasql.DynamicStatements.Statement.dynamicallyParameterized' or directly execute it in +-- 'Hasql.Session.Session' using +-- 'Hasql.DynamicStatements.Session.dynamicallyParameterizedStatement'. newtype Snippet = Snippet (Seq SnippetChunk) -data SnippetChunk = - StringSnippetChunk ByteString | - ParamSnippetChunk (Encoders.Params ()) +data SnippetChunk + = StringSnippetChunk ByteString + | ParamSnippetChunk (Encoders.Params ()) deriving instance Semigroup Snippet + deriving instance Monoid Snippet instance IsString Snippet where fromString x = Snippet (pure (StringSnippetChunk (fromString x))) -{-| -SQL chunk in ASCII. --} +-- | +-- SQL chunk in ASCII. sql :: ByteString -> Snippet sql x = Snippet (pure (StringSnippetChunk x)) -{-| -Parameter encoded using an implicitly derived encoder from the type. --} -param :: Encoders.DefaultParamEncoder param => param -> Snippet +-- | +-- Parameter encoded using an implicitly derived encoder from the type. +param :: (Encoders.DefaultParamEncoder param) => param -> Snippet param = encoderAndParam Encoders.defaultParam -{-| -Parameter with an explicitly defined encoder. --} +-- | +-- Parameter with an explicitly defined encoder. encoderAndParam :: Encoders.NullableOrNot Encoders.Value param -> param -> Snippet encoderAndParam encoder param = Snippet (pure (ParamSnippetChunk (param >$ Encoders.param encoder))) diff --git a/library/Hasql/DynamicStatements/Statement.hs b/library/Hasql/DynamicStatements/Statement.hs --- a/library/Hasql/DynamicStatements/Statement.hs +++ b/library/Hasql/DynamicStatements/Statement.hs @@ -1,66 +1,64 @@ module Hasql.DynamicStatements.Statement where +import qualified Hasql.Decoders as Decoders import Hasql.DynamicStatements.Prelude -import Hasql.Statement import qualified Hasql.DynamicStatements.Snippet.Defs as SnippetDefs -import qualified Hasql.Decoders as Decoders import qualified Hasql.Encoders as Encoders -import qualified Ptr.Poking as Poking +import Hasql.Statement import qualified Ptr.ByteString as ByteString - - -{-| -Construct a statement dynamically, specifying the parameters in-place -in the declaration of snippet and providing a result decoder and -specifying whether the statement should be prepared. - -The injection of the parameters is handled automatically, -generating parametric statements with binary encoders under the hood. - -This is useful when the SQL of your statement depends on the parameters. -Here's an example: - -@ -selectSubstring :: Text -> Maybe Int32 -> Maybe Int32 -> 'Statement' () Text -selectSubstring string from to = let - snippet = - "select substring(" <> Snippet.'SnippetDefs.param' string <> - foldMap (mappend " from " . Snippet.'SnippetDefs.param') from <> - foldMap (mappend " for " . Snippet.'SnippetDefs.param') to <> - ")" - decoder = Decoders.'Decoders.singleRow' (Decoders.'Decoders.column' (Decoders.'Decoders.nonNullable' Decoders.'Decoders.text')) - in 'dynamicallyParameterized' snippet decoder True -@ - -Without the Snippet API you would have had to implement the same functionality thus: - -@ -selectSubstring' :: Text -> Maybe Int32 -> Maybe Int32 -> 'Statement' () Text -selectSubstring' string from to = let - sql = case (from, to) of - (Just _, Just _) -> "select substring($1 from $2 to $3)" - (Just _, Nothing) -> "select substring($1 from $2)" - (Nothing, Just _) -> "select substring($1 to $2)" - (Nothing, Nothing) -> "select substring($1)" - encoder = - Encoders.'Encoders.param' (string '>$' Encoders.'Encoders.text') <> - foldMap (\\ x -> Encoders.'Encoders.param' (x '>$' Encoders.'Encoders.int8')) from <> - foldMap (\\ x -> Encoders.'Encoders.param' (x '>$' Encoders.'Encoders.int8')) to - decoder = Decoders.'Decoders.singleRow' (Decoders.'Decoders.column' Decoders.'Decoders.text') - in Statement sql encoder decoder True -@ +import qualified Ptr.Poking as Poking -As you can see, the Snippet API abstracts over placeholders and -matching encoder generation, thus also protecting you from all sorts of related bugs. --} +-- | +-- Construct a statement dynamically, specifying the parameters in-place +-- in the declaration of snippet and providing a result decoder and +-- specifying whether the statement should be prepared. +-- +-- The injection of the parameters is handled automatically, +-- generating parametric statements with binary encoders under the hood. +-- +-- This is useful when the SQL of your statement depends on the parameters. +-- Here's an example: +-- +-- @ +-- selectSubstring :: Text -> Maybe Int32 -> Maybe Int32 -> 'Statement' () Text +-- selectSubstring string from to = let +-- snippet = +-- "select substring(" <> Snippet.'SnippetDefs.param' string <> +-- foldMap (mappend " from " . Snippet.'SnippetDefs.param') from <> +-- foldMap (mappend " for " . Snippet.'SnippetDefs.param') to <> +-- ")" +-- decoder = Decoders.'Decoders.singleRow' (Decoders.'Decoders.column' (Decoders.'Decoders.nonNullable' Decoders.'Decoders.text')) +-- in 'dynamicallyParameterized' snippet decoder True +-- @ +-- +-- Without the Snippet API you would have had to implement the same functionality thus: +-- +-- @ +-- selectSubstring' :: Text -> Maybe Int32 -> Maybe Int32 -> 'Statement' () Text +-- selectSubstring' string from to = let +-- sql = case (from, to) of +-- (Just _, Just _) -> "select substring($1 from $2 to $3)" +-- (Just _, Nothing) -> "select substring($1 from $2)" +-- (Nothing, Just _) -> "select substring($1 to $2)" +-- (Nothing, Nothing) -> "select substring($1)" +-- encoder = +-- Encoders.'Encoders.param' (string '>$' Encoders.'Encoders.text') <> +-- foldMap (\\ x -> Encoders.'Encoders.param' (x '>$' Encoders.'Encoders.int8')) from <> +-- foldMap (\\ x -> Encoders.'Encoders.param' (x '>$' Encoders.'Encoders.int8')) to +-- decoder = Decoders.'Decoders.singleRow' (Decoders.'Decoders.column' Decoders.'Decoders.text') +-- in Statement sql encoder decoder True +-- @ +-- +-- As you can see, the Snippet API abstracts over placeholders and +-- matching encoder generation, thus also protecting you from all sorts of related bugs. dynamicallyParameterized :: SnippetDefs.Snippet -> Decoders.Result result -> Bool -> Statement () result -dynamicallyParameterized (SnippetDefs.Snippet chunks) decoder prepared = let - step (!paramId, !poking, !encoder) = \ case - SnippetDefs.StringSnippetChunk sql -> (paramId, poking <> Poking.bytes sql, encoder) - SnippetDefs.ParamSnippetChunk paramEncoder -> let - newParamId = paramId + 1 - newPoking = poking <> Poking.word8 36 <> Poking.asciiIntegral paramId - newEncoder = encoder <> paramEncoder - in (newParamId, newPoking, newEncoder) - in case foldl' step (1, mempty, mempty) chunks of - (_, poking, encoder) -> Statement (ByteString.poking poking) encoder decoder prepared +dynamicallyParameterized (SnippetDefs.Snippet chunks) decoder prepared = + let step (!paramId, !poking, !encoder) = \case + SnippetDefs.StringSnippetChunk sql -> (paramId, poking <> Poking.bytes sql, encoder) + SnippetDefs.ParamSnippetChunk paramEncoder -> + let newParamId = paramId + 1 + newPoking = poking <> Poking.word8 36 <> Poking.asciiIntegral paramId + newEncoder = encoder <> paramEncoder + in (newParamId, newPoking, newEncoder) + in case foldl' step (1, mempty, mempty) chunks of + (_, poking, encoder) -> Statement (ByteString.poking poking) encoder decoder prepared diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,58 +1,58 @@ module Main where -import Prelude hiding (assert) +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Char8 as ByteStringChar8 +import qualified Hasql.Connection as Connection +import qualified Hasql.Decoders as Decoders +import qualified Hasql.DynamicStatements.Session as Session +import qualified Hasql.DynamicStatements.Snippet as Snippet +import qualified Hasql.DynamicStatements.Statement as Statement +import qualified Hasql.Encoders as Encoders +import qualified Hasql.Session as Session +import qualified Hasql.Statement as Statement +import qualified Test.QuickCheck as QuickCheck import Test.QuickCheck.Instances import Test.Tasty -import Test.Tasty.Runners import Test.Tasty.HUnit import Test.Tasty.QuickCheck -import qualified Test.QuickCheck as QuickCheck -import qualified Hasql.Statement as Statement -import qualified Hasql.Encoders as Encoders -import qualified Hasql.Decoders as Decoders -import qualified Hasql.Session as Session -import qualified Hasql.Connection as Connection -import qualified Hasql.DynamicStatements.Snippet as Snippet -import qualified Hasql.DynamicStatements.Session as Session -import qualified Hasql.DynamicStatements.Statement as Statement -import qualified Data.ByteString as ByteString -import qualified Data.ByteString.Char8 as ByteStringChar8 - +import Test.Tasty.Runners +import Prelude hiding (assert) main = defaultMain tree tree = - testGroup "All tests" - [ - testCase "Select substring" $ let - sample string from to = let - snippet = - "select substring(" <> Snippet.param @Text string <> - foldMap (mappend " from " . Snippet.param @Int32) from <> - foldMap (mappend " for " . Snippet.param @Int32) to <> - ")" - decoder = Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.text)) - in runSession (Session.dynamicallyParameterizedStatement snippet decoder True) - in do - assertEqual "" (Right (Right "bc")) =<< sample "abcd" (Just 2) (Just 2) - assertEqual "" (Right (Right "bcd")) =<< sample "abcd" (Just 2) (Just 3) - assertEqual "" (Right (Right "abc")) =<< sample "abcd" Nothing (Just 3) - assertEqual "" (Right (Right "bcd")) =<< sample "abcd" (Just 2) Nothing - , - testGroup "Regression" [ - testCase "Missing $ for 1000th parameter string #2" $ let - snippet = - "SELECT 1 " <> (foldMap @[] ("," <>) $ replicate 1001 $ Snippet.param (10::Int64)) - statement = - Statement.dynamicallyParameterized snippet Decoders.noResult True - sql = - case statement of - Statement.Statement x _ _ _ -> x - in do - assertBool (ByteStringChar8.unpack sql) (ByteString.isInfixOf "$1000" sql) - ] - ] + testGroup + "All tests" + [ testCase "Select substring" + $ let sample string from to = + let snippet = + "select substring(" + <> Snippet.param @Text string + <> foldMap (mappend " from " . Snippet.param @Int32) from + <> foldMap (mappend " for " . Snippet.param @Int32) to + <> ")" + decoder = Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.text)) + in runSession (Session.dynamicallyParameterizedStatement snippet decoder True) + in do + assertEqual "" (Right (Right "bc")) =<< sample "abcd" (Just 2) (Just 2) + assertEqual "" (Right (Right "bcd")) =<< sample "abcd" (Just 2) (Just 3) + assertEqual "" (Right (Right "abc")) =<< sample "abcd" Nothing (Just 3) + assertEqual "" (Right (Right "bcd")) =<< sample "abcd" (Just 2) Nothing, + testGroup + "Regression" + [ testCase "Missing $ for 1000th parameter string #2" + $ let snippet = + "SELECT 1 " <> (foldMap @[] ("," <>) $ replicate 1001 $ Snippet.param (10 :: Int64)) + statement = + Statement.dynamicallyParameterized snippet Decoders.noResult True + sql = + case statement of + Statement.Statement x _ _ _ -> x + in do + assertBool (ByteStringChar8.unpack sql) (ByteString.isInfixOf "$1000" sql) + ] + ] runSession :: Session.Session a -> IO (Either Connection.ConnectionError (Either Session.QueryError a)) runSession = withConnection . Session.run @@ -70,7 +70,7 @@ host = "localhost" port = 5432 user = "postgres" - password = "" + password = "postgres" database = "postgres" use connection = lift $ handler connection