git.iko.soy/rel8
on f3daaff 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 , 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.Query.Set ( unionAll )
22import Rel8.Table ( Table )
23import Rel8.Table.Bool ( bool )
24import Rel8.Table.Either
25 ( EitherTable( EitherTable )
26 , leftTable, rightTable
27 , isLeftTable, isRightTable
28 )
29import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
32keepLeftTable :: EitherTable a b -> Query a
33keepLeftTable e@(EitherTable _ a _) = do
34 where_ $ isLeftTable e
35 pure a
38keepRightTable :: EitherTable a b -> Query b
39keepRightTable e@(EitherTable _ _ b) = do
40 where_ $ isRightTable e
41 pure b
44bindEitherTable :: (Table Expr a, Functor m)
45 => (i -> m (EitherTable a b)) -> EitherTable a i -> m (EitherTable a b)
46bindEitherTable query e@(EitherTable input a i) = do
47 query i <&> \(EitherTable output a' b) ->
48 EitherTable (input <> output) (bool a a' (isRightTable e)) b
51bitraverseEitherTable :: (Table Expr c, Table Expr d)
52 => (a -> Query c)
53 -> (b -> Query d)
54 -> EitherTable a b
55 -> Query (EitherTable c d)
56bitraverseEitherTable f g e = traverseLeftTable `unionAll` traverseRightTable
57 where
58 traverseLeftTable = do
59 mc@(MaybeTable _ c) <- optional (f =<< keepLeftTable e)
60 where_ $ isJustTable mc ==. isLeftTable e
61 pure $ leftTable c
62 traverseRightTable = do
63 md@(MaybeTable _ d) <- optional (g =<< keepRightTable e)
64 where_ $ isJustTable md ==. isRightTable e
65 pure $ rightTable d