git.iko.soy/rel8
on master help sign in
alignBy doesn't actually need any Table constraints
294543eShane O'Brien
src/Rel8/Query/Maybe.hs+13−14
compare with master
unifiedsplit
@@ -13,17 +13,15 @@ import qualified Opaleye.Internal.PackMap as Opaleye
13import qualified Opaleye.Internal.PrimQuery as Opaleye
13import qualified Opaleye.Internal.PrimQuery as Opaleye
14import qualified Opaleye.Internal.QueryArr as Opaleye
14import qualified Opaleye.Internal.QueryArr as Opaleye
15import qualified Opaleye.Internal.Tag as Opaleye
15import qualified Opaleye.Internal.Tag as Opaleye
16−import qualified Opaleye.Internal.Unpackspec as Opaleye
17
16
18-- rel8
17-- rel8
19import Rel8.Expr.Bool ( true )
18import Rel8.Expr.Bool ( true )
20import Rel8.Expr.Eq ( (==.) )
19import Rel8.Expr.Eq ( (==.) )
21−import Rel8.Expr.Opaleye ( toPrimExpr )
20+import Rel8.Expr.Opaleye ( toPrimExpr, traversePrimExpr )
22import Rel8.Query ( Query )
21import Rel8.Query ( Query )
23import Rel8.Query.Filter ( where_ )
22import Rel8.Query.Filter ( where_ )
24import Rel8.Query.Opaleye ( mapOpaleye )
23import Rel8.Query.Opaleye ( mapOpaleye )
25import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
24import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
26−import Rel8.Table.Opaleye ( unpackspec )
27import Rel8.Table.Tag ( Tag(..), fromExpr )
25import Rel8.Table.Tag ( Tag(..), fromExpr )
28
26
29
27
@@ -33,17 +31,18 @@ import Rel8.Table.Tag ( Tag(..), fromExpr )
33-- To speak in more concrete terms, 'optional' is most useful to write @LEFT
31-- To speak in more concrete terms, 'optional' is most useful to write @LEFT
34-- JOIN@s.
32-- JOIN@s.
35optional :: Query a -> Query (MaybeTable a)
33optional :: Query a -> Query (MaybeTable a)
36−optional = mapOpaleye $ Opaleye.QueryArr . go
34+optional = mapOpaleye $ \query -> Opaleye.QueryArr $ \i -> case i of
37− where
35+ (_, left, tag) -> (ma', join, tag'')
38− go query (i, left, tag) =
36+ where
39− (MaybeTable (fromExpr t') a, join, Opaleye.next tag')
37+ (ma, right, tag') = Opaleye.runSimpleQueryArr (pure <$> query) ((), tag)
40− where
41− (MaybeTable Tag {expr = t} a, right, tag') =
38+ MaybeTable Tag {expr = just} a = ma
42− Opaleye.runSimpleQueryArr (pure <$> query) (i, tag)
43− (t', bindings) = Opaleye.run $
39+ (just', bindings) = Opaleye.run $ do
44− Opaleye.runUnpackspec unpackspec (Opaleye.extractAttr "maybe" tag') t
40+ traversePrimExpr (Opaleye.extractAttr "isJust" tag') just
41+ tag'' = Opaleye.next tag'
45− join = Opaleye.Join Opaleye.LeftJoin condition [] bindings left right
42+ join = Opaleye.Join Opaleye.LeftJoin on [] bindings left right
43+ where
46− condition = toPrimExpr true
44+ on = toPrimExpr true
45+ ma' = MaybeTable (fromExpr just') a
47
46
48
47
49-- | Filter out 'MaybeTable's, returning only the tables that are not-null.
48-- | Filter out 'MaybeTable's, returning only the tables that are not-null.
src/Rel8/Query/These.hs+26−15
@@ -15,26 +15,26 @@ where
15import Prelude
15import Prelude
16
16
17-- opaleye
17-- opaleye
18−import qualified Opaleye.Internal.Join as Opaleye
18+import qualified Opaleye.Internal.PackMap as Opaleye
19import qualified Opaleye.Internal.PrimQuery as Opaleye
19import qualified Opaleye.Internal.PrimQuery as Opaleye
20+import qualified Opaleye.Internal.QueryArr as Opaleye
21+import qualified Opaleye.Internal.Tag as Opaleye
20
22
21-- rel8
23-- rel8
22import Rel8.Expr ( Expr )
24import Rel8.Expr ( Expr )
23import Rel8.Expr.Bool ( boolExpr, not_ )
25import Rel8.Expr.Bool ( boolExpr, not_ )
24import Rel8.Expr.Eq ( (==.) )
26import Rel8.Expr.Eq ( (==.) )
25−import Rel8.Expr.Opaleye ( toColumn, toPrimExpr )
27+import Rel8.Expr.Opaleye ( toPrimExpr, traversePrimExpr )
26import Rel8.Expr.Serialize ( litExpr )
28import Rel8.Expr.Serialize ( litExpr )
27import Rel8.Query ( Query )
29import Rel8.Query ( Query )
28import Rel8.Query.Filter ( where_ )
30import Rel8.Query.Filter ( where_ )
29import Rel8.Query.Maybe ( optional )
31import Rel8.Query.Maybe ( optional )
30import Rel8.Query.Opaleye ( zipOpaleyeWith )
32import Rel8.Query.Opaleye ( zipOpaleyeWith )
31−import Rel8.Table ( Table )
32import Rel8.Table.Either ( EitherTable( EitherTable ) )
33import Rel8.Table.Either ( EitherTable( EitherTable ) )
33import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
34import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
34−import Rel8.Table.Opaleye ( unpackspec )
35+import Rel8.Table.Tag ( Tag(..), fromExpr )
35−import Rel8.Table.Tag ( Tag(..) )
36import Rel8.Table.These
36import Rel8.Table.These
37− ( TheseTable( TheseTable )
37+ ( TheseTable( TheseTable, here, there )
38 , hasHereTable, hasThereTable
38 , hasHereTable, hasThereTable
39 , isThisTable, isThatTable, isThoseTable
39 , isThisTable, isThatTable, isThoseTable
40 )
40 )
@@ -42,17 +42,28 @@ import Rel8.Type.Tag ( EitherTag( IsLeft, IsRight ) )
42
42
43
43
44-- | Corresponds to a @FULL OUTER JOIN@ between two queries.
44-- | Corresponds to a @FULL OUTER JOIN@ between two queries.
45−alignBy :: (Table Expr a, Table Expr b)
45+alignBy :: ()
46 => (a -> b -> Expr Bool)
46 => (a -> b -> Expr Bool)
47 -> Query a -> Query b -> Query (TheseTable a b)
47 -> Query a -> Query b -> Query (TheseTable a b)
48−alignBy condition as bs =
48+alignBy condition = zipOpaleyeWith $ \left right -> Opaleye.QueryArr $ \i -> case i of
49− uncurry TheseTable <$> zipOpaleyeWith fullOuterJoin as bs
49+ (_, input, tag) -> (tab, join', tag''')
50− where
50+ where
51− fullOuterJoin a b =
51+ (ma, left', tag') = Opaleye.runSimpleQueryArr (pure <$> left) ((), tag)
52− Opaleye.joinExplicit unpackspec unpackspec pure pure full a b on
52+ (mb, right', tag'') = Opaleye.runSimpleQueryArr (pure <$> right) ((), tag')
53− where
53+ MaybeTable Tag {expr = hasHere} a = ma
54− full = Opaleye.FullJoin
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
55− on = toColumn . toPrimExpr . uncurry condition
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
56
67
57
68
58-- | Filter 'TheseTable's, keeping only 'thisTable's and 'thoseTable's.
69-- | Filter 'TheseTable's, keeping only 'thisTable's and 'thoseTable's.