@@ -1,29 +1,52 @@
11{-# language FlexibleContexts #-}
2−{-# language MonoLocalBinds #-}
2+{-# language GADTs #-}
3+{-# language NamedFieldPuns #-}
34
45module Rel8.Query.List
56 ( many, some
67 , manyExpr, someExpr
8+ , catListTable, catNonEmptyTable
9+ , catList, catNonEmpty
710 )
811where
912
1013-- base
14+import Data.Functor.Identity ( runIdentity )
1115import Data.List.NonEmpty ( NonEmpty )
1216import Prelude
1317
18+-- opaleye
19+import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
20+
1421-- rel8
15−import Rel8.Expr ( Expr )
22+import Rel8.Expr ( Col( E, unE ), Expr )
1623import Rel8.Expr.Aggregate ( listAggExpr, nonEmptyAggExpr )
24+import Rel8.Expr.Opaleye ( mapPrimExpr )
1725import Rel8.Query ( Query )
1826import Rel8.Query.Aggregate ( aggregate )
1927import Rel8.Query.Maybe ( optional )
20−import Rel8.Schema.Null ( Sql )
21−import Rel8.Table ( Table )
28+import Rel8.Schema.HTable.Vectorize ( hunvectorize )
29+import Rel8.Schema.Null ( Sql, Unnullify )
30+import Rel8.Schema.Spec ( SSpec( SSpec, info ) )
31+import Rel8.Table ( Table, fromColumns )
2232import Rel8.Table.Aggregate ( listAgg, nonEmptyAgg )
23−import Rel8.Table.List ( ListTable )
33+import Rel8.Table.List ( ListTable( ListTable ) )
2434import Rel8.Table.Maybe ( maybeTable )
25−import Rel8.Table.NonEmpty ( NonEmptyTable )
26−import Rel8.Type ( DBType )
35+import Rel8.Table.NonEmpty ( NonEmptyTable( NonEmptyTable ) )
36+import Rel8.Type ( DBType, typeInformation )
37+import Rel8.Type.Array ( extractArrayElement )
38+import Rel8.Type.Information ( TypeInformation )
39+
40+
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@.
48+many :: Table Expr a => Query a -> Query (ListTable a)
49+many = fmap (maybeTable mempty id) . optional . aggregate . fmap listAgg
2750
2851
2952-- | Aggregate a 'Query' into a 'NonEmptyTable'. If the supplied query returns
@@ -38,17 +61,6 @@ some :: Table Expr a => Query a -> Query (NonEmptyTable a)
3861some = aggregate . fmap nonEmptyAgg
3962
4063
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@.
48−many :: Table Expr a => Query a -> Query (ListTable a)
49−many = fmap (maybeTable mempty id) . optional . aggregate . fmap listAgg
50−
51−
5264-- | A version of 'many' specialised to single expressions.
5365manyExpr :: Sql DBType a => Query (Expr a) -> Query (Expr [a])
5466manyExpr = fmap (maybeTable mempty id) . optional . aggregate . fmap listAggExpr
@@ -57,3 +69,27 @@ manyExpr = fmap (maybeTable mempty id) . optional . aggregate . fmap listAggExpr
5769-- | A version of 'many' specialised to single expressions.
5870someExpr :: Sql DBType a => Query (Expr a) -> Query (Expr (NonEmpty a))
5971someExpr = aggregate . fmap nonEmptyAggExpr
72+
73+
74+catListTable :: Table Expr a => ListTable a -> Query a
75+catListTable (ListTable as) = pure $ fromColumns $ runIdentity $
76+ hunvectorize (\SSpec {info} -> pure . E . sunnest info . unE) as
77+
78+
79+catNonEmptyTable :: Table Expr a => NonEmptyTable a -> Query a
80+catNonEmptyTable (NonEmptyTable as) = pure $ fromColumns $ runIdentity $
81+ hunvectorize (\SSpec {info} -> pure . E . sunnest info . unE) as
82+
83+
84+catList :: Sql DBType a => Expr [a] -> Query (Expr a)
85+catList = pure . sunnest typeInformation
86+
87+
88+catNonEmpty :: Sql DBType a => Expr (NonEmpty a) -> Query (Expr a)
89+catNonEmpty = pure . sunnest typeInformation
90+
91+
92+sunnest :: TypeInformation (Unnullify a) -> Expr (list a) -> Expr a
93+sunnest info = mapPrimExpr $
94+ extractArrayElement info .
95+ Opaleye.UnExpr (Opaleye.UnOpOther "UNNEST")