on master help sign in
Remove bind*Table
commit421fe3ff76ae8d378e1a3767f0f695ad821e9bae authorShane O'Brien <shane.obrien@circuithub.com> dateFri 18 Jun 2021, 17:18 (5 years ago) parentbff98fe
5 files changed+3−45
src/Rel8.hs−3 src/Rel8/Query/Either.hs−16 src/Rel8/Query/Maybe.hs−15 src/Rel8/Query/These.hs+2−9 src/Rel8/Table/Maybe.hs+1−2
src/Rel8.hs−3
@@ -56,7 +56,6 @@ module Rel8
5656 , isNothingTable, isJustTable
5757 , optional
5858 , catMaybeTable
59− , bindMaybeTable
6059 , traverseMaybeTable
6160 , nameMaybeTable
6261
@@ -66,7 +65,6 @@ module Rel8
6665 , isLeftTable, isRightTable
6766 , keepLeftTable
6867 , keepRightTable
69− , bindEitherTable
7068 , bitraverseEitherTable
7169 , nameEitherTable
7270
@@ -82,7 +80,6 @@ module Rel8
8280 , keepThisTable, loseThisTable
8381 , keepThatTable, loseThatTable
8482 , keepThoseTable, loseThoseTable
85− , bindTheseTable
8683 , bitraverseTheseTable
8784 , nameTheseTable
8885
src/Rel8/Query/Either.hs−16
@@ -3,23 +3,18 @@
33module Rel8.Query.Either
44 ( keepLeftTable
55 , keepRightTable
6− , bindEitherTable
76 , bitraverseEitherTable
87 )
98where
109
1110-- base
12−import Data.Functor ( (<&>) )
1311import Prelude
1412
1513-- rel8
16−import Rel8.Expr ( Expr )
1714import Rel8.Expr.Eq ( (==.) )
1815import Rel8.Query ( Query )
1916import Rel8.Query.Filter ( where_ )
2017import Rel8.Query.Maybe ( optional )
21−import Rel8.Table ( Table )
22−import Rel8.Table.Bool ( bool )
2318import Rel8.Table.Either
2419 ( EitherTable( EitherTable )
2520 , isLeftTable, isRightTable
@@ -41,17 +36,6 @@ keepRightTable e@(EitherTable _ _ b) = do
4136 pure b
4237
4338
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@.
48−bindEitherTable :: (Table Expr a, Functor m)
49− => (i -> m (EitherTable a b)) -> EitherTable a i -> m (EitherTable a b)
50−bindEitherTable query e@(EitherTable input a i) = do
51− query i <&> \(EitherTable output a' b) ->
52− EitherTable (input <> output) (bool a a' (isRightTable e)) b
53−
54−
5539-- | @bitraverseEitherTable f g x@ will pass all @leftTable@s through @f@ and
5640-- all @rightTable@s through @g@. The results are then lifted back into
5741-- @leftTable@ and @rightTable@, respectively. This is similar to 'bitraverse'
src/Rel8/Query/Maybe.hs−15
@@ -1,13 +1,11 @@
11module Rel8.Query.Maybe
22 ( optional
33 , catMaybeTable
4− , bindMaybeTable
54 , traverseMaybeTable
65 )
76where
87
98-- base
10−import Data.Functor ( (<&>) )
119import Prelude
1210
1311-- opaleye
@@ -59,19 +57,6 @@ catMaybeTable ma@(MaybeTable _ a) = do
5957 pure a
6058
6159
62−-- | @bindMaybeTable f x@ is similar to the monadic bind (@>>=@) operation. It
63−-- allows you to "extend" an optional query with another query. If either the
64−-- input or output are 'Rel8.nothingTable', then the result is
65−-- 'Rel8.nothingTable'.
66−--
67−-- This is similar to 'traverseMaybeTable', followed by a @join@ on the
68−-- resulting @MaybeTable@s.
69−bindMaybeTable :: Functor m
70− => (a -> m (MaybeTable b)) -> MaybeTable a -> m (MaybeTable b)
71−bindMaybeTable query (MaybeTable input a) =
72− query a <&> \(MaybeTable output b) -> MaybeTable (input <> output) b
73−
74−
7560-- | Extend an optional query with another query. This is useful if you want
7661-- to step through multiple @LEFT JOINs@.
7762--
src/Rel8/Query/These.hs+2−9
@@ -7,13 +7,11 @@ module Rel8.Query.These
77 , keepThisTable, loseThisTable
88 , keepThatTable, loseThatTable
99 , keepThoseTable, loseThoseTable
10− , bindTheseTable
1110 , bitraverseTheseTable
1211 )
1312where
1413
1514-- base
16−import Data.Functor ( (<&>) )
1715import Prelude
1816
1917-- opaleye
@@ -57,10 +55,12 @@ alignBy condition as bs =
5755 on = toColumn . toPrimExpr . uncurry condition
5856
5957
58+-- | Filter 'TheseTable's, keeping only 'thisTable's and 'thoseTable's.
6059keepHereTable :: TheseTable a b -> Query (a, MaybeTable b)
6160keepHereTable = loseThatTable
6261
6362
63+-- | Filter 'TheseTable's, keeping on
6464loseHereTable :: TheseTable a b -> Query b
6565loseHereTable = keepThatTable
6666
@@ -112,13 +112,6 @@ loseThoseTable t@(TheseTable (MaybeTable _ a) (MaybeTable _ b)) = do
112112 result = (mempty `asTypeOf` result) {expr = tag}
113113
114114
115−bindTheseTable :: (Table Expr a, Semigroup a, Functor m)
116− => (i -> m (TheseTable a b)) -> TheseTable a i -> m (TheseTable a b)
117−bindTheseTable query (TheseTable here (MaybeTable input i)) =
118− query i <&> \(TheseTable here' (MaybeTable output b)) ->
119− TheseTable (here <> here') (MaybeTable (input <> output) b)
120−
121−
122115bitraverseTheseTable :: ()
123116 => (a -> Query c)
124117 -> (b -> Query d)
src/Rel8/Table/Maybe.hs+1−2
@@ -101,8 +101,7 @@ instance Bind MaybeTable where
101101 MaybeTable tag' b -> MaybeTable (tag <> tag') b
102102
103103
104−-- | Has the same behavior as the @Monad@ instance for @Maybe@. See also:
105−-- 'Rel8.bindMaybeTable'.
104+-- | Has the same behavior as the @Monad@ instance for @Maybe@.
106105instance Monad MaybeTable where
107106 (>>=) = (>>-)
108107