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

Make postgres tests pass

Browse Source
This commit is contained in:
belevy 2021-01-19 14:26:27 -06:00
parent 2f5ae76cbf
commit 2ab733fbee
4 changed files with 14 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Database/Esqueleto/Experimental/ToAlias.hs
View File

@ -23,7 +23,7 @@ instance ToAlias (SqlExpr (Value a)) where
ident <- newIdentFor (DBName "v") ident <- newIdentFor (DBName "v")
pure $ ERaw noMeta{sqlExprMetaAlias = Just ident} $ \_ info -> pure $ ERaw noMeta{sqlExprMetaAlias = Just ident} $ \_ info ->
let (b, v) = f Never info let (b, v) = f Never info
in (b <> " AS " <> useIdent info ident, []) in (b <> " AS " <> useIdent info ident, v)
instance ToAlias (SqlExpr (Entity a)) where instance ToAlias (SqlExpr (Entity a)) where

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

@ -19,22 +19,22 @@ class ToAliasReference a where
instance ToAliasReference (SqlExpr (Value a)) where instance ToAliasReference (SqlExpr (Value a)) where
toAliasReference aliasSource (ERaw m _) toAliasReference aliasSource (ERaw m _)
| Just alias <- sqlExprMetaAlias m = pure $ ERaw m $ \_ info -> | Just alias <- sqlExprMetaAlias m = pure $ ERaw m $ \_ info ->
(useIdent info aliasSource <> "." <> useIdent info alias, []) (useIdent info aliasSource <> "." <> useIdent info alias, [])
toAliasReference _ e = pure e toAliasReference _ e = pure e
instance ToAliasReference (SqlExpr (Entity a)) where instance ToAliasReference (SqlExpr (Entity a)) where
toAliasReference aliasSource (ERaw m _) toAliasReference aliasSource (ERaw m _)
| Just _ <- sqlExprMetaAlias m, False <- sqlExprMetaIsReference m = | Just _ <- sqlExprMetaAlias m, False <- sqlExprMetaIsReference m =
pure $ ERaw m{sqlExprMetaIsReference = True} $ \_ info -> pure $ ERaw m{sqlExprMetaIsReference = True} $ \_ info ->
(useIdent info aliasSource, []) (useIdent info aliasSource, [])
toAliasReference _ e = pure e toAliasReference _ e = pure e
instance ToAliasReference (SqlExpr (Maybe (Entity a))) where instance ToAliasReference (SqlExpr (Maybe (Entity a))) where
-- FIXME: Code duplication because the compiler doesnt like half final encoding -- FIXME: Code duplication because the compiler doesnt like half final encoding
toAliasReference aliasSource (ERaw m f) toAliasReference aliasSource (ERaw m _)
| Just _ <- sqlExprMetaAlias m, False <- sqlExprMetaIsReference m = | Just _ <- sqlExprMetaAlias m, False <- sqlExprMetaIsReference m =
pure $ ERaw m{sqlExprMetaIsReference = True} $ \_ info -> pure $ ERaw m{sqlExprMetaIsReference = True} $ \_ info ->
(useIdent info aliasSource, []) (useIdent info aliasSource, [])
toAliasReference s e = pure e toAliasReference s e = pure e

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

@ -363,7 +363,9 @@ distinctOnOrderBy exprs act =
act act
where where
toDistinctOn :: SqlExpr OrderBy -> SqlExpr DistinctOn toDistinctOn :: SqlExpr OrderBy -> SqlExpr DistinctOn
toDistinctOn = coerce toDistinctOn (ERaw m f) = ERaw m $ \p info ->
let (b, vals) = f p info
in (TLB.fromLazyText $ head $ TL.splitOn " " $ TLB.toLazyText b, vals)
-- | @ORDER BY random()@ clause. -- | @ORDER BY random()@ clause.
-- --
@ -918,7 +920,11 @@ in_ :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (ValueList typ) -> Sql
ERaw noMeta $ \p info -> ERaw noMeta $ \p info ->
let (b1, vals1) = v Parens info let (b1, vals1) = v Parens info
(b2, vals2) = list Parens info (b2, vals2) = list Parens info
in (b1 <> " IN " <> b2, vals1 <> vals2) in
if b2 == "()" then
("FALSE", [])
else
(b1 <> " IN " <> b2, vals1 <> vals2)
-- | @NOT IN@ operator. -- | @NOT IN@ operator.
notIn :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (ValueList typ) -> SqlExpr (Value Bool) notIn :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (ValueList typ) -> SqlExpr (Value Bool)
@ -3042,7 +3048,7 @@ materializeExpr info v
| ERaw m _ <- v, Just f <- sqlExprMetaCompositeFields m = | ERaw m _ <- v, Just f <- sqlExprMetaCompositeFields m =
let bs = f info let bs = f info
in (uncommas $ map (parensM Parens) bs, []) in (uncommas $ map (parensM Parens) bs, [])
| ERaw _ f <- v = f Never info | ERaw _ f <- v = f Parens info
-- | You may return tuples (up to 16-tuples) and tuples of tuples -- | You may return tuples (up to 16-tuples) and tuples of tuples

1
test/Common/Test.hs
View File

@ -894,7 +894,6 @@ testSelectSubQuery run = describe "select subquery" $ do
`Experimental.on` (\(l :& d) -> just (l ^. LordId) ==. d ?. DeedOwnerId) `Experimental.on` (\(l :& d) -> just (l ^. LordId) ==. d ?. DeedOwnerId)
pure (lords, deeds) pure (lords, deeds)
liftIO . print =<< renderQuerySelect q
ret <- select q ret <- select q
liftIO $ ret `shouldMatchList` ((l3e, Nothing) : l1WithDeeds) liftIO $ ret `shouldMatchList` ((l3e, Nothing) : l1WithDeeds)