git.iko.soy/rel8
on 2a36dbe help sign in
rel8/src/Rel8/Query/Maybe.hs
138 lines 4.9 kB history raw
1module Rel8.Query.Maybe
2 ( optional
3 , catMaybeTable
4 , bindMaybeTable
5 , traverseMaybeTable
6 )
7where
9-- base
10import Prelude
12-- opaleye
13import qualified Opaleye.Internal.PackMap as Opaleye
14import qualified Opaleye.Internal.PrimQuery as Opaleye
15import qualified Opaleye.Internal.QueryArr as Opaleye
16import qualified Opaleye.Internal.Tag as Opaleye
17import qualified Opaleye.Internal.Unpackspec as Opaleye
19-- rel8
20import Rel8.Expr.Bool ( true )
21import Rel8.Expr.Eq ( (==.) )
22import Rel8.Expr.Opaleye ( toPrimExpr )
23import Rel8.Query ( Query )
24import Rel8.Query.Filter ( where_ )
25import Rel8.Query.Opaleye ( mapOpaleye )
26import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
27import Rel8.Table.Opaleye ( unpackspec )
28import Rel8.Table.Tag ( Tag(..), fromExpr )
31optional :: Query a -> Query (MaybeTable a)
32optional = mapOpaleye $ Opaleye.QueryArr . go
33 where
34 go query (i, left, tag) =
35 (MaybeTable (fromExpr t') a, join, Opaleye.next tag')
36 where
37 (MaybeTable Tag {expr = t} a, right, tag') =
38 Opaleye.runSimpleQueryArr (pure <$> query) (i, tag)
39 (t', bindings) = Opaleye.run $
40 Opaleye.runUnpackspec unpackspec (Opaleye.extractAttr "maybe" tag') t
41 join = Opaleye.Join Opaleye.LeftJoin condition [] bindings left right
42 condition = toPrimExpr true
45-- | Filter out 'MaybeTable's, returning only the tables that are not-null.
46--
47-- This operation can be used to "undo" the effect of 'optional', which
48-- operationally is like turning a @LEFT JOIN@ back into a full @JOIN@. You
49-- can think of this as analogous to 'Data.Maybe.catMaybes'.
50--
51-- To see this in action, first consider the following 'optional' query:
52--
53-- >>> :{
54-- select c $ do
55-- author <- each authorSchema
56-- maybeRel8 <- optional $
57-- each projectSchema
58-- >>= filter (\p -> projectAuthorId p ==. authorId author)
59-- >>= filter (\p -> projectName p ==. "rel8")
60-- return (authorName author, projectName <$> maybeRel8)
61-- :}
62-- [("Ollie",Just "rel8"),("Bryan O'Sullivan",Nothing),("Emily Pillmore",Nothing)]
63--
64-- Here @optional@ is acting as a @LEFT JOIN@. We can turn this into a proper
65-- join by using @catMaybeTable@ to filter out rows where the join failed:
66--
67-- >>> :{
68-- select c $ do
69-- author <- each authorSchema
70-- maybeRel8 <- optional $
71-- each projectSchema
72-- >>= filter (\p -> projectAuthorId p ==. authorId author)
73-- >>= filter (\p -> projectName p ==. "rel8")
74-- rel8 <- catMaybeTable maybeRel8
75-- return (authorName author, projectName rel8)
76-- :}
77-- [("Ollie","rel8")]
78catMaybeTable :: MaybeTable a -> Query a
79catMaybeTable ma@(MaybeTable _ a) = do
80 where_ $ isJustTable ma
81 pure a
84-- | @bindMaybeTable f x@ is similar to the monadic bind (@>>=@) operation. It
85-- allows you to "extend" an optional query with another query. If either the
86-- input or output are 'noTable', then the result is 'noTable'.
87--
88-- This is similar to 'traverseMaybeTable', followed by a @join@ on the
89-- resulting @MaybeTable@s.
90--
91-- >>> select c $ bindMaybeTable (optional . values . pure . not_) =<< optional (values [lit True])
92-- [Just False]
93--
94-- >>> select c $ bindMaybeTable (\_ -> return (noTable :: MaybeTable (Expr Bool))) =<< optional (values [lit True])
95-- [Nothing]
96--
97-- >>> select c $ bindMaybeTable (optional . values . pure . not_) =<< return (noTable :: MaybeTable (Expr Bool))
98-- [Nothing]
99bindMaybeTable :: Monad m
100 => (a -> m (MaybeTable b)) -> MaybeTable a -> m (MaybeTable b)
101bindMaybeTable query (MaybeTable input a) = do
102 MaybeTable output b <- query a
103 pure $ MaybeTable (input <> output) b
106-- | Extend an optional query with another query. This is useful if you want
107-- to step through multiple @LEFT JOINs@.
108--
109-- Note that @traverseMaybeTable@ takes a @a -> Query b@ function, which means
110-- you also have the ability to "expand" one row into multiple rows.
111--
112-- >>> :{
113-- duplicate :: Expr Bool -> Query (Expr Bool)
114-- duplicate x = unionAll (return x) (return x)
115-- :}
116--
117-- >>> select c $ traverseMaybeTable duplicate =<< optional (values [lit True])
118-- [Just True,Just True]
119--
120-- Note that if the @a -> Query b@ function returns no rows, then the resulting
121-- query will also have no rows:
122--
123-- >>> select c $ traverseMaybeTable (limit 0 . pure) =<< optional (values [lit True])
124-- []
125--
126-- However, regardless of the given @a -> Query b@ function, if the input is
127-- @noTable@, you will always get exactly one @noTable@ back:
128--
129-- >>> select c $ traverseMaybeTable duplicate (noTable :: MaybeTable (Expr Bool))
130-- [Nothing]
131--
132-- >>> select c $ traverseMaybeTable (limit 0 . pure) (noTable :: MaybeTable (Expr Bool))
133-- [Nothing]
134traverseMaybeTable :: (a -> Query b) -> MaybeTable a -> Query (MaybeTable b)
135traverseMaybeTable query ma@(MaybeTable input _) = do
136 MaybeTable output b <- optional (query =<< catMaybeTable ma)
137 where_ $ expr output ==. expr input
138 pure $ MaybeTable input b