git.iko.soy/rel8
on da76712 help sign in
rel8/src/Rel8/Query/List.hs
122 lines 4.3 kB history raw
1{-# language FlexibleContexts #-}
2{-# language GADTs #-}
3{-# language NamedFieldPuns #-}
5module Rel8.Query.List
6 ( many, some
7 , manyExpr, someExpr
8 , catListTable, catNonEmptyTable
9 , catList, catNonEmpty
10 )
11where
13-- base
14import Data.Functor.Identity ( runIdentity )
15import Data.List.NonEmpty ( NonEmpty )
16import Prelude
18-- opaleye
19import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
21-- rel8
22import Rel8.Expr ( Expr )
23import Rel8.Expr.Aggregate ( listAggExpr, nonEmptyAggExpr )
24import Rel8.Expr.Opaleye ( mapPrimExpr )
25import Rel8.Query ( Query )
26import Rel8.Query.Aggregate ( aggregate )
27import Rel8.Query.Maybe ( optional )
28import Rel8.Query.Rebind ( rebind )
29import Rel8.Schema.HTable.Vectorize ( hunvectorize )
30import Rel8.Schema.Null ( Sql, Unnullify )
31import Rel8.Schema.Spec ( Spec( Spec, info ) )
32import Rel8.Table ( Table, fromColumns )
33import Rel8.Table.Cols ( toCols )
34import Rel8.Table.Aggregate ( listAgg, nonEmptyAgg )
35import Rel8.Table.List ( ListTable( ListTable ) )
36import Rel8.Table.Maybe ( maybeTable )
37import Rel8.Table.NonEmpty ( NonEmptyTable( NonEmptyTable ) )
38import Rel8.Type ( DBType, typeInformation )
39import Rel8.Type.Array ( extractArrayElement )
40import Rel8.Type.Information ( TypeInformation )
43-- | Aggregate a 'Query' into a 'ListTable'. If the supplied query returns 0
44-- rows, this function will produce a 'Query' that returns one row containing
45-- the empty @ListTable@. If the supplied @Query@ does return rows, @many@ will
46-- return exactly one row, with a @ListTable@ collecting all returned rows.
47--
48-- @many@ is analogous to 'Control.Applicative.many' from
49-- @Control.Applicative@.
50many :: Table Expr a => Query a -> Query (ListTable Expr a)
51many =
52 fmap (maybeTable mempty (\(ListTable a) -> ListTable a)) .
53 optional .
54 aggregate .
55 fmap (listAgg . toCols)
58-- | Aggregate a 'Query' into a 'NonEmptyTable'. If the supplied query returns
59-- 0 rows, this function will produce a 'Query' that is empty - that is, will
60-- produce zero @NonEmptyTable@s. If the supplied @Query@ does return rows,
61-- @some@ will return exactly one row, with a @NonEmptyTable@ collecting all
62-- returned rows.
63--
64-- @some@ is analogous to 'Control.Applicative.some' from
65-- @Control.Applicative@.
66some :: Table Expr a => Query a -> Query (NonEmptyTable Expr a)
67some =
68 fmap (\(NonEmptyTable a) -> NonEmptyTable a) .
69 aggregate .
70 fmap (nonEmptyAgg . toCols)
73-- | A version of 'many' specialised to single expressions.
74manyExpr :: Sql DBType a => Query (Expr a) -> Query (Expr [a])
75manyExpr = fmap (maybeTable mempty id) . optional . aggregate . fmap listAggExpr
78-- | A version of 'many' specialised to single expressions.
79someExpr :: Sql DBType a => Query (Expr a) -> Query (Expr (NonEmpty a))
80someExpr = aggregate . fmap nonEmptyAggExpr
83-- | Expand a 'ListTable' into a 'Query', where each row in the query is an
84-- element of the given @ListTable@.
85--
86-- @catListTable@ is an inverse to 'many'.
87catListTable :: Table Expr a => ListTable Expr a -> Query a
88catListTable (ListTable as) =
89 rebind "unnest" $ fromColumns $ runIdentity $
90 hunvectorize (\Spec {info} -> pure . sunnest info) as
93-- | Expand a 'NonEmptyTable' into a 'Query', where each row in the query is an
94-- element of the given @NonEmptyTable@.
95--
96-- @catNonEmptyTable@ is an inverse to 'some'.
97catNonEmptyTable :: Table Expr a => NonEmptyTable Expr a -> Query a
98catNonEmptyTable (NonEmptyTable as) =
99 rebind "unnest" $ fromColumns $ runIdentity $
100 hunvectorize (\Spec {info} -> pure . sunnest info) as
103-- | Expand an expression that contains a list into a 'Query', where each row
104-- in the query is an element of the given list.
105--
106-- @catList@ is an inverse to 'manyExpr'.
107catList :: Sql DBType a => Expr [a] -> Query (Expr a)
108catList = rebind "unnest" . sunnest typeInformation
111-- | Expand an expression that contains a non-empty list into a 'Query', where
112-- each row in the query is an element of the given list.
113--
114-- @catNonEmpty@ is an inverse to 'someExpr'.
115catNonEmpty :: Sql DBType a => Expr (NonEmpty a) -> Query (Expr a)
116catNonEmpty = rebind "unnest" . sunnest typeInformation
119sunnest :: TypeInformation (Unnullify a) -> Expr (list a) -> Expr a
120sunnest info = mapPrimExpr $
121 extractArrayElement info .
122 Opaleye.UnExpr (Opaleye.UnOpOther "UNNEST")