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