git.iko.soy/rel8
on fce7213 help sign in
rel8/src/Rel8/Query/Either.hs
64 lines 1.7 kB history raw
1{-# language FlexibleContexts #-}
3module Rel8.Query.Either
4 ( keepLeftTable
5 , keepRightTable
6 , bindEitherTable
7 , bitraverseEitherTable
8 )
9where
11-- base
12import Prelude
14-- rel8
15import Rel8.Expr.Eq ( (==.) )
16import Rel8.Query ( Query )
17import Rel8.Query.Filter ( where_ )
18import Rel8.Query.Maybe ( optional )
19import Rel8.Query.Set ( unionAll )
20import Rel8.Schema.Context ( DB )
21import Rel8.Table ( Table )
22import Rel8.Table.Bool ( bool )
23import Rel8.Table.Either
24 ( EitherTable( EitherTable )
25 , leftTable, rightTable
26 , isLeftTable, isRightTable
27 )
28import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
31keepLeftTable :: EitherTable a b -> Query a
32keepLeftTable e@(EitherTable _ a _) = do
33 where_ $ isLeftTable e
34 pure a
37keepRightTable :: EitherTable a b -> Query b
38keepRightTable e@(EitherTable _ _ b) = do
39 where_ $ isRightTable e
40 pure b
43bindEitherTable :: (Table DB a, Monad m)
44 => (i -> m (EitherTable a b)) -> EitherTable a i -> m (EitherTable a b)
45bindEitherTable query e@(EitherTable input a i) = do
46 EitherTable output a' b <- query i
47 pure $ EitherTable (input <> output) (bool a a' (isRightTable e)) b
50bitraverseEitherTable :: (Table DB c, Table DB d)
51 => (a -> Query c)
52 -> (b -> Query d)
53 -> EitherTable a b
54 -> Query (EitherTable c d)
55bitraverseEitherTable f g e = traverseLeftTable `unionAll` traverseRightTable
56 where
57 traverseLeftTable = do
58 mc@(MaybeTable _ c) <- optional (f =<< keepLeftTable e)
59 where_ $ isJustTable mc ==. isLeftTable e
60 pure $ leftTable c
61 traverseRightTable = do
62 md@(MaybeTable _ d) <- optional (g =<< keepRightTable e)
63 where_ $ isJustTable md ==. isRightTable e
64 pure $ rightTable d