git.iko.soy/rel8
on master help sign in
Document more of EitherTable
commit4ec1182dc35ce9f725811768155a81e702f14f18 authorOllie Charles <ollie@ocharles.org.uk> dateFri 18 Jun 2021, 11:23 (5 years ago) parent4b50256
2 files changed+20
compare with master
unifiedsplit
src/Rel8/Query/Either.hs+8 src/Rel8/Table/Either.hs+12
src/Rel8/Query/Either.hs+8
@@ -27,18 +27,24 @@ import Rel8.Table.Either
2727import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
2828
2929
30+-- | Filter 'EitherTable's, keeping only 'leftTable's.
3031keepLeftTable :: EitherTable a b -> Query a
3132keepLeftTable e@(EitherTable _ a _) = do
3233 where_ $ isLeftTable e
3334 pure a
3435
3536
37+-- | Filter 'EitherTable's, keeping only 'rightTable's.
3638keepRightTable :: EitherTable a b -> Query b
3739keepRightTable e@(EitherTable _ _ b) = do
3840 where_ $ isRightTable e
3941 pure b
4042
4143
44+-- | Extend an 'EitherTable' with a 'Query' if it's a 'rightTable'. If the
45+-- @EitherTable@ is a 'leftTable', the original value is preserved.
46+--
47+-- This is like the '>>=' implementation for @ExceptT@.
4248bindEitherTable :: (Table Expr a, Functor m)
4349 => (i -> m (EitherTable a b)) -> EitherTable a i -> m (EitherTable a b)
4450bindEitherTable query e@(EitherTable input a i) = do
@@ -46,6 +52,8 @@ bindEitherTable query e@(EitherTable input a i) = do
4652 EitherTable (input <> output) (bool a a' (isRightTable e)) b
4753
4854
55+-- | Extend an 'EitherTable' with queries for both 'leftTable' and
56+-- 'rightTable'.
4957bitraverseEitherTable :: ()
5058 => (a -> Query c)
5159 -> (b -> Query d)
src/Rel8/Table/Either.hs+12
@@ -66,6 +66,12 @@ import Data.Functor.Apply ( Apply, (<.>) )
6666import Data.Functor.Bind ( Bind, (>>-) )
6767
6868
69+-- | An @EitherTable a b@ is a Rel8 table that contains either the table @a@ or
70+-- the table @b@. You can construct an @EitherTable@ using 'leftTable' and
71+-- 'rightTable', and eliminate/pattern match using 'eitherTable'.
72+--
73+-- An @EitherTable@ is operationally the same as Haskell's 'Either' type, but
74+-- adapted to work with Rel8.
6975type EitherTable :: Type -> Type -> Type
7076data EitherTable a b = EitherTable
7177 { tag :: Tag "isRight" EitherTag
@@ -149,24 +155,30 @@ instance (ToExprs exprs1 a, ToExprs exprs2 b, x ~ EitherTable exprs1 exprs2) =>
149155 bimap (toResult @exprs1) (toResult @exprs2)
150156
151157
158+-- | Test if an 'EitherTable' is a 'leftTable'.
152159isLeftTable :: EitherTable a b -> Expr Bool
153160isLeftTable = isLeft . expr . tag
154161
155162
163+-- | Test if an 'EitherTable' is a 'rightTable'.
156164isRightTable :: EitherTable a b -> Expr Bool
157165isRightTable = isRight . expr . tag
158166
159167
168+-- | Pattern match/eliminate an 'EitherTable', by providing mappings from a
169+-- 'leftTable' and 'rightTable'.
160170eitherTable :: Table Expr c
161171 => (a -> c) -> (b -> c) -> EitherTable a b -> c
162172eitherTable f g EitherTable {tag, left, right} =
163173 bool (f left) (g right) (isRight (expr tag))
164174
165175
176+-- | Construct a left 'EitherTable'. Like 'Left'.
166177leftTable :: Table Expr b => a -> EitherTable a b
167178leftTable a = EitherTable (fromExpr (litExpr IsLeft)) a undefined
168179
169180
181+-- | Construct a right 'EitherTable'. Like 'Right'.
170182rightTable :: Table Expr a => b -> EitherTable a b
171183rightTable = rightTableWith undefined
172184