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