git.iko.soy/rel8
on master help sign in
Fix bitraverse{Either,These}Table to not need Table constraint
bde3d54Shane O'Brien
src/Rel8/Query/Either.hs+7−13
compare with master
unifiedsplit
@@ -18,12 +18,10 @@ import Rel8.Expr.Eq ( (==.) )
18import Rel8.Query ( Query )
18import Rel8.Query ( Query )
19import Rel8.Query.Filter ( where_ )
19import Rel8.Query.Filter ( where_ )
20import Rel8.Query.Maybe ( optional )
20import Rel8.Query.Maybe ( optional )
21−import Rel8.Query.Set ( unionAll )
22import Rel8.Table ( Table )
21import Rel8.Table ( Table )
23import Rel8.Table.Bool ( bool )
22import Rel8.Table.Bool ( bool )
24import Rel8.Table.Either
23import Rel8.Table.Either
25 ( EitherTable( EitherTable )
24 ( EitherTable( EitherTable )
26− , leftTable, rightTable
27 , isLeftTable, isRightTable
25 , isLeftTable, isRightTable
28 )
26 )
29import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
27import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
@@ -48,18 +46,14 @@ bindEitherTable query e@(EitherTable input a i) = do
48 EitherTable (input <> output) (bool a a' (isRightTable e)) b
46 EitherTable (input <> output) (bool a a' (isRightTable e)) b
49
47
50
48
51−bitraverseEitherTable :: (Table Expr c, Table Expr d)
49+bitraverseEitherTable :: ()
52 => (a -> Query c)
50 => (a -> Query c)
53 -> (b -> Query d)
51 -> (b -> Query d)
54 -> EitherTable a b
52 -> EitherTable a b
55 -> Query (EitherTable c d)
53 -> Query (EitherTable c d)
56−bitraverseEitherTable f g e = traverseLeftTable `unionAll` traverseRightTable
54+bitraverseEitherTable f g e@(EitherTable tag _ _) = do
57− where
58− traverseLeftTable = do
59− mc@(MaybeTable _ c) <- optional (f =<< keepLeftTable e)
55+ mc@(MaybeTable _ c) <- optional (f =<< keepLeftTable e)
60− where_ $ isJustTable mc ==. isLeftTable e
61− pure $ leftTable c
62− traverseRightTable = do
63− md@(MaybeTable _ d) <- optional (g =<< keepRightTable e)
56+ md@(MaybeTable _ d) <- optional (g =<< keepRightTable e)
57+ where_ $ isJustTable mc ==. isLeftTable e
64− where_ $ isJustTable md ==. isRightTable e
58+ where_ $ isJustTable md ==. isRightTable e
65− pure $ rightTable d
59+ pure $ EitherTable tag c d
src/Rel8/Query/These.hs+11−11
@@ -13,7 +13,6 @@ module Rel8.Query.These
13where
13where
14
14
15-- base
15-- base
16−import Data.Bifunctor ( bimap )
17import Prelude
16import Prelude
18
17
19-- opaleye
18-- opaleye
@@ -22,12 +21,13 @@ import qualified Opaleye.Internal.PrimQuery as Opaleye
22
21
23-- rel8
22-- rel8
24import Rel8.Expr ( Expr )
23import Rel8.Expr ( Expr )
25−import Rel8.Expr.Bool ( (&&.), boolExpr, not_ )
24+import Rel8.Expr.Bool ( boolExpr, not_ )
25+import Rel8.Expr.Eq ( (==.) )
26import Rel8.Expr.Opaleye ( toColumn, toPrimExpr )
26import Rel8.Expr.Opaleye ( toColumn, toPrimExpr )
27import Rel8.Expr.Serialize ( litExpr )
27import Rel8.Expr.Serialize ( litExpr )
28import Rel8.Query ( Query )
28import Rel8.Query ( Query )
29import Rel8.Query.Filter ( where_ )
29import Rel8.Query.Filter ( where_ )
30−import Rel8.Query.Maybe ( traverseMaybeTable )
30+import Rel8.Query.Maybe ( optional )
31import Rel8.Query.Opaleye ( zipOpaleyeWith )
31import Rel8.Query.Opaleye ( zipOpaleyeWith )
32import Rel8.Table ( Table )
32import Rel8.Table ( Table )
33import Rel8.Table.Either ( EitherTable( EitherTable ) )
33import Rel8.Table.Either ( EitherTable( EitherTable ) )
@@ -35,6 +35,7 @@ import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
35import Rel8.Table.Opaleye ( unpackspec )
35import Rel8.Table.Opaleye ( unpackspec )
36import Rel8.Table.These
36import Rel8.Table.These
37 ( TheseTable( TheseTable )
37 ( TheseTable( TheseTable )
38+ , hasHereTable, hasThereTable
38 , isThisTable, isThatTable, isThoseTable
39 , isThisTable, isThatTable, isThoseTable
39 )
40 )
40import Rel8.Type.Tag ( EitherTag( IsLeft, IsRight ) )
41import Rel8.Type.Tag ( EitherTag( IsLeft, IsRight ) )
@@ -115,15 +116,14 @@ bindTheseTable query (TheseTable here (MaybeTable input i)) = do
115 pure $ TheseTable (here <> here') (MaybeTable (input <> output) b)
116 pure $ TheseTable (here <> here') (MaybeTable (input <> output) b)
116
117
117
118
118−bitraverseTheseTable :: (Table Expr c, Table Expr d)
119+bitraverseTheseTable :: ()
119 => (a -> Query c)
120 => (a -> Query c)
120 -> (b -> Query d)
121 -> (b -> Query d)
121 -> TheseTable a b
122 -> TheseTable a b
122 -> Query (TheseTable c d)
123 -> Query (TheseTable c d)
123−bitraverseTheseTable f g (TheseTable here there) =
124+bitraverseTheseTable f g t = do
124− bimap fromJustTable fromJustTable <$>
125+ mc <- optional (f . fst =<< keepHereTable t)
125− alignBy (\l r -> isJustTable l &&. isJustTable r)
126+ md <- optional (g . snd =<< keepThereTable t)
126− (traverseMaybeTable f here)
127+ where_ $ isJustTable mc ==. hasHereTable t
127− (traverseMaybeTable g there)
128+ where_ $ isJustTable md ==. hasThereTable t
128− where
129+ pure $ TheseTable mc md
129− fromJustTable (MaybeTable _ a) = a