git.iko.soy/rel8
on 28aaa76 help sign in
rel8/src/Rel8/Query/Either.hs
59 lines 1.5 kB history raw
1{-# language FlexibleContexts #-}
3module Rel8.Query.Either
4 ( keepLeftTable
5 , keepRightTable
6 , bindEitherTable
7 , bitraverseEitherTable
8 )
9where
11-- base
12import Data.Functor ( (<&>) )
13import Prelude
15-- rel8
16import Rel8.Expr ( Expr )
17import Rel8.Expr.Eq ( (==.) )
18import Rel8.Query ( Query )
19import Rel8.Query.Filter ( where_ )
20import Rel8.Query.Maybe ( optional )
21import Rel8.Table ( Table )
22import Rel8.Table.Bool ( bool )
23import Rel8.Table.Either
24 ( EitherTable( EitherTable )
25 , isLeftTable, isRightTable
26 )
27import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
30keepLeftTable :: EitherTable a b -> Query a
31keepLeftTable e@(EitherTable _ a _) = do
32 where_ $ isLeftTable e
33 pure a
36keepRightTable :: EitherTable a b -> Query b
37keepRightTable e@(EitherTable _ _ b) = do
38 where_ $ isRightTable e
39 pure b
42bindEitherTable :: (Table Expr a, Functor m)
43 => (i -> m (EitherTable a b)) -> EitherTable a i -> m (EitherTable a b)
44bindEitherTable query e@(EitherTable input a i) = do
45 query i <&> \(EitherTable output a' b) ->
46 EitherTable (input <> output) (bool a a' (isRightTable e)) b
49bitraverseEitherTable :: ()
50 => (a -> Query c)
51 -> (b -> Query d)
52 -> EitherTable a b
53 -> Query (EitherTable c d)
54bitraverseEitherTable 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