git.iko.soy/rel8
on master help sign in
Document more of EitherTable
4ec1182Ollie Charles
src/Rel8/Query/Either.hs+8
compare with master
unifiedsplit
@@ -27,18 +27,24 @@ import Rel8.Table.Either
27import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
27import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
28
28
29
29
30+-- | Filter 'EitherTable's, keeping only 'leftTable's.
30keepLeftTable :: EitherTable a b -> Query a
31keepLeftTable :: EitherTable a b -> Query a
31keepLeftTable e@(EitherTable _ a _) = do
32keepLeftTable e@(EitherTable _ a _) = do
32 where_ $ isLeftTable e
33 where_ $ isLeftTable e
33 pure a
34 pure a
34
35
35
36
37+-- | Filter 'EitherTable's, keeping only 'rightTable's.
36keepRightTable :: EitherTable a b -> Query b
38keepRightTable :: EitherTable a b -> Query b
37keepRightTable e@(EitherTable _ _ b) = do
39keepRightTable e@(EitherTable _ _ b) = do
38 where_ $ isRightTable e
40 where_ $ isRightTable e
39 pure b
41 pure b
40
42
41
43
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@.
42bindEitherTable :: (Table Expr a, Functor m)
48bindEitherTable :: (Table Expr a, Functor m)
43 => (i -> m (EitherTable a b)) -> EitherTable a i -> m (EitherTable a b)
49 => (i -> m (EitherTable a b)) -> EitherTable a i -> m (EitherTable a b)
44bindEitherTable query e@(EitherTable input a i) = do
50bindEitherTable query e@(EitherTable input a i) = do
@@ -46,6 +52,8 @@ bindEitherTable query e@(EitherTable input a i) = do
46 EitherTable (input <> output) (bool a a' (isRightTable e)) b
52 EitherTable (input <> output) (bool a a' (isRightTable e)) b
47
53
48
54
55+-- | Extend an 'EitherTable' with queries for both 'leftTable' and
56+-- 'rightTable'.
49bitraverseEitherTable :: ()
57bitraverseEitherTable :: ()
50 => (a -> Query c)
58 => (a -> Query c)
51 -> (b -> Query d)
59 -> (b -> Query d)
src/Rel8/Table/Either.hs+12
@@ -66,6 +66,12 @@ import Data.Functor.Apply ( Apply, (<.>) )
66import Data.Functor.Bind ( Bind, (>>-) )
66import Data.Functor.Bind ( Bind, (>>-) )
67
67
68
68
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.
69type EitherTable :: Type -> Type -> Type
75type EitherTable :: Type -> Type -> Type
70data EitherTable a b = EitherTable
76data EitherTable a b = EitherTable
71 { tag :: Tag "isRight" EitherTag
77 { tag :: Tag "isRight" EitherTag
@@ -149,24 +155,30 @@ instance (ToExprs exprs1 a, ToExprs exprs2 b, x ~ EitherTable exprs1 exprs2) =>
149 bimap (toResult @exprs1) (toResult @exprs2)
155 bimap (toResult @exprs1) (toResult @exprs2)
150
156
151
157
158+-- | Test if an 'EitherTable' is a 'leftTable'.
152isLeftTable :: EitherTable a b -> Expr Bool
159isLeftTable :: EitherTable a b -> Expr Bool
153isLeftTable = isLeft . expr . tag
160isLeftTable = isLeft . expr . tag
154
161
155
162
163+-- | Test if an 'EitherTable' is a 'rightTable'.
156isRightTable :: EitherTable a b -> Expr Bool
164isRightTable :: EitherTable a b -> Expr Bool
157isRightTable = isRight . expr . tag
165isRightTable = isRight . expr . tag
158
166
159
167
168+-- | Pattern match/eliminate an 'EitherTable', by providing mappings from a
169+-- 'leftTable' and 'rightTable'.
160eitherTable :: Table Expr c
170eitherTable :: Table Expr c
161 => (a -> c) -> (b -> c) -> EitherTable a b -> c
171 => (a -> c) -> (b -> c) -> EitherTable a b -> c
162eitherTable f g EitherTable {tag, left, right} =
172eitherTable f g EitherTable {tag, left, right} =
163 bool (f left) (g right) (isRight (expr tag))
173 bool (f left) (g right) (isRight (expr tag))
164
174
165
175
176+-- | Construct a left 'EitherTable'. Like 'Left'.
166leftTable :: Table Expr b => a -> EitherTable a b
177leftTable :: Table Expr b => a -> EitherTable a b
167leftTable a = EitherTable (fromExpr (litExpr IsLeft)) a undefined
178leftTable a = EitherTable (fromExpr (litExpr IsLeft)) a undefined
168
179
169
180
181+-- | Construct a right 'EitherTable'. Like 'Right'.
170rightTable :: Table Expr a => b -> EitherTable a b
182rightTable :: Table Expr a => b -> EitherTable a b
171rightTable = rightTableWith undefined
183rightTable = rightTableWith undefined
172
184