git.iko.soy/rel8
on 70ce05d help sign in
rel8/src/Rel8/Query/Maybe.hs
72 lines 2.6 kB history raw
1module Rel8.Query.Maybe
2 ( optional
3 , catMaybeTable
4 , traverseMaybeTable
5 )
6where
8-- base
9import Prelude
11-- opaleye
12import qualified Opaleye.Internal.PackMap as Opaleye
13import qualified Opaleye.Internal.PrimQuery as Opaleye
14import qualified Opaleye.Internal.QueryArr as Opaleye
15import qualified Opaleye.Internal.Tag as Opaleye
17-- rel8
18import Rel8.Expr.Bool ( true )
19import Rel8.Expr.Eq ( (==.) )
20import Rel8.Expr.Opaleye ( toPrimExpr, traversePrimExpr )
21import Rel8.Query ( Query )
22import Rel8.Query.Filter ( where_ )
23import Rel8.Query.Opaleye ( mapOpaleye )
24import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
25import Rel8.Table.Tag ( Tag(..), fromExpr )
28-- | Convert a query that might return zero rows to a query that always returns
29-- at least one row.
30--
31-- To speak in more concrete terms, 'optional' is most useful to write @LEFT
32-- JOIN@s.
33optional :: Query a -> Query (MaybeTable a)
34optional = mapOpaleye $ \query -> Opaleye.QueryArr $ \i -> case i of
35 (_, left, tag) -> (ma', join, tag'')
36 where
37 (ma, right, tag') = Opaleye.runSimpleQueryArr (pure <$> query) ((), tag)
38 MaybeTable Tag {expr = just} a = ma
39 (just', bindings) = Opaleye.run $ do
40 traversePrimExpr (Opaleye.extractAttr "isJust" tag') just
41 tag'' = Opaleye.next tag'
42 join = Opaleye.Join Opaleye.LeftJoin on [] bindings left right
43 where
44 on = toPrimExpr true
45 ma' = MaybeTable (fromExpr just') a
48-- | Filter out 'MaybeTable's, returning only the tables that are not-null.
49--
50-- This operation can be used to "undo" the effect of 'optional', which
51-- operationally is like turning a @LEFT JOIN@ back into a full @JOIN@. You
52-- can think of this as analogous to 'Data.Maybe.catMaybes'.
53catMaybeTable :: MaybeTable a -> Query a
54catMaybeTable ma@(MaybeTable _ a) = do
55 where_ $ isJustTable ma
56 pure a
59-- | Extend an optional query with another query. This is useful if you want
60-- to step through multiple @LEFT JOINs@.
61--
62-- Note that @traverseMaybeTable@ takes a @a -> Query b@ function, which means
63-- you also have the ability to "expand" one row into multiple rows. If the
64-- @a -> Query b@ function returns no rows, then the resulting query will also
65-- have no rows. However, regardless of the given @a -> Query b@ function, if
66-- the input is @nothingTable@, you will always get exactly one @nothingTable@
67-- back.
68traverseMaybeTable :: (a -> Query b) -> MaybeTable a -> Query (MaybeTable b)
69traverseMaybeTable query ma@(MaybeTable input _) = do
70 MaybeTable output b <- optional (query =<< catMaybeTable ma)
71 where_ $ expr output ==. expr input
72 pure $ MaybeTable input b