git.iko.soy/rel8
on master help sign in
Fix bitraverse{Either,These}Table to not need Table constraint
commitbde3d54aace58ad6a8ecc19d87e71c4afc6004ca authorShane O'Brien <shane.obrien@circuithub.com> dateMon 29 Mar 2021, 12:22 (6 years ago) parent6531b02
2 files changed+18−24
compare with master
unifiedsplit
src/Rel8/Query/Either.hs+7−13 src/Rel8/Query/These.hs+11−11
src/Rel8/Query/Either.hs+7−13
@@ -18,12 +18,10 @@ import Rel8.Expr.Eq ( (==.) )
1818import Rel8.Query ( Query )
1919import Rel8.Query.Filter ( where_ )
2020import Rel8.Query.Maybe ( optional )
21−import Rel8.Query.Set ( unionAll )
2221import Rel8.Table ( Table )
2322import Rel8.Table.Bool ( bool )
2423import Rel8.Table.Either
2524 ( EitherTable( EitherTable )
26− , leftTable, rightTable
2725 , isLeftTable, isRightTable
2826 )
2927import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
@@ -48,18 +46,14 @@ bindEitherTable query e@(EitherTable input a i) = do
4846 EitherTable (input <> output) (bool a a' (isRightTable e)) b
4947
5048
51−bitraverseEitherTable :: (Table Expr c, Table Expr d)
49+bitraverseEitherTable :: ()
5250 => (a -> Query c)
5351 -> (b -> Query d)
5452 -> EitherTable a b
5553 -> Query (EitherTable c d)
56−bitraverseEitherTable f g e = traverseLeftTable `unionAll` traverseRightTable
57− where
58− traverseLeftTable = do
59− 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)
64− where_ $ isJustTable md ==. isRightTable e
65− pure $ rightTable d
54+bitraverseEitherTable f g e@(EitherTable tag _ _) = do
55+ mc@(MaybeTable _ c) <- optional (f =<< keepLeftTable e)
56+ md@(MaybeTable _ d) <- optional (g =<< keepRightTable e)
57+ where_ $ isJustTable mc ==. isLeftTable e
58+ where_ $ isJustTable md ==. isRightTable e
59+ pure $ EitherTable tag c d
src/Rel8/Query/These.hs+11−11
@@ -13,7 +13,6 @@ module Rel8.Query.These
1313where
1414
1515-- base
16−import Data.Bifunctor ( bimap )
1716import Prelude
1817
1918-- opaleye
@@ -22,12 +21,13 @@ import qualified Opaleye.Internal.PrimQuery as Opaleye
2221
2322-- rel8
2423import Rel8.Expr ( Expr )
25−import Rel8.Expr.Bool ( (&&.), boolExpr, not_ )
24+import Rel8.Expr.Bool ( boolExpr, not_ )
25+import Rel8.Expr.Eq ( (==.) )
2626import Rel8.Expr.Opaleye ( toColumn, toPrimExpr )
2727import Rel8.Expr.Serialize ( litExpr )
2828import Rel8.Query ( Query )
2929import Rel8.Query.Filter ( where_ )
30−import Rel8.Query.Maybe ( traverseMaybeTable )
30+import Rel8.Query.Maybe ( optional )
3131import Rel8.Query.Opaleye ( zipOpaleyeWith )
3232import Rel8.Table ( Table )
3333import Rel8.Table.Either ( EitherTable( EitherTable ) )
@@ -35,6 +35,7 @@ import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
3535import Rel8.Table.Opaleye ( unpackspec )
3636import Rel8.Table.These
3737 ( TheseTable( TheseTable )
38+ , hasHereTable, hasThereTable
3839 , isThisTable, isThatTable, isThoseTable
3940 )
4041import Rel8.Type.Tag ( EitherTag( IsLeft, IsRight ) )
@@ -115,15 +116,14 @@ bindTheseTable query (TheseTable here (MaybeTable input i)) = do
115116 pure $ TheseTable (here <> here') (MaybeTable (input <> output) b)
116117
117118
118−bitraverseTheseTable :: (Table Expr c, Table Expr d)
119+bitraverseTheseTable :: ()
119120 => (a -> Query c)
120121 -> (b -> Query d)
121122 -> TheseTable a b
122123 -> Query (TheseTable c d)
123−bitraverseTheseTable f g (TheseTable here there) =
124− bimap fromJustTable fromJustTable <$>
125− alignBy (\l r -> isJustTable l &&. isJustTable r)
126− (traverseMaybeTable f here)
127− (traverseMaybeTable g there)
128− where
129− fromJustTable (MaybeTable _ a) = a
124+bitraverseTheseTable f g t = do
125+ mc <- optional (f . fst =<< keepHereTable t)
126+ md <- optional (g . snd =<< keepThereTable t)
127+ where_ $ isJustTable mc ==. hasHereTable t
128+ where_ $ isJustTable md ==. hasThereTable t
129+ pure $ TheseTable mc md