git.iko.soy/rel8
on f47423e help sign in
rel8/src/Rel8/Table/NonEmpty.hs
123 lines 3.8 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 ( happend, hvectorize, hunvectorize )
30import qualified Rel8.Schema.Kind as K
31import Rel8.Schema.Name ( Name( Name ) )
32import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
33import Rel8.Schema.Result ( vectorizer, unvectorizer )
34import Rel8.Schema.Spec ( Spec(..) )
35import Rel8.Table
36 ( Table, Context, Columns, fromColumns, toColumns
37 , FromExprs, fromResult, toResult
38 , Transpose
39 )
40import Rel8.Table.Alternative ( AltTable, (<|>:) )
41import Rel8.Table.Eq ( EqTable, eqTable )
42import Rel8.Table.Ord ( OrdTable, ordTable )
43import Rel8.Table.Serialize ( ToExprs )
46-- | A @NonEmptyTable@ value contains one or more instances of @a@. You
47-- construct @NonEmptyTable@s with 'Rel8.some' or 'nonEmptyAgg'.
48type NonEmptyTable :: K.Context -> Type -> Type
49newtype NonEmptyTable context a =
50 NonEmptyTable (HNonEmptyTable (Columns a) (Context a))
53instance (Table context a, context ~ context') =>
54 Table context' (NonEmptyTable context a)
55 where
56 type Columns (NonEmptyTable context a) = HNonEmptyTable (Columns a)
57 type Context (NonEmptyTable context a) = Context a
58 type FromExprs (NonEmptyTable context a) = NonEmpty (FromExprs a)
59 type Transpose to (NonEmptyTable context a) =
60 NonEmptyTable to (Transpose to a)
62 fromColumns = NonEmptyTable
63 toColumns (NonEmptyTable a) = a
64 fromResult = fmap (fromResult @_ @a) . hunvectorize unvectorizer
65 toResult = hvectorize vectorizer . fmap (toResult @_ @a)
68instance (EqTable a, context ~ Expr) =>
69 EqTable (NonEmptyTable context a)
70 where
71 eqTable =
72 hvectorize
73 (\Spec {nullity} (Identity Dict) -> case nullity of
74 Null -> Dict
75 NotNull -> Dict)
76 (Identity (eqTable @a))
79instance (OrdTable a, context ~ Expr) =>
80 OrdTable (NonEmptyTable context a)
81 where
82 ordTable =
83 hvectorize
84 (\Spec {nullity} (Identity Dict) -> case nullity of
85 Null -> Dict
86 NotNull -> Dict)
87 (Identity (ordTable @a))
90instance (ToExprs exprs a, context ~ Expr) =>
91 ToExprs (NonEmptyTable context exprs) (NonEmpty a)
94instance context ~ Expr => AltTable (NonEmptyTable context) where
95 (<|>:) = (<>)
98instance (Table Expr a, context ~ Expr) => Semigroup (NonEmptyTable context a)
99 where
100 NonEmptyTable as <> NonEmptyTable bs = NonEmptyTable $
101 happend (const sappend1) as bs
104-- | Construct a @NonEmptyTable@ from a non-empty list of expressions.
105nonEmptyTable :: Table Expr a => NonEmpty a -> NonEmptyTable Expr a
106nonEmptyTable =
107 NonEmptyTable .
108 hvectorize (\Spec {info} -> snonEmptyOf info) .
109 fmap toColumns
112-- | Construct a 'NonEmptyTable' in the 'Name' context. This can be useful if
113-- you have a 'NonEmptyTable' that you are storing in a table and need to
114-- construct a 'TableSchema'.
115nameNonEmptyTable
116 :: Table Name a
117 => a -- ^ The names of the columns of elements of the list.
118 -> NonEmptyTable Name a
119nameNonEmptyTable =
120 NonEmptyTable .
121 hvectorize (\_ (Identity (Name a)) -> Name a) .
122 pure .
123 toColumns