git.iko.soy/rel8
on 9903886 help sign in
rel8/src/Rel8/Query/List.hs
95 lines 3.4 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 ( Col( E, unE ), 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.Schema.HTable.Vectorize ( hunvectorize )
29import Rel8.Schema.Null ( Sql, Unnullify )
30import Rel8.Schema.Spec ( SSpec( SSpec, info ) )
31import Rel8.Table ( Table, fromColumns )
32import Rel8.Table.Aggregate ( listAgg, nonEmptyAgg )
33import Rel8.Table.List ( ListTable( ListTable ) )
34import Rel8.Table.Maybe ( maybeTable )
35import Rel8.Table.NonEmpty ( NonEmptyTable( NonEmptyTable ) )
36import Rel8.Type ( DBType, typeInformation )
37import Rel8.Type.Array ( extractArrayElement )
38import Rel8.Type.Information ( TypeInformation )
41-- | Aggregate a 'Query' into a 'ListTable'. If the supplied query returns 0
42-- rows, this function will produce a 'Query' that returns one row containing
43-- the empty @ListTable@. If the supplied @Query@ does return rows, @many@ will
44-- return exactly one row, with a @ListTable@ collecting all returned rows.
45--
46-- @many@ is analogous to 'Control.Applicative.many' from
47-- @Control.Applicative@.
48many :: Table Expr a => Query a -> Query (ListTable a)
49many = fmap (maybeTable mempty id) . optional . aggregate . fmap listAgg
52-- | Aggregate a 'Query' into a 'NonEmptyTable'. If the supplied query returns
53-- 0 rows, this function will produce a 'Query' that is empty - that is, will
54-- produce zero @NonEmptyTable@s. If the supplied @Query@ does return rows,
55-- @some@ will return exactly one row, with a @NonEmptyTable@ collecting all
56-- returned rows.
57--
58-- @some@ is analogous to 'Control.Applicative.some' from
59-- @Control.Applicative@.
60some :: Table Expr a => Query a -> Query (NonEmptyTable a)
61some = aggregate . fmap nonEmptyAgg
64-- | A version of 'many' specialised to single expressions.
65manyExpr :: Sql DBType a => Query (Expr a) -> Query (Expr [a])
66manyExpr = fmap (maybeTable mempty id) . optional . aggregate . fmap listAggExpr
69-- | A version of 'many' specialised to single expressions.
70someExpr :: Sql DBType a => Query (Expr a) -> Query (Expr (NonEmpty a))
71someExpr = aggregate . fmap nonEmptyAggExpr
74catListTable :: Table Expr a => ListTable a -> Query a
75catListTable (ListTable as) = pure $ fromColumns $ runIdentity $
76 hunvectorize (\SSpec {info} -> pure . E . sunnest info . unE) as
79catNonEmptyTable :: Table Expr a => NonEmptyTable a -> Query a
80catNonEmptyTable (NonEmptyTable as) = pure $ fromColumns $ runIdentity $
81 hunvectorize (\SSpec {info} -> pure . E . sunnest info . unE) as
84catList :: Sql DBType a => Expr [a] -> Query (Expr a)
85catList = pure . sunnest typeInformation
88catNonEmpty :: Sql DBType a => Expr (NonEmpty a) -> Query (Expr a)
89catNonEmpty = pure . sunnest typeInformation
92sunnest :: TypeInformation (Unnullify a) -> Expr (list a) -> Expr a
93sunnest info = mapPrimExpr $
94 extractArrayElement info .
95 Opaleye.UnExpr (Opaleye.UnOpOther "UNNEST")