mirror of
https://github.com/circuithub/rel8.git
synced 2024-09-11 16:05:41 +03:00
Document more of EitherTable
This commit is contained in:
parent
4b50256af0
commit
4ec1182dc3
@ -27,18 +27,24 @@ import Rel8.Table.Either
|
||||
import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
|
||||
|
||||
|
||||
-- | Filter 'EitherTable's, keeping only 'leftTable's.
|
||||
keepLeftTable :: EitherTable a b -> Query a
|
||||
keepLeftTable e@(EitherTable _ a _) = do
|
||||
where_ $ isLeftTable e
|
||||
pure a
|
||||
|
||||
|
||||
-- | Filter 'EitherTable's, keeping only 'rightTable's.
|
||||
keepRightTable :: EitherTable a b -> Query b
|
||||
keepRightTable e@(EitherTable _ _ b) = do
|
||||
where_ $ isRightTable e
|
||||
pure b
|
||||
|
||||
|
||||
-- | Extend an 'EitherTable' with a 'Query' if it's a 'rightTable'. If the
|
||||
-- @EitherTable@ is a 'leftTable', the original value is preserved.
|
||||
--
|
||||
-- This is like the '>>=' implementation for @ExceptT@.
|
||||
bindEitherTable :: (Table Expr a, Functor m)
|
||||
=> (i -> m (EitherTable a b)) -> EitherTable a i -> m (EitherTable a b)
|
||||
bindEitherTable query e@(EitherTable input a i) = do
|
||||
@ -46,6 +52,8 @@ bindEitherTable query e@(EitherTable input a i) = do
|
||||
EitherTable (input <> output) (bool a a' (isRightTable e)) b
|
||||
|
||||
|
||||
-- | Extend an 'EitherTable' with queries for both 'leftTable' and
|
||||
-- 'rightTable'.
|
||||
bitraverseEitherTable :: ()
|
||||
=> (a -> Query c)
|
||||
-> (b -> Query d)
|
||||
|
@ -66,6 +66,12 @@ import Data.Functor.Apply ( Apply, (<.>) )
|
||||
import Data.Functor.Bind ( Bind, (>>-) )
|
||||
|
||||
|
||||
-- | An @EitherTable a b@ is a Rel8 table that contains either the table @a@ or
|
||||
-- the table @b@. You can construct an @EitherTable@ using 'leftTable' and
|
||||
-- 'rightTable', and eliminate/pattern match using 'eitherTable'.
|
||||
--
|
||||
-- An @EitherTable@ is operationally the same as Haskell's 'Either' type, but
|
||||
-- adapted to work with Rel8.
|
||||
type EitherTable :: Type -> Type -> Type
|
||||
data EitherTable a b = EitherTable
|
||||
{ tag :: Tag "isRight" EitherTag
|
||||
@ -149,24 +155,30 @@ instance (ToExprs exprs1 a, ToExprs exprs2 b, x ~ EitherTable exprs1 exprs2) =>
|
||||
bimap (toResult @exprs1) (toResult @exprs2)
|
||||
|
||||
|
||||
-- | Test if an 'EitherTable' is a 'leftTable'.
|
||||
isLeftTable :: EitherTable a b -> Expr Bool
|
||||
isLeftTable = isLeft . expr . tag
|
||||
|
||||
|
||||
-- | Test if an 'EitherTable' is a 'rightTable'.
|
||||
isRightTable :: EitherTable a b -> Expr Bool
|
||||
isRightTable = isRight . expr . tag
|
||||
|
||||
|
||||
-- | Pattern match/eliminate an 'EitherTable', by providing mappings from a
|
||||
-- 'leftTable' and 'rightTable'.
|
||||
eitherTable :: Table Expr c
|
||||
=> (a -> c) -> (b -> c) -> EitherTable a b -> c
|
||||
eitherTable f g EitherTable {tag, left, right} =
|
||||
bool (f left) (g right) (isRight (expr tag))
|
||||
|
||||
|
||||
-- | Construct a left 'EitherTable'. Like 'Left'.
|
||||
leftTable :: Table Expr b => a -> EitherTable a b
|
||||
leftTable a = EitherTable (fromExpr (litExpr IsLeft)) a undefined
|
||||
|
||||
|
||||
-- | Construct a right 'EitherTable'. Like 'Right'.
|
||||
rightTable :: Table Expr a => b -> EitherTable a b
|
||||
rightTable = rightTableWith undefined
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user