git.iko.soy/rel8
on 0272bcc help sign in
rel8/src/Rel8/Table/NonEmpty.hs
143 lines 4.2 kB history raw
1{-# language DataKinds #-}
2{-# language FlexibleContexts #-}
3{-# language FlexibleInstances #-}
4{-# language MultiParamTypeClasses #-}
5{-# language NamedFieldPuns #-}
6{-# language ScopedTypeVariables #-}
7{-# language StandaloneKindSignatures #-}
8{-# language TypeApplications #-}
9{-# language TypeFamilies #-}
10{-# language UndecidableInstances #-}
12module Rel8.Table.NonEmpty
13 ( NonEmptyTable(..)
14 , ($+)
15 , nonEmptyTable
16 , nameNonEmptyTable
17 )
18where
20-- base
21import Data.Functor.Identity ( Identity( Identity ) )
22import Data.Kind ( Type )
23import Data.List.NonEmpty ( NonEmpty )
24import Prelude hiding ( id )
26-- rel8
27import Rel8.Expr ( Expr )
28import Rel8.Expr.Array ( sappend1, snonEmptyOf )
29import Rel8.Schema.Dict ( Dict( Dict ) )
30import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
31import Rel8.Schema.HTable.Vectorize
32 ( hvectorize, hunvectorize
33 , happend
34 , hproject, hcolumn
35 )
36import qualified Rel8.Schema.Kind as K
37import Rel8.Schema.Name ( Name( Name ) )
38import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
39import Rel8.Schema.Result ( vectorizer, unvectorizer )
40import Rel8.Schema.Spec ( Spec(..) )
41import Rel8.Table
42 ( Table, Context, Columns, fromColumns, toColumns
43 , FromExprs, fromResult, toResult
44 , Transpose
45 )
46import Rel8.Table.Alternative ( AltTable, (<|>:) )
47import Rel8.Table.Eq ( EqTable, eqTable )
48import Rel8.Table.Ord ( OrdTable, ordTable )
49import Rel8.Table.Projection
50 ( Projectable, Projecting, Projection, project, apply
51 )
52import Rel8.Table.Serialize ( ToExprs )
55-- | A @NonEmptyTable@ value contains one or more instances of @a@. You
56-- construct @NonEmptyTable@s with 'Rel8.some' or 'nonEmptyAgg'.
57type NonEmptyTable :: K.Context -> Type -> Type
58newtype NonEmptyTable context a =
59 NonEmptyTable (HNonEmptyTable (Columns a) (Context a))
62instance Projectable (NonEmptyTable context) where
63 project f (NonEmptyTable a) = NonEmptyTable (hproject (apply f) a)
66instance (Table context a, context ~ context') =>
67 Table context' (NonEmptyTable context a)
68 where
69 type Columns (NonEmptyTable context a) = HNonEmptyTable (Columns a)
70 type Context (NonEmptyTable context a) = Context a
71 type FromExprs (NonEmptyTable context a) = NonEmpty (FromExprs a)
72 type Transpose to (NonEmptyTable context a) =
73 NonEmptyTable to (Transpose to a)
75 fromColumns = NonEmptyTable
76 toColumns (NonEmptyTable a) = a
77 fromResult = fmap (fromResult @_ @a) . hunvectorize unvectorizer
78 toResult = hvectorize vectorizer . fmap (toResult @_ @a)
81instance (EqTable a, context ~ Expr) =>
82 EqTable (NonEmptyTable context a)
83 where
84 eqTable =
85 hvectorize
86 (\Spec {nullity} (Identity Dict) -> case nullity of
87 Null -> Dict
88 NotNull -> Dict)
89 (Identity (eqTable @a))
92instance (OrdTable a, context ~ Expr) =>
93 OrdTable (NonEmptyTable context a)
94 where
95 ordTable =
96 hvectorize
97 (\Spec {nullity} (Identity Dict) -> case nullity of
98 Null -> Dict
99 NotNull -> Dict)
100 (Identity (ordTable @a))
103instance (ToExprs exprs a, context ~ Expr) =>
104 ToExprs (NonEmptyTable context exprs) (NonEmpty a)
107instance context ~ Expr => AltTable (NonEmptyTable context) where
108 (<|>:) = (<>)
111instance (Table Expr a, context ~ Expr) => Semigroup (NonEmptyTable context a)
112 where
113 NonEmptyTable as <> NonEmptyTable bs = NonEmptyTable $
114 happend (const sappend1) as bs
117-- | Project a single expression out of a 'NonEmptyTable'.
118($+) :: Projecting a (Expr b)
119 => Projection a (Expr b) -> NonEmptyTable Expr a -> Expr (NonEmpty b)
120f $+ NonEmptyTable a = hcolumn $ hproject (apply f) a
121infixl 4 $+
124-- | Construct a @NonEmptyTable@ from a non-empty list of expressions.
125nonEmptyTable :: Table Expr a => NonEmpty a -> NonEmptyTable Expr a
126nonEmptyTable =
127 NonEmptyTable .
128 hvectorize (\Spec {info} -> snonEmptyOf info) .
129 fmap toColumns
132-- | Construct a 'NonEmptyTable' in the 'Name' context. This can be useful if
133-- you have a 'NonEmptyTable' that you are storing in a table and need to
134-- construct a 'TableSchema'.
135nameNonEmptyTable
136 :: Table Name a
137 => a -- ^ The names of the columns of elements of the list.
138 -> NonEmptyTable Name a
139nameNonEmptyTable =
140 NonEmptyTable .
141 hvectorize (\_ (Identity (Name a)) -> Name a) .
142 pure .
143 toColumns