git.iko.soy/rel8
on 8de0eec help sign in
rel8/src/Rel8/Table/NonEmpty.hs
132 lines 4.0 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 , nonEmptyTable, nameNonEmptyTable
15 )
16where
18-- base
19import Data.Functor.Identity ( Identity( Identity ) )
20import Data.Kind ( Type )
21import Data.List.NonEmpty ( NonEmpty )
22import Prelude hiding ( id )
24-- rel8
25import Rel8.Expr ( Expr )
26import Rel8.Expr.Array ( sappend1, snonEmptyOf )
27import Rel8.Schema.Dict ( Dict( Dict ) )
28import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
29import Rel8.Schema.HTable.Vectorize
30 ( hvectorize, hunvectorize
31 , happend
32 , hproject
33 )
34import qualified Rel8.Schema.Kind as K
35import Rel8.Schema.Name ( Name( Name ) )
36import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
37import Rel8.Schema.Result ( vectorizer, unvectorizer )
38import Rel8.Schema.Spec ( Spec(..) )
39import Rel8.Table
40 ( Table, Context, Columns, fromColumns, toColumns
41 , FromExprs, fromResult, toResult
42 , Transpose
43 )
44import Rel8.Table.Alternative ( AltTable, (<|>:) )
45import Rel8.Table.Eq ( EqTable, eqTable )
46import Rel8.Table.Ord ( OrdTable, ordTable )
47import Rel8.Table.Projection ( Projectable, project, apply )
48import Rel8.Table.Serialize ( ToExprs )
51-- | A @NonEmptyTable@ value contains one or more instances of @a@. You
52-- construct @NonEmptyTable@s with 'Rel8.some' or 'nonEmptyAgg'.
53type NonEmptyTable :: K.Context -> Type -> Type
54newtype NonEmptyTable context a =
55 NonEmptyTable (HNonEmptyTable (Columns a) (Context a))
58instance Projectable (NonEmptyTable context) where
59 project f (NonEmptyTable a) = NonEmptyTable (hproject (apply f) a)
62instance (Table context a, context ~ context') =>
63 Table context' (NonEmptyTable context a)
64 where
65 type Columns (NonEmptyTable context a) = HNonEmptyTable (Columns a)
66 type Context (NonEmptyTable context a) = Context a
67 type FromExprs (NonEmptyTable context a) = NonEmpty (FromExprs a)
68 type Transpose to (NonEmptyTable context a) =
69 NonEmptyTable to (Transpose to a)
71 fromColumns = NonEmptyTable
72 toColumns (NonEmptyTable a) = a
73 fromResult = fmap (fromResult @_ @a) . hunvectorize unvectorizer
74 toResult = hvectorize vectorizer . fmap (toResult @_ @a)
77instance (EqTable a, context ~ Expr) =>
78 EqTable (NonEmptyTable context a)
79 where
80 eqTable =
81 hvectorize
82 (\Spec {nullity} (Identity Dict) -> case nullity of
83 Null -> Dict
84 NotNull -> Dict)
85 (Identity (eqTable @a))
88instance (OrdTable a, context ~ Expr) =>
89 OrdTable (NonEmptyTable context a)
90 where
91 ordTable =
92 hvectorize
93 (\Spec {nullity} (Identity Dict) -> case nullity of
94 Null -> Dict
95 NotNull -> Dict)
96 (Identity (ordTable @a))
99instance (ToExprs exprs a, context ~ Expr) =>
100 ToExprs (NonEmptyTable context exprs) (NonEmpty a)
103instance context ~ Expr => AltTable (NonEmptyTable context) where
104 (<|>:) = (<>)
107instance (Table Expr a, context ~ Expr) => Semigroup (NonEmptyTable context a)
108 where
109 NonEmptyTable as <> NonEmptyTable bs = NonEmptyTable $
110 happend (const sappend1) as bs
113-- | Construct a @NonEmptyTable@ from a non-empty list of expressions.
114nonEmptyTable :: Table Expr a => NonEmpty a -> NonEmptyTable Expr a
115nonEmptyTable =
116 NonEmptyTable .
117 hvectorize (\Spec {info} -> snonEmptyOf info) .
118 fmap toColumns
121-- | Construct a 'NonEmptyTable' in the 'Name' context. This can be useful if
122-- you have a 'NonEmptyTable' that you are storing in a table and need to
123-- construct a 'TableSchema'.
124nameNonEmptyTable
125 :: Table Name a
126 => a -- ^ The names of the columns of elements of the list.
127 -> NonEmptyTable Name a
128nameNonEmptyTable =
129 NonEmptyTable .
130 hvectorize (\_ (Identity (Name a)) -> Name a) .
131 pure .
132 toColumns