git.iko.soy/rel8
on 5a47018 help sign in
rel8/src/Rel8/Query/Maybe.hs
66 lines 2.2 kB history raw
1{-# language GADTs #-}
2{-# language NamedFieldPuns #-}
4module Rel8.Query.Maybe
5 ( optional
6 , catMaybeTable
7 , traverseMaybeTable
8 )
9where
11-- base
12import Prelude
14-- comonad
15import Control.Comonad ( extract )
17-- opaleye
18import qualified Opaleye.Internal.MaybeFields as Opaleye
20-- rel8
21import Rel8.Expr ( Col( E ), Expr )
22import Rel8.Expr.Eq ( (==.) )
23import Rel8.Expr.Opaleye ( fromColumn, fromPrimExpr )
24import Rel8.Query ( Query )
25import Rel8.Query.Filter ( where_ )
26import Rel8.Query.Opaleye ( mapOpaleye )
27import Rel8.Table.Maybe ( MaybeTable(..), isJustTable )
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 Expr a)
36optional = mapOpaleye $ Opaleye.optionalInternal $ \tag a -> MaybeTable
37 { tag = E $ fromPrimExpr $ fromColumn tag
38 , just = pure a
39 }
42-- | Filter out 'MaybeTable's, returning only the tables that are not-null.
43--
44-- This operation can be used to "undo" the effect of 'optional', which
45-- operationally is like turning a @LEFT JOIN@ back into a full @JOIN@. You
46-- can think of this as analogous to 'Data.Maybe.catMaybes'.
47catMaybeTable :: MaybeTable Expr a -> Query a
48catMaybeTable ma@(MaybeTable _ a) = do
49 where_ $ isJustTable ma
50 pure (extract a)
53-- | Extend an optional query with another query. This is useful if you want
54-- to step through multiple @LEFT JOINs@.
55--
56-- Note that @traverseMaybeTable@ takes a @a -> Query b@ function, which means
57-- you also have the ability to "expand" one row into multiple rows. If the
58-- @a -> Query b@ function returns no rows, then the resulting query will also
59-- have no rows. However, regardless of the given @a -> Query b@ function, if
60-- the input is @nothingTable@, you will always get exactly one @nothingTable@
61-- back.
62traverseMaybeTable :: (a -> Query b) -> MaybeTable Expr a -> Query (MaybeTable Expr b)
63traverseMaybeTable query ma@(MaybeTable (E input) _) = do
64 MaybeTable (E output) b <- optional (query =<< catMaybeTable ma)
65 where_ $ output ==. input
66 pure $ MaybeTable (E input) b