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