git.iko.soy/rel8
on master help sign in
alignBy doesn't actually need any Table constraints

We can use the same technique we use in `optional` to get rid of them.

commit294543e5309939d464abdfecbeb15f45df56d6fa authorShane O'Brien <shane.obrien@circuithub.com> dateMon 21 Jun 2021, 23:22 (5 years ago) parente83f356
2 files changed+39−29
compare with master
unifiedsplit
src/Rel8/Query/Maybe.hs+13−14 src/Rel8/Query/These.hs+26−15
src/Rel8/Query/Maybe.hs+13−14
@@ -13,17 +13,15 @@ import qualified Opaleye.Internal.PackMap as Opaleye
1313import qualified Opaleye.Internal.PrimQuery as Opaleye
1414import qualified Opaleye.Internal.QueryArr as Opaleye
1515import qualified Opaleye.Internal.Tag as Opaleye
16−import qualified Opaleye.Internal.Unpackspec as Opaleye
1716
1817-- rel8
1918import Rel8.Expr.Bool ( true )
2019import Rel8.Expr.Eq ( (==.) )
21−import Rel8.Expr.Opaleye ( toPrimExpr )
20+import Rel8.Expr.Opaleye ( toPrimExpr, traversePrimExpr )
2221import Rel8.Query ( Query )
2322import Rel8.Query.Filter ( where_ )
2423import Rel8.Query.Opaleye ( mapOpaleye )
2524import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
26−import Rel8.Table.Opaleye ( unpackspec )
2725import Rel8.Table.Tag ( Tag(..), fromExpr )
2826
2927
@@ -33,17 +31,18 @@ import Rel8.Table.Tag ( Tag(..), fromExpr )
3331-- To speak in more concrete terms, 'optional' is most useful to write @LEFT
3432-- JOIN@s.
3533optional :: Query a -> Query (MaybeTable a)
36−optional = mapOpaleye $ Opaleye.QueryArr . go
37− where
38− go query (i, left, tag) =
39− (MaybeTable (fromExpr t') a, join, Opaleye.next tag')
40− where
41− (MaybeTable Tag {expr = t} a, right, tag') =
42− Opaleye.runSimpleQueryArr (pure <$> query) (i, tag)
43− (t', bindings) = Opaleye.run $
44− Opaleye.runUnpackspec unpackspec (Opaleye.extractAttr "maybe" tag') t
45− join = Opaleye.Join Opaleye.LeftJoin condition [] bindings left right
46− condition = toPrimExpr true
34+optional = mapOpaleye $ \query -> Opaleye.QueryArr $ \i -> case i of
35+ (_, left, tag) -> (ma', join, tag'')
36+ where
37+ (ma, right, tag') = Opaleye.runSimpleQueryArr (pure <$> query) ((), tag)
38+ MaybeTable Tag {expr = just} a = ma
39+ (just', bindings) = Opaleye.run $ do
40+ traversePrimExpr (Opaleye.extractAttr "isJust" tag') just
41+ tag'' = Opaleye.next tag'
42+ join = Opaleye.Join Opaleye.LeftJoin on [] bindings left right
43+ where
44+ on = toPrimExpr true
45+ ma' = MaybeTable (fromExpr just') a
4746
4847
4948-- | Filter out 'MaybeTable's, returning only the tables that are not-null.
src/Rel8/Query/These.hs+26−15
@@ -15,26 +15,26 @@ where
1515import Prelude
1616
1717-- opaleye
18−import qualified Opaleye.Internal.Join as Opaleye
18+import qualified Opaleye.Internal.PackMap as Opaleye
1919import qualified Opaleye.Internal.PrimQuery as Opaleye
20+import qualified Opaleye.Internal.QueryArr as Opaleye
21+import qualified Opaleye.Internal.Tag as Opaleye
2022
2123-- rel8
2224import Rel8.Expr ( Expr )
2325import Rel8.Expr.Bool ( boolExpr, not_ )
2426import Rel8.Expr.Eq ( (==.) )
25−import Rel8.Expr.Opaleye ( toColumn, toPrimExpr )
27+import Rel8.Expr.Opaleye ( toPrimExpr, traversePrimExpr )
2628import Rel8.Expr.Serialize ( litExpr )
2729import Rel8.Query ( Query )
2830import Rel8.Query.Filter ( where_ )
2931import Rel8.Query.Maybe ( optional )
3032import Rel8.Query.Opaleye ( zipOpaleyeWith )
31−import Rel8.Table ( Table )
3233import Rel8.Table.Either ( EitherTable( EitherTable ) )
3334import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
34−import Rel8.Table.Opaleye ( unpackspec )
35−import Rel8.Table.Tag ( Tag(..) )
35+import Rel8.Table.Tag ( Tag(..), fromExpr )
3636import Rel8.Table.These
37− ( TheseTable( TheseTable )
37+ ( TheseTable( TheseTable, here, there )
3838 , hasHereTable, hasThereTable
3939 , isThisTable, isThatTable, isThoseTable
4040 )
@@ -42,17 +42,28 @@ import Rel8.Type.Tag ( EitherTag( IsLeft, IsRight ) )
4242
4343
4444-- | Corresponds to a @FULL OUTER JOIN@ between two queries.
45−alignBy :: (Table Expr a, Table Expr b)
45+alignBy :: ()
4646 => (a -> b -> Expr Bool)
4747 -> Query a -> Query b -> Query (TheseTable a b)
48−alignBy condition as bs =
49− uncurry TheseTable <$> zipOpaleyeWith fullOuterJoin as bs
50− where
51− fullOuterJoin a b =
52− Opaleye.joinExplicit unpackspec unpackspec pure pure full a b on
53− where
54− full = Opaleye.FullJoin
55− on = toColumn . toPrimExpr . uncurry condition
48+alignBy condition = zipOpaleyeWith $ \left right -> Opaleye.QueryArr $ \i -> case i of
49+ (_, input, tag) -> (tab, join', tag''')
50+ where
51+ (ma, left', tag') = Opaleye.runSimpleQueryArr (pure <$> left) ((), tag)
52+ (mb, right', tag'') = Opaleye.runSimpleQueryArr (pure <$> right) ((), tag')
53+ MaybeTable Tag {expr = hasHere} a = ma
54+ MaybeTable Tag {expr = hasThere} b = mb
55+ (hasHere', lbindings) = Opaleye.run $ do
56+ traversePrimExpr (Opaleye.extractAttr "hasHere" tag'') hasHere
57+ (hasThere', rbindings) = Opaleye.run $ do
58+ traversePrimExpr (Opaleye.extractAttr "hasThere" tag'') hasThere
59+ tag''' = Opaleye.next tag''
60+ join = Opaleye.Join Opaleye.FullJoin on lbindings rbindings left' right'
61+ where
62+ on = toPrimExpr $ condition a b
63+ ma' = MaybeTable (fromExpr hasHere') a
64+ mb' = MaybeTable (fromExpr hasThere') b
65+ tab = TheseTable {here = ma', there = mb'}
66+ join' = Opaleye.times input join
5667
5768
5869-- | Filter 'TheseTable's, keeping only 'thisTable's and 'thoseTable's.