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