haskell/esqueleto
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Update ERaw to change the direction of NeedParens (parent now tells child context). Removed need for composite key constructor

Browse Source
This commit is contained in:
belevy 2021-01-17 14:47:32 -06:00
parent 1ba08abfb3
commit 89bd673c62
5 changed files with 236 additions and 247 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/Database/Esqueleto/Experimental/ToAliasReference.hs
View File

@ -5,7 +5,8 @@ module Database.Esqueleto.Experimental.ToAliasReference
where where
import Database.Esqueleto.Experimental.ToAlias import Database.Esqueleto.Experimental.ToAlias
import Database.Esqueleto.Internal.Internal hiding (From, from, on) import Database.Esqueleto.Internal.Internal hiding (From,
from, on)
import Database.Esqueleto.Internal.PersistentImport import Database.Esqueleto.Internal.PersistentImport
{-# DEPRECATED ToAliasReferenceT "This type alias doesn't do anything. Please delete it. Will be removed in the next release." #-} {-# DEPRECATED ToAliasReferenceT "This type alias doesn't do anything. Please delete it. Will be removed in the next release." #-}
@ -18,7 +19,6 @@ class ToAliasReference a where
instance ToAliasReference (SqlExpr (Value a)) where instance ToAliasReference (SqlExpr (Value a)) where
toAliasReference aliasSource (EAliasedValue aliasIdent _) = pure $ EValueReference aliasSource (\_ -> aliasIdent) toAliasReference aliasSource (EAliasedValue aliasIdent _) = pure $ EValueReference aliasSource (\_ -> aliasIdent)
toAliasReference _ v@(ERaw _ _) = toAlias v toAliasReference _ v@(ERaw _ _) = toAlias v
toAliasReference _ v@(ECompositeKey _) = toAlias v
toAliasReference s (EValueReference _ b) = pure $ EValueReference s b toAliasReference s (EValueReference _ b) = pure $ EValueReference s b
instance ToAliasReference (SqlExpr (Entity a)) where instance ToAliasReference (SqlExpr (Entity a)) where

252
src/Database/Esqueleto/Internal/Internal.hs
View File

@ -540,15 +540,17 @@ subSelectUnsafe = sub SELECT
e ^. field e ^. field
| isIdField field = idFieldValue | isIdField field = idFieldValue
| otherwise = ERaw Never $ \info -> (dot info $ persistFieldDef field, []) | otherwise = ERaw noMeta $ \_ info -> (dot info $ persistFieldDef field, [])
where where
idFieldValue = idFieldValue =
case entityKeyFields ed of case entityKeyFields ed of
idField:[] -> idField:[] ->
ERaw Never $ \info -> (dot info idField, []) ERaw noMeta $ \_ info -> (dot info idField, [])
idFields -> idFields ->
ECompositeKey $ \info -> dot info <$> idFields let renderedFields info = dot info <$> idFields
in ERaw noMeta{ sqlExprMetaCompositeFields = Just renderedFields} $
\p info -> (parensM p $ uncommas $ dot info <$> idFields, [])
ed = entityDef $ getEntityVal (Proxy :: Proxy (SqlExpr (Entity val))) ed = entityDef $ getEntityVal (Proxy :: Proxy (SqlExpr (Entity val)))
@ -598,7 +600,7 @@ EMaybe r ?. field = just (r ^. field)
-- | Lift a constant value from Haskell-land to the query. -- | Lift a constant value from Haskell-land to the query.
val :: PersistField typ => typ -> SqlExpr (Value typ) val :: PersistField typ => typ -> SqlExpr (Value typ)
val v = ERaw Never $ const ("?", [toPersistValue v]) val v = ERaw noMeta $ \_ _ -> ("?", [toPersistValue v])
-- | @IS NULL@ comparison. -- | @IS NULL@ comparison.
-- --
@ -624,27 +626,28 @@ val v = ERaw Never $ const ("?", [toPersistValue v])
isNothing :: PersistField typ => SqlExpr (Value (Maybe typ)) -> SqlExpr (Value Bool) isNothing :: PersistField typ => SqlExpr (Value (Maybe typ)) -> SqlExpr (Value Bool)
isNothing v = isNothing v =
case v of case v of
ERaw p f -> ERaw m f ->
isNullExpr $ first (parensM p) . f case sqlExprMetaCompositeFields m of
Just fields ->
ERaw noMeta $ \p info ->
first (parensM p) . flip (,) [] . (intersperseB " AND " . map (<> " IS NULL")) $ fields info
Nothing ->
ERaw noMeta $ \p info ->
first (parensM p) . isNullExpr $ f Never info
EAliasedValue i _ -> EAliasedValue i _ ->
isNullExpr $ aliasedValueIdentToRawSql i ERaw noMeta $ \p info ->
first (parensM p) . isNullExpr $ aliasedValueIdentToRawSql i info
EValueReference i i' -> EValueReference i i' ->
isNullExpr $ valueReferenceToRawSql i i' ERaw noMeta $ \p info ->
ECompositeKey f -> first (parensM p) . isNullExpr $ valueReferenceToRawSql i i' info
ERaw Parens $ flip (,) [] . (intersperseB " AND " . map (<> " IS NULL")) . f
where where
isNullExpr :: (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Value Bool) isNullExpr = first ((<> " IS NULL"))
isNullExpr g = ERaw Parens $ first ((<> " IS NULL")) . g
-- | Analogous to 'Just', promotes a value of type @typ@ into -- | Analogous to 'Just', promotes a value of type @typ@ into
-- one of type @Maybe typ@. It should hold that @'val' . Just -- one of type @Maybe typ@. It should hold that @'val' . Just
-- === just . 'val'@. -- === just . 'val'@.
just :: SqlExpr (Value typ) -> SqlExpr (Value (Maybe typ)) just :: SqlExpr (Value typ) -> SqlExpr (Value (Maybe typ))
just exprVal = case exprVal of just = veryUnsafeCoerceSqlExprValue
ERaw p f -> ERaw p f
ECompositeKey f -> ECompositeKey f
EAliasedValue i v -> EAliasedValue i (just v)
EValueReference i i' -> EValueReference i i'
-- | @NULL@ value. -- | @NULL@ value.
nothing :: SqlExpr (Value (Maybe typ)) nothing :: SqlExpr (Value (Maybe typ))
@ -653,23 +656,22 @@ nothing = unsafeSqlValue "NULL"
-- | Join nested 'Maybe's in a 'Value' into one. This is useful when -- | Join nested 'Maybe's in a 'Value' into one. This is useful when
-- calling aggregate functions on nullable fields. -- calling aggregate functions on nullable fields.
joinV :: SqlExpr (Value (Maybe (Maybe typ))) -> SqlExpr (Value (Maybe typ)) joinV :: SqlExpr (Value (Maybe (Maybe typ))) -> SqlExpr (Value (Maybe typ))
joinV exprMM = case exprMM of joinV = veryUnsafeCoerceSqlExprValue
ERaw p f -> ERaw p f
ECompositeKey f -> ECompositeKey f
EAliasedValue i v -> EAliasedValue i (joinV v)
EValueReference i i' -> EValueReference i i'
countHelper :: Num a => TLB.Builder -> TLB.Builder -> SqlExpr (Value typ) -> SqlExpr (Value a) countHelper :: Num a => TLB.Builder -> TLB.Builder -> SqlExpr (Value typ) -> SqlExpr (Value a)
countHelper open close v = countHelper open close v =
case v of case v of
ERaw _ f -> countRawSql f ERaw meta f ->
if hasCompositeKeyMeta meta then
countRows
else
countRawSql (f Never)
EAliasedValue i _ -> countRawSql $ aliasedValueIdentToRawSql i EAliasedValue i _ -> countRawSql $ aliasedValueIdentToRawSql i
EValueReference i i' -> countRawSql $ valueReferenceToRawSql i i' EValueReference i i' -> countRawSql $ valueReferenceToRawSql i i'
ECompositeKey _ -> countRows
where where
countRawSql :: (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Value a) countRawSql :: (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Value a)
countRawSql x = ERaw Never $ first (\b -> "COUNT" <> open <> parens b <> close) . x countRawSql x = ERaw noMeta $ \_ -> first (\b -> "COUNT" <> open <> parens b <> close) . x
-- | @COUNT(*)@ value. -- | @COUNT(*)@ value.
countRows :: Num a => SqlExpr (Value a) countRows :: Num a => SqlExpr (Value a)
@ -686,15 +688,16 @@ countDistinct :: Num a => SqlExpr (Value typ) -> SqlExpr (Value a)
countDistinct = countHelper "(DISTINCT " ")" countDistinct = countHelper "(DISTINCT " ")"
not_ :: SqlExpr (Value Bool) -> SqlExpr (Value Bool) not_ :: SqlExpr (Value Bool) -> SqlExpr (Value Bool)
not_ v = ERaw Never (\info -> first ("NOT " <>) $ x info) not_ v = ERaw noMeta $ \p info -> first ("NOT " <>) $ x p info
where where
x info = x p info =
case v of case v of
ERaw p f -> ERaw m f ->
let (b, vals) = f info if hasCompositeKeyMeta m then
in (parensM p b, vals)
ECompositeKey _ ->
throw (CompositeKeyErr NotError) throw (CompositeKeyErr NotError)
else
let (b, vals) = f Never info
in (parensM p b, vals)
EAliasedValue i _ -> EAliasedValue i _ ->
aliasedValueIdentToRawSql i info aliasedValueIdentToRawSql i info
EValueReference i i' -> EValueReference i i' ->
@ -900,8 +903,7 @@ subList_select = EList . sub_select
-- | Lift a list of constant value from Haskell-land to the query. -- | Lift a list of constant value from Haskell-land to the query.
valList :: PersistField typ => [typ] -> SqlExpr (ValueList typ) valList :: PersistField typ => [typ] -> SqlExpr (ValueList typ)
valList [] = EEmptyList valList [] = EEmptyList
valList vals = EList $ ERaw Parens $ const ( uncommas ("?" <$ vals) valList vals = EList $ ERaw noMeta $ \p -> const (parensM p (uncommas ("?" <$ vals)), map toPersistValue vals )
, map toPersistValue vals )
-- | Same as 'just' but for 'ValueList'. Most of the time you -- | Same as 'just' but for 'ValueList'. Most of the time you
-- won't need it, though, because you can use 'just' from -- won't need it, though, because you can use 'just' from
@ -949,11 +951,17 @@ v `notIn` e = ifNotEmptyList e True $ unsafeSqlBinOp " NOT IN " v (veryUnsafeCo
-- return person -- return person
-- @ -- @
exists :: SqlQuery () -> SqlExpr (Value Bool) exists :: SqlQuery () -> SqlExpr (Value Bool)
exists = unsafeSqlFunction "EXISTS " . existsHelper exists q = ERaw noMeta $ \p info ->
let ERaw _ f = existsHelper q
(b, vals) = f Never info
in ( parensM p $ "EXISTS " <> b, vals)
-- | @NOT EXISTS@ operator. -- | @NOT EXISTS@ operator.
notExists :: SqlQuery () -> SqlExpr (Value Bool) notExists :: SqlQuery () -> SqlExpr (Value Bool)
notExists = unsafeSqlFunction "NOT EXISTS " . existsHelper notExists q = ERaw noMeta $ \p info ->
let ERaw _ f = existsHelper q
(b, vals) = f Never info
in ( parensM p $ "NOT EXISTS " <> b, vals)
-- | @SET@ clause used on @UPDATE@s. Note that while it's not -- | @SET@ clause used on @UPDATE@s. Note that while it's not
-- a type error to use this function on a @SELECT@, it will -- a type error to use this function on a @SELECT@, it will
@ -980,8 +988,7 @@ field /=. expr = setAux field (\ent -> ent ^. field /. expr)
-- | Apply a 'PersistField' constructor to @SqlExpr Value@ arguments. -- | Apply a 'PersistField' constructor to @SqlExpr Value@ arguments.
(<#) :: (a -> b) -> SqlExpr (Value a) -> SqlExpr (Insertion b) (<#) :: (a -> b) -> SqlExpr (Value a) -> SqlExpr (Insertion b)
(<#) _ (ERaw _ f) = EInsert Proxy f (<#) _ (ERaw _ f) = EInsert Proxy (f Never)
(<#) _ (ECompositeKey _) = throw (CompositeKeyErr ToInsertionError)
(<#) _ (EAliasedValue i _) = EInsert Proxy $ aliasedValueIdentToRawSql i (<#) _ (EAliasedValue i _) = EInsert Proxy $ aliasedValueIdentToRawSql i
(<#) _ (EValueReference i i') = EInsert Proxy $ valueReferenceToRawSql i i' (<#) _ (EValueReference i i') = EInsert Proxy $ valueReferenceToRawSql i i'
@ -997,10 +1004,9 @@ field /=. expr = setAux field (\ent -> ent ^. field /. expr)
where where
g = g =
case v of case v of
ERaw _ f' -> f' ERaw _ f' -> f' Never
EAliasedValue i _ -> aliasedValueIdentToRawSql i EAliasedValue i _ -> aliasedValueIdentToRawSql i
EValueReference i i' -> valueReferenceToRawSql i i' EValueReference i i' -> valueReferenceToRawSql i i'
ECompositeKey _ -> throw (CompositeKeyErr CombineInsertionError)
-- | @CASE@ statement. For example: -- | @CASE@ statement. For example:
-- --
@ -1295,8 +1301,7 @@ renderUpdates
renderUpdates conn = uncommas' . concatMap renderUpdate renderUpdates conn = uncommas' . concatMap renderUpdate
where where
mk :: SqlExpr (Value ()) -> [(TLB.Builder, [PersistValue])] mk :: SqlExpr (Value ()) -> [(TLB.Builder, [PersistValue])]
mk (ERaw _ f) = [f info] mk (ERaw _ f) = [f Never info]
mk (ECompositeKey _) = throw (CompositeKeyErr MakeSetError) -- FIXME
mk (EAliasedValue i _) = [aliasedValueIdentToRawSql i info] mk (EAliasedValue i _) = [aliasedValueIdentToRawSql i info]
mk (EValueReference i i') = [valueReferenceToRawSql i i' info] mk (EValueReference i i') = [valueReferenceToRawSql i i' info]
@ -2013,6 +2018,18 @@ type IdentInfo = (SqlBackend, IdentState)
useIdent :: IdentInfo -> Ident -> TLB.Builder useIdent :: IdentInfo -> Ident -> TLB.Builder
useIdent info (I ident) = fromDBName info $ DBName ident useIdent info (I ident) = fromDBName info $ DBName ident
data SqlExprMeta = SqlExprMeta
{ sqlExprMetaCompositeFields :: Maybe (IdentInfo -> [TLB.Builder])
}
noMeta :: SqlExprMeta
noMeta = SqlExprMeta
{ sqlExprMetaCompositeFields = Nothing
}
hasCompositeKeyMeta :: SqlExprMeta -> Bool
hasCompositeKeyMeta = Maybe.isJust . sqlExprMetaCompositeFields
-- | An expression on the SQL backend. -- | An expression on the SQL backend.
-- --
-- There are many comments describing the constructors of this -- There are many comments describing the constructors of this
@ -2033,7 +2050,7 @@ data SqlExpr a where
-- connection (mainly for escaping names) and returns both an -- connection (mainly for escaping names) and returns both an
-- string ('TLB.Builder') and a list of values to be -- string ('TLB.Builder') and a list of values to be
-- interpolated by the SQL backend. -- interpolated by the SQL backend.
ERaw :: NeedParens -> (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Value a) ERaw :: SqlExprMeta -> (NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Value a)
-- A raw expression with an alias -- A raw expression with an alias
@ -2082,7 +2099,6 @@ data SqlExpr a where
-- used in the context of a composite key. That's because it's -- used in the context of a composite key. That's because it's
-- impossible, e.g., for 'val' to disambiguate between these -- impossible, e.g., for 'val' to disambiguate between these
-- uses. -- uses.
ECompositeKey :: (IdentInfo -> [TLB.Builder]) -> SqlExpr (Value a)
-- 'EList' and 'EEmptyList' are used by list operators. -- 'EList' and 'EEmptyList' are used by list operators.
EList :: SqlExpr (Value a) -> SqlExpr (ValueList a) EList :: SqlExpr (Value a) -> SqlExpr (ValueList a)
@ -2134,10 +2150,10 @@ setAux
-> SqlExpr (Update val) -> SqlExpr (Update val)
setAux field mkVal = ESet $ \ent -> unsafeSqlBinOp " = " name (mkVal ent) setAux field mkVal = ESet $ \ent -> unsafeSqlBinOp " = " name (mkVal ent)
where where
name = ERaw Never $ \info -> (fieldName info field, mempty) name = ERaw noMeta $ \_ info -> (fieldName info field, mempty)
sub :: PersistField a => Mode -> SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a) sub :: PersistField a => Mode -> SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
sub mode query = ERaw Parens $ \info -> toRawSql mode info query sub mode query = ERaw noMeta $ \_ info -> first parens $ toRawSql mode info query
fromDBName :: IdentInfo -> DBName -> TLB.Builder fromDBName :: IdentInfo -> DBName -> TLB.Builder
fromDBName (conn, _) = TLB.fromText . connEscapeName conn fromDBName (conn, _) = TLB.fromText . connEscapeName conn
@ -2156,31 +2172,28 @@ ifNotEmptyList (EList _) _ x = x
-- --
-- Since: 2.1.1 -- Since: 2.1.1
unsafeSqlCase :: PersistField a => [(SqlExpr (Value Bool), SqlExpr (Value a))] -> SqlExpr (Value a) -> SqlExpr (Value a) unsafeSqlCase :: PersistField a => [(SqlExpr (Value Bool), SqlExpr (Value a))] -> SqlExpr (Value a) -> SqlExpr (Value a)
unsafeSqlCase when v = ERaw Never buildCase unsafeSqlCase when v = ERaw noMeta buildCase
where where
buildCase :: IdentInfo -> (TLB.Builder, [PersistValue]) buildCase :: NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue])
buildCase info = buildCase p info =
let (elseText, elseVals) = valueToSql v info let (elseText, elseVals) = valueToSql v Parens info
(whenText, whenVals) = mapWhen when info (whenText, whenVals) = mapWhen when Parens info
in ( "CASE" <> whenText <> " ELSE " <> elseText <> " END", whenVals <> elseVals) in ( "CASE" <> whenText <> " ELSE " <> elseText <> " END", whenVals <> elseVals)
mapWhen :: [(SqlExpr (Value Bool), SqlExpr (Value a))] -> IdentInfo -> (TLB.Builder, [PersistValue]) mapWhen :: [(SqlExpr (Value Bool), SqlExpr (Value a))] -> NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue])
mapWhen [] _ = throw (UnexpectedCaseErr UnsafeSqlCaseError) mapWhen [] _ _ = throw (UnexpectedCaseErr UnsafeSqlCaseError)
mapWhen when' info = foldl (foldHelp info) (mempty, mempty) when' mapWhen when' p info = foldl (foldHelp p info) (mempty, mempty) when'
foldHelp :: IdentInfo -> (TLB.Builder, [PersistValue]) -> (SqlExpr (Value Bool), SqlExpr (Value a)) -> (TLB.Builder, [PersistValue]) foldHelp :: NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue]) -> (SqlExpr (Value Bool), SqlExpr (Value a)) -> (TLB.Builder, [PersistValue])
foldHelp _ _ (ECompositeKey _, _) = throw (CompositeKeyErr FoldHelpError) foldHelp p info (b0, vals0) (v1, v2) =
foldHelp _ _ (_, ECompositeKey _) = throw (CompositeKeyErr FoldHelpError) let (b1, vals1) = valueToSql v1 p info
foldHelp info (b0, vals0) (v1, v2) = (b2, vals2) = valueToSql v2 p info
let (b1, vals1) = valueToSql v1 info
(b2, vals2) = valueToSql v2 info
in ( b0 <> " WHEN " <> b1 <> " THEN " <> b2, vals0 <> vals1 <> vals2 ) in ( b0 <> " WHEN " <> b1 <> " THEN " <> b2, vals0 <> vals1 <> vals2 )
valueToSql :: SqlExpr (Value a) -> IdentInfo -> (TLB.Builder, [PersistValue]) valueToSql :: SqlExpr (Value a) -> NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue])
valueToSql (ERaw p f) = (first (parensM p)) . f valueToSql (ERaw _ f) p = f p
valueToSql (ECompositeKey _) = throw (CompositeKeyErr SqlCaseError) valueToSql (EAliasedValue i _) _ = aliasedValueIdentToRawSql i
valueToSql (EAliasedValue i _) = aliasedValueIdentToRawSql i valueToSql (EValueReference i i') _ = valueReferenceToRawSql i i'
valueToSql (EValueReference i i') = valueReferenceToRawSql i i'
-- | (Internal) Create a custom binary operator. You /should/ -- | (Internal) Create a custom binary operator. You /should/
-- /not/ use this function directly since its type is very -- /not/ use this function directly since its type is very
@ -2195,32 +2208,35 @@ unsafeSqlCase when v = ERaw Never buildCase
-- In the example above, we constraint the arguments to be of the -- In the example above, we constraint the arguments to be of the
-- same type and constraint the result to be a boolean value. -- same type and constraint the result to be a boolean value.
unsafeSqlBinOp :: TLB.Builder -> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c) unsafeSqlBinOp :: TLB.Builder -> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp op (ERaw p1 f1) (ERaw p2 f2) = ERaw Parens f unsafeSqlBinOp op (ERaw m1 f1) (ERaw m2 f2)
| not (hasCompositeKeyMeta m1 || hasCompositeKeyMeta m2) = ERaw noMeta f
where where
f info = f p info =
let (b1, vals1) = f1 info let (b1, vals1) = f1 Parens info
(b2, vals2) = f2 info (b2, vals2) = f2 Parens info
in in
( parensM p1 b1 <> op <> parensM p2 b2 ( parensM p (b1 <> op <> b2)
, vals1 <> vals2 , vals1 <> vals2
) )
unsafeSqlBinOp op a b = unsafeSqlBinOp op (construct a) (construct b) unsafeSqlBinOp op a b = unsafeSqlBinOp op (construct a) (construct b)
where where
construct :: SqlExpr (Value a) -> SqlExpr (Value a) construct :: SqlExpr (Value a) -> SqlExpr (Value a)
construct (ERaw p f) = construct (ERaw m f) =
ERaw (if p == Never then Parens else Never) $ \info -> case sqlExprMetaCompositeFields m of
let (b1, vals) = f info Just fields ->
ERaw noMeta $ \_ info -> (parens $ uncommas $ fields info, mempty)
Nothing ->
ERaw noMeta $ \p info ->
let (b1, vals) = f (if p == Never then Parens else Never) info
build ("?", [PersistList vals']) = build ("?", [PersistList vals']) =
(uncommas $ replicate (length vals') "?", vals') (uncommas $ replicate (length vals') "?", vals')
build expr = expr build expr = expr
in in
build (parensM p b1, vals) first (parensM p) $ build (b1, vals)
construct (ECompositeKey f) =
ERaw Parens $ \info -> (uncommas $ f info, mempty)
construct (EAliasedValue i _) = construct (EAliasedValue i _) =
ERaw Never $ aliasedValueIdentToRawSql i ERaw noMeta $ const $ aliasedValueIdentToRawSql i
construct (EValueReference i i') = construct (EValueReference i i') =
ERaw Never $ valueReferenceToRawSql i i' ERaw noMeta $ const $ valueReferenceToRawSql i i'
{-# INLINE unsafeSqlBinOp #-} {-# INLINE unsafeSqlBinOp #-}
-- | Similar to 'unsafeSqlBinOp', but may also be applied to -- | Similar to 'unsafeSqlBinOp', but may also be applied to
@ -2248,18 +2264,19 @@ unsafeSqlBinOp op a b = unsafeSqlBinOp op (construct a) (construct b)
-- no placeholders and split it on the commas. -- no placeholders and split it on the commas.
unsafeSqlBinOpComposite :: TLB.Builder -> TLB.Builder -> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c) unsafeSqlBinOpComposite :: TLB.Builder -> TLB.Builder -> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOpComposite op sep a b unsafeSqlBinOpComposite op sep a b
| isCompositeKey a || isCompositeKey b = ERaw Parens $ compose (listify a) (listify b) | isCompositeKey a || isCompositeKey b = ERaw noMeta $ const $ compose (listify a) (listify b)
| otherwise = unsafeSqlBinOp op a b | otherwise = unsafeSqlBinOp op a b
where where
isCompositeKey :: SqlExpr (Value x) -> Bool isCompositeKey :: SqlExpr (Value x) -> Bool
isCompositeKey (ECompositeKey _) = True isCompositeKey (ERaw m _) = hasCompositeKeyMeta m
isCompositeKey _ = False isCompositeKey _ = False
listify :: SqlExpr (Value x) -> IdentInfo -> ([TLB.Builder], [PersistValue]) listify :: SqlExpr (Value x) -> IdentInfo -> ([TLB.Builder], [PersistValue])
listify (ECompositeKey f) = flip (,) [] . f listify v
listify (ERaw _ f) = deconstruct . f | ERaw m _ <- v, Just f <- sqlExprMetaCompositeFields m = flip (,) [] . f
listify (EAliasedValue i _) = deconstruct . (aliasedValueIdentToRawSql i) | ERaw _ f <- v = deconstruct . f Parens
listify (EValueReference i i') = deconstruct . (valueReferenceToRawSql i i') | EAliasedValue i _ <- v = deconstruct . (aliasedValueIdentToRawSql i)
| EValueReference i i' <- v = deconstruct . (valueReferenceToRawSql i i')
deconstruct :: (TLB.Builder, [PersistValue]) -> ([TLB.Builder], [PersistValue]) deconstruct :: (TLB.Builder, [PersistValue]) -> ([TLB.Builder], [PersistValue])
deconstruct ("?", [PersistList vals]) = (replicate (length vals) "?", vals) deconstruct ("?", [PersistList vals]) = (replicate (length vals) "?", vals)
@ -2276,19 +2293,19 @@ unsafeSqlBinOpComposite op sep a b
bc = intersperseB sep [x <> op <> y | (x, y) <- zip b1 b2] bc = intersperseB sep [x <> op <> y | (x, y) <- zip b1 b2]
vc = v1 <> v2 vc = v1 <> v2
-- | (Internal) A raw SQL value. The same warning from -- | (Internal) A raw SQL value. The same warning from
-- 'unsafeSqlBinOp' applies to this function as well. -- 'unsafeSqlBinOp' applies to this function as well.
unsafeSqlValue :: TLB.Builder -> SqlExpr (Value a) unsafeSqlValue :: TLB.Builder -> SqlExpr (Value a)
unsafeSqlValue v = ERaw Never $ const (v, mempty) unsafeSqlValue v = ERaw noMeta $ \_ _ -> (v, mempty)
{-# INLINE unsafeSqlValue #-} {-# INLINE unsafeSqlValue #-}
valueToFunctionArg :: IdentInfo -> SqlExpr (Value a) -> (TLB.Builder, [PersistValue]) valueToFunctionArg :: IdentInfo -> SqlExpr (Value a) -> (TLB.Builder, [PersistValue])
valueToFunctionArg info v = valueToFunctionArg info v =
case v of case v of
ERaw _ f -> f info ERaw _ f -> f Never info
EAliasedValue i _ -> aliasedValueIdentToRawSql i info EAliasedValue i _ -> aliasedValueIdentToRawSql i info
EValueReference i i' -> valueReferenceToRawSql i i' info EValueReference i i' -> valueReferenceToRawSql i i' info
ECompositeKey _ -> throw (CompositeKeyErr SqlFunctionError)
-- | (Internal) A raw SQL function. Once again, the same warning -- | (Internal) A raw SQL function. Once again, the same warning
-- from 'unsafeSqlBinOp' applies to this function as well. -- from 'unsafeSqlBinOp' applies to this function as well.
@ -2296,7 +2313,7 @@ unsafeSqlFunction
:: UnsafeSqlFunctionArgument a :: UnsafeSqlFunctionArgument a
=> TLB.Builder -> a -> SqlExpr (Value b) => TLB.Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction name arg = unsafeSqlFunction name arg =
ERaw Never $ \info -> ERaw noMeta $ \p info ->
let (argsTLB, argsVals) = let (argsTLB, argsVals) =
uncommas' $ map (valueToFunctionArg info) $ toArgList arg uncommas' $ map (valueToFunctionArg info) $ toArgList arg
in in
@ -2310,7 +2327,7 @@ unsafeSqlExtractSubField
:: UnsafeSqlFunctionArgument a :: UnsafeSqlFunctionArgument a
=> TLB.Builder -> a -> SqlExpr (Value b) => TLB.Builder -> a -> SqlExpr (Value b)
unsafeSqlExtractSubField subField arg = unsafeSqlExtractSubField subField arg =
ERaw Never $ \info -> ERaw noMeta $ \_ info ->
let (argsTLB, argsVals) = let (argsTLB, argsVals) =
uncommas' $ map (valueToFunctionArg info) $ toArgList arg uncommas' $ map (valueToFunctionArg info) $ toArgList arg
in in
@ -2322,13 +2339,12 @@ unsafeSqlFunctionParens
:: UnsafeSqlFunctionArgument a :: UnsafeSqlFunctionArgument a
=> TLB.Builder -> a -> SqlExpr (Value b) => TLB.Builder -> a -> SqlExpr (Value b)
unsafeSqlFunctionParens name arg = unsafeSqlFunctionParens name arg =
ERaw Never $ \info -> ERaw noMeta $ \p info ->
let valueToFunctionArgParens v = let valueToFunctionArgParens v =
case v of case v of
ERaw p f -> first (parensM p) (f info) ERaw _ f -> f p info
EAliasedValue i _ -> aliasedValueIdentToRawSql i info EAliasedValue i _ -> aliasedValueIdentToRawSql i info
EValueReference i i' -> valueReferenceToRawSql i i' info EValueReference i i' -> valueReferenceToRawSql i i' info
ECompositeKey _ -> throw (CompositeKeyErr SqlFunctionError)
(argsTLB, argsVals) = (argsTLB, argsVals) =
uncommas' $ map valueToFunctionArgParens $ toArgList arg uncommas' $ map valueToFunctionArgParens $ toArgList arg
in in
@ -2337,16 +2353,13 @@ unsafeSqlFunctionParens name arg =
-- | (Internal) An explicit SQL type cast using CAST(value as type). -- | (Internal) An explicit SQL type cast using CAST(value as type).
-- See 'unsafeSqlBinOp' for warnings. -- See 'unsafeSqlBinOp' for warnings.
unsafeSqlCastAs :: T.Text -> SqlExpr (Value a) -> SqlExpr (Value b) unsafeSqlCastAs :: T.Text -> SqlExpr (Value a) -> SqlExpr (Value b)
unsafeSqlCastAs t v = ERaw Never ((first (\value -> "CAST" <> parens (value <> " AS " <> TLB.fromText t))) . valueToText) unsafeSqlCastAs t v = ERaw noMeta $ \_ -> ((first (\value -> "CAST" <> parens (value <> " AS " <> TLB.fromText t))) . valueToText)
where where
valueToText info = valueToText info =
case v of case v of
(ERaw p f) -> ERaw _ f -> f Never info
let (b, vals) = f info
in (parensM p b, vals)
EAliasedValue i _ -> aliasedValueIdentToRawSql i info EAliasedValue i _ -> aliasedValueIdentToRawSql i info
EValueReference i i' -> valueReferenceToRawSql i i' info EValueReference i i' -> valueReferenceToRawSql i i' info
ECompositeKey _ -> throw (CompositeKeyErr SqlCastAsError)
-- | (Internal) This class allows 'unsafeSqlFunction' to work with different -- | (Internal) This class allows 'unsafeSqlFunction' to work with different
-- numbers of arguments; specifically it allows providing arguments to a sql -- numbers of arguments; specifically it allows providing arguments to a sql
@ -2477,8 +2490,7 @@ instance ( UnsafeSqlFunctionArgument a
-- 'SqlExpr (Value b)'. You should /not/ use this function -- 'SqlExpr (Value b)'. You should /not/ use this function
-- unless you know what you're doing! -- unless you know what you're doing!
veryUnsafeCoerceSqlExprValue :: SqlExpr (Value a) -> SqlExpr (Value b) veryUnsafeCoerceSqlExprValue :: SqlExpr (Value a) -> SqlExpr (Value b)
veryUnsafeCoerceSqlExprValue (ERaw p f) = ERaw p f veryUnsafeCoerceSqlExprValue (ERaw m f) = ERaw m f
veryUnsafeCoerceSqlExprValue (ECompositeKey f) = ECompositeKey f
veryUnsafeCoerceSqlExprValue (EAliasedValue i v) = EAliasedValue i (veryUnsafeCoerceSqlExprValue v) veryUnsafeCoerceSqlExprValue (EAliasedValue i v) = EAliasedValue i (veryUnsafeCoerceSqlExprValue v)
veryUnsafeCoerceSqlExprValue (EValueReference i i') = EValueReference i i' veryUnsafeCoerceSqlExprValue (EValueReference i i') = EValueReference i i'
@ -2915,16 +2927,14 @@ makeFrom info mode fs = ret
fromKind RightOuterJoinKind = " RIGHT OUTER JOIN " fromKind RightOuterJoinKind = " RIGHT OUTER JOIN "
fromKind FullOuterJoinKind = " FULL OUTER JOIN " fromKind FullOuterJoinKind = " FULL OUTER JOIN "
makeOnClause (ERaw _ f) = first (" ON " <>) (f info) makeOnClause (ERaw _ f) = first (" ON " <>) (f Never info)
makeOnClause (ECompositeKey _) = throw (CompositeKeyErr MakeOnClauseError)
makeOnClause (EAliasedValue _ _) = throw (AliasedValueErr MakeOnClauseError) makeOnClause (EAliasedValue _ _) = throw (AliasedValueErr MakeOnClauseError)
makeOnClause (EValueReference _ _) = throw (AliasedValueErr MakeOnClauseError) makeOnClause (EValueReference _ _) = throw (AliasedValueErr MakeOnClauseError)
mkExc :: SqlExpr (Value Bool) -> OnClauseWithoutMatchingJoinException mkExc :: SqlExpr (Value Bool) -> OnClauseWithoutMatchingJoinException
mkExc (ERaw _ f) = mkExc (ERaw _ f) =
OnClauseWithoutMatchingJoinException $ OnClauseWithoutMatchingJoinException $
TL.unpack $ TLB.toLazyText $ fst (f info) TL.unpack $ TLB.toLazyText $ fst (f Never info)
mkExc (ECompositeKey _) = throw (CompositeKeyErr MakeExcError)
mkExc (EAliasedValue _ _) = throw (AliasedValueErr MakeExcError) mkExc (EAliasedValue _ _) = throw (AliasedValueErr MakeExcError)
mkExc (EValueReference _ _) = throw (AliasedValueErr MakeExcError) mkExc (EValueReference _ _) = throw (AliasedValueErr MakeExcError)
@ -2932,8 +2942,7 @@ makeSet :: IdentInfo -> [SetClause] -> (TLB.Builder, [PersistValue])
makeSet _ [] = mempty makeSet _ [] = mempty
makeSet info os = first ("\nSET " <>) . uncommas' $ concatMap mk os makeSet info os = first ("\nSET " <>) . uncommas' $ concatMap mk os
where where
mk (SetClause (ERaw _ f)) = [f info] mk (SetClause (ERaw _ f)) = [f Never info]
mk (SetClause (ECompositeKey _)) = throw (CompositeKeyErr MakeSetError) -- FIXME
mk (SetClause (EAliasedValue i _)) = [aliasedValueIdentToRawSql i info] mk (SetClause (EAliasedValue i _)) = [aliasedValueIdentToRawSql i info]
mk (SetClause (EValueReference i i')) = [valueReferenceToRawSql i i' info] mk (SetClause (EValueReference i i')) = [valueReferenceToRawSql i i' info]
@ -2943,10 +2952,9 @@ makeWhere info (Where v) = first ("\nWHERE " <>) $ x info
where where
x = x =
case v of case v of
ERaw _ f -> f ERaw _ f -> f Never
EAliasedValue i _ -> aliasedValueIdentToRawSql i EAliasedValue i _ -> aliasedValueIdentToRawSql i
EValueReference i i' -> valueReferenceToRawSql i i' EValueReference i i' -> valueReferenceToRawSql i i'
ECompositeKey _ -> throw (CompositeKeyErr MakeWhereError)
makeGroupBy :: IdentInfo -> GroupByClause -> (TLB.Builder, [PersistValue]) makeGroupBy :: IdentInfo -> GroupByClause -> (TLB.Builder, [PersistValue])
makeGroupBy _ (GroupBy []) = (mempty, []) makeGroupBy _ (GroupBy []) = (mempty, [])
@ -2956,8 +2964,7 @@ makeGroupBy info (GroupBy fields) = first ("\nGROUP BY " <>) build
build = uncommas' $ map match fields build = uncommas' $ map match fields
match :: SomeValue -> (TLB.Builder, [PersistValue]) match :: SomeValue -> (TLB.Builder, [PersistValue])
match (SomeValue (ERaw _ f)) = f info match (SomeValue (ERaw _ f)) = f Never info
match (SomeValue (ECompositeKey f)) = (mconcat $ f info, mempty)
match (SomeValue (EAliasedValue i _)) = aliasedValueIdentToRawSql i info match (SomeValue (EAliasedValue i _)) = aliasedValueIdentToRawSql i info
match (SomeValue (EValueReference i i')) = valueReferenceToRawSql i i' info match (SomeValue (EValueReference i i')) = valueReferenceToRawSql i i' info
@ -2967,10 +2974,9 @@ makeHaving info (Where v) = first ("\nHAVING " <>) $ x info
where where
x = x =
case v of case v of
ERaw _ f -> f ERaw _ f -> f Never
EAliasedValue i _ -> aliasedValueIdentToRawSql i EAliasedValue i _ -> aliasedValueIdentToRawSql i
EValueReference i i' -> valueReferenceToRawSql i i' EValueReference i i' -> valueReferenceToRawSql i i'
ECompositeKey _ -> throw (CompositeKeyErr MakeHavingError)
-- makeHaving, makeWhere and makeOrderBy -- makeHaving, makeWhere and makeOrderBy
makeOrderByNoNewline makeOrderByNoNewline
@ -2979,17 +2985,17 @@ makeOrderByNoNewline _ [] = mempty
makeOrderByNoNewline info os = first ("ORDER BY " <>) . uncommas' $ concatMap mk os makeOrderByNoNewline info os = first ("ORDER BY " <>) . uncommas' $ concatMap mk os
where where
mk :: OrderByClause -> [(TLB.Builder, [PersistValue])] mk :: OrderByClause -> [(TLB.Builder, [PersistValue])]
mk (EOrderBy t (ECompositeKey f)) = mk (EOrderBy t v)
| ERaw m _ <- v, Just f <- sqlExprMetaCompositeFields m =
let fs = f info let fs = f info
vals = repeat [] vals = repeat []
in zip (map (<> orderByType t) fs) vals in zip (map (<> orderByType t) fs) vals
mk (EOrderBy t v) = | otherwise =
let x = let x =
case v of case v of
ERaw p f -> (first (parensM p)) . f ERaw _ f -> f Never
EAliasedValue i _ -> aliasedValueIdentToRawSql i EAliasedValue i _ -> aliasedValueIdentToRawSql i
EValueReference i i' -> valueReferenceToRawSql i i' EValueReference i i' -> valueReferenceToRawSql i i'
ECompositeKey _ -> undefined -- defined above
in [ first (<> orderByType t) $ x info ] in [ first (<> orderByType t) $ x info ]
mk EOrderRandom = [first (<> "RANDOM()") mempty] mk EOrderRandom = [first (<> "RANDOM()") mempty]
@ -3151,12 +3157,11 @@ instance PersistField a => SqlSelect (SqlExpr (Value a)) (Value a) where
-- | Materialize a @SqlExpr (Value a)@. -- | Materialize a @SqlExpr (Value a)@.
materializeExpr :: IdentInfo -> SqlExpr (Value a) -> (TLB.Builder, [PersistValue]) materializeExpr :: IdentInfo -> SqlExpr (Value a) -> (TLB.Builder, [PersistValue])
materializeExpr info (ERaw p f) = materializeExpr info v
let (b, vals) = f info | ERaw m _ <- v, Just f <- sqlExprMetaCompositeFields m =
in (parensM p b, vals)
materializeExpr info (ECompositeKey f) =
let bs = f info let bs = f info
in (uncommas $ map (parensM Parens) bs, []) in (uncommas $ map (parensM Parens) bs, [])
| ERaw _ f <- v = f Parens info
materializeExpr info (EAliasedValue ident x) = materializeExpr info (EAliasedValue ident x) =
let (b, vals) = materializeExpr info x let (b, vals) = materializeExpr info x
in (b <> " AS " <> (useIdent info ident), vals) in (b <> " AS " <> (useIdent info ident), vals)
@ -3684,16 +3689,9 @@ insertSelectCount = rawEsqueleto INSERT_INTO . fmap EInsertFinal
-- @since 3.2.0 -- @since 3.2.0
renderExpr :: SqlBackend -> SqlExpr (Value Bool) -> T.Text renderExpr :: SqlBackend -> SqlExpr (Value Bool) -> T.Text
renderExpr sqlBackend e = case e of renderExpr sqlBackend e = case e of
ERaw _ mkBuilderValues -> do ERaw _ mkBuilderValues ->
let (builder, _) = mkBuilderValues (sqlBackend, initialIdentState) let (builder, _) = mkBuilderValues Never (sqlBackend, initialIdentState)
in (builderToText builder) in (builderToText builder)
ECompositeKey mkInfo ->
throw
. RenderExprUnexpectedECompositeKey
. builderToText
. mconcat
. mkInfo
$ (sqlBackend, initialIdentState)
EAliasedValue i _ -> EAliasedValue i _ ->
builderToText $ useIdent (sqlBackend, initialIdentState) i builderToText $ useIdent (sqlBackend, initialIdentState) i
EValueReference i i' -> EValueReference i i' ->

1
src/Database/Esqueleto/Internal/Sql.hs
View File

@ -37,7 +37,6 @@ module Database.Esqueleto.Internal.Sql
-- * The guts -- * The guts
, unsafeSqlCase , unsafeSqlCase
, unsafeSqlBinOp , unsafeSqlBinOp
, unsafeSqlBinOpComposite
, unsafeSqlValue , unsafeSqlValue
, unsafeSqlCastAs , unsafeSqlCastAs
, unsafeSqlFunction , unsafeSqlFunction

21
src/Database/Esqueleto/PostgreSQL.hs
View File

@ -36,16 +36,17 @@ import Data.Semigroup
import Control.Arrow (first, (***)) import Control.Arrow (first, (***))
import Control.Exception (throw) import Control.Exception (throw)
import Control.Monad (void) import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.IO.Class (MonadIO (..))
import qualified Control.Monad.Trans.Reader as R import qualified Control.Monad.Trans.Reader as R
import Data.Int (Int64) import Data.Int (Int64)
import Data.List.NonEmpty (NonEmpty((:|))) import Data.List.NonEmpty (NonEmpty ((:|)))
import qualified Data.List.NonEmpty as NonEmpty import qualified Data.List.NonEmpty as NonEmpty
import Data.Proxy (Proxy(..)) import Data.Proxy (Proxy (..))
import qualified Data.Text.Internal.Builder as TLB import qualified Data.Text.Internal.Builder as TLB
import Data.Time.Clock (UTCTime) import Data.Time.Clock (UTCTime)
import Database.Esqueleto.Internal.Internal hiding (random_) import Database.Esqueleto.Internal.Internal hiding (random_)
import Database.Esqueleto.Internal.PersistentImport hiding (upsert, upsertBy) import Database.Esqueleto.Internal.PersistentImport hiding (upsert,
upsertBy)
import Database.Persist.Class (OnlyOneUniqueKey) import Database.Persist.Class (OnlyOneUniqueKey)
-- | (@random()@) Split out into database specific modules -- | (@random()@) Split out into database specific modules
@ -83,7 +84,7 @@ unsafeSqlAggregateFunction
-> a -> a
-> [OrderByClause] -> [OrderByClause]
-> SqlExpr (Value b) -> SqlExpr (Value b)
unsafeSqlAggregateFunction name mode args orderByClauses = ERaw Never $ \info -> unsafeSqlAggregateFunction name mode args orderByClauses = ERaw noMeta $ \_ info ->
let (orderTLB, orderVals) = makeOrderByNoNewline info orderByClauses let (orderTLB, orderVals) = makeOrderByNoNewline info orderByClauses
-- Don't add a space if we don't have order by clauses -- Don't add a space if we don't have order by clauses
orderTLBSpace = orderTLBSpace =
@ -91,7 +92,7 @@ unsafeSqlAggregateFunction name mode args orderByClauses = ERaw Never $ \info ->
[] -> "" [] -> ""
(_:_) -> " " (_:_) -> " "
(argsTLB, argsVals) = (argsTLB, argsVals) =
uncommas' $ map (\(ERaw _ f) -> f info) $ toArgList args uncommas' $ map (\(ERaw _ f) -> f Never info) $ toArgList args
aggMode = aggMode =
case mode of case mode of
AggModeAll -> "" AggModeAll -> ""
@ -355,13 +356,11 @@ filterWhere
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
-- ^ Filter clause -- ^ Filter clause
-> SqlExpr (Value a) -> SqlExpr (Value a)
filterWhere aggExpr clauseExpr = ERaw Never $ \info -> filterWhere aggExpr clauseExpr = ERaw noMeta $ \_ info ->
let (aggBuilder, aggValues) = case aggExpr of let (aggBuilder, aggValues) = case aggExpr of
ERaw _ aggF -> aggF info ERaw _ aggF -> aggF Never info
ECompositeKey _ -> throw $ CompositeKeyErr FilterWhereAggError
(clauseBuilder, clauseValues) = case clauseExpr of (clauseBuilder, clauseValues) = case clauseExpr of
ERaw _ clauseF -> clauseF info ERaw _ clauseF -> clauseF Never info
ECompositeKey _ -> throw $ CompositeKeyErr FilterWhereClauseError
in ( aggBuilder <> " FILTER (WHERE " <> clauseBuilder <> ")" in ( aggBuilder <> " FILTER (WHERE " <> clauseBuilder <> ")"
, aggValues <> clauseValues , aggValues <> clauseValues
) )

25
test/Common/Test.hs
View File

@ -1,6 +1,6 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE EmptyDataDecls #-}
@ -62,7 +62,8 @@ module Common.Test
, Key(..) , Key(..)
) where ) where
import Control.Monad (forM_, replicateM, replicateM_, void) import Control.Monad (forM_, replicateM,
replicateM_, void)
import Control.Monad.Catch (MonadCatch) import Control.Monad.Catch (MonadCatch)
import Control.Monad.Reader (ask) import Control.Monad.Reader (ask)
import Data.Either import Data.Either
@ -70,8 +71,10 @@ import Data.Time
#if __GLASGOW_HASKELL__ >= 806 #if __GLASGOW_HASKELL__ >= 806
import Control.Monad.Fail (MonadFail) import Control.Monad.Fail (MonadFail)
#endif #endif
import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Logger (MonadLogger(..), NoLoggingT, runNoLoggingT) import Control.Monad.Logger (MonadLogger (..),
NoLoggingT,
runNoLoggingT)
import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.Reader (ReaderT)
import qualified Data.Attoparsec.Text as AP import qualified Data.Attoparsec.Text as AP
import Data.Char (toLower, toUpper) import Data.Char (toLower, toUpper)
@ -83,7 +86,8 @@ import Database.Persist.TH
import Test.Hspec import Test.Hspec
import UnliftIO import UnliftIO
import Data.Conduit (ConduitT, runConduit, (.|)) import Data.Conduit (ConduitT, runConduit,
(.|))
import qualified Data.Conduit.List as CL import qualified Data.Conduit.List as CL
import qualified Data.List as L import qualified Data.List as L
import qualified Data.Set as S import qualified Data.Set as S
@ -1078,17 +1082,6 @@ testSelectWhere run = describe "select where_" $ do
( val $ PointKey 1 2 ( val $ PointKey 1 2
, val $ PointKey 5 6 ) , val $ PointKey 5 6 )
liftIO $ ret `shouldBe` [()] liftIO $ ret `shouldBe` [()]
it "works when using ECompositeKey constructor" $ run $ do
insert_ $ Point 1 2 ""
ret <-
select $
from $ \p -> do
where_ $
p ^. PointId
`between`
( EI.ECompositeKey $ const ["3", "4"]
, EI.ECompositeKey $ const ["5", "6"] )
liftIO $ ret `shouldBe` []
it "works with avg_" $ run $ do it "works with avg_" $ run $ do
_ <- insert' p1 _ <- insert' p1