git.iko.soy/rel8
on 707a36a help sign in
rel8/src/Rel8/Query/Either.hs
66 lines 1.8 kB history raw
1{-# language FlexibleContexts #-}
3module Rel8.Query.Either
4 ( keepLeftTable
5 , keepRightTable
6 , bitraverseEitherTable
7 )
8where
10-- base
11import Prelude
13-- rel8
14import Rel8.Expr ( Expr )
15import Rel8.Expr.Eq ( (==.) )
16import Rel8.Query ( Query )
17import Rel8.Query.Filter ( where_ )
18import Rel8.Query.Maybe ( optional )
19import Rel8.Table.Either
20 ( EitherTable( EitherTable )
21 , isLeftTable, isRightTable
22 )
23import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
26-- | Filter 'EitherTable's, keeping only 'leftTable's.
27keepLeftTable :: EitherTable Expr a b -> Query a
28keepLeftTable e@(EitherTable _ a _) = do
29 where_ $ isLeftTable e
30 pure a
33-- | Filter 'EitherTable's, keeping only 'rightTable's.
34keepRightTable :: EitherTable Expr a b -> Query b
35keepRightTable e@(EitherTable _ _ b) = do
36 where_ $ isRightTable e
37 pure b
40-- | @bitraverseEitherTable f g x@ will pass all @leftTable@s through @f@ and
41-- all @rightTable@s through @g@. The results are then lifted back into
42-- @leftTable@ and @rightTable@, respectively. This is similar to 'bitraverse'
43-- for 'Either'.
44--
45-- For example,
46--
47-- >>> :{
48-- select do
49-- x <- values (map lit [ Left True, Right (42 :: Int32) ])
50-- bitraverseEitherTable (\y -> values [y, not_ y]) (\y -> pure (y * 100)) x
51-- :}
52-- [ Left True
53-- , Left False
54-- , Right 4200
55-- ]
56bitraverseEitherTable :: ()
57 => (a -> Query c)
58 -> (b -> Query d)
59 -> EitherTable Expr a b
60 -> Query (EitherTable Expr c d)
61bitraverseEitherTable f g e@(EitherTable tag _ _) = do
62 mc@(MaybeTable _ c) <- optional (f =<< keepLeftTable e)
63 md@(MaybeTable _ d) <- optional (g =<< keepRightTable e)
64 where_ $ isJustTable mc ==. isLeftTable e
65 where_ $ isJustTable md ==. isRightTable e
66 pure $ EitherTable tag c d