git.iko.soy/rel8
on 97d89cf help sign in
rel8/src/Rel8/Table/NonEmpty.hs
126 lines 3.9 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( E, unE ) )
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( N, Name ) )
32import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
33import Rel8.Schema.Result ( vectorizer, unvectorizer )
34import Rel8.Schema.Spec ( SSpec(..) )
35import Rel8.Table
36 ( Table, Context, Columns, fromColumns, toColumns
37 , FromExprs, fromResult, toResult
38 )
39import Rel8.Table.Alternative ( AltTable, (<|>:) )
40import Rel8.Table.Eq ( EqTable, eqTable )
41import Rel8.Table.Ord ( OrdTable, ordTable )
42import Rel8.Table.Recontextualize ( Recontextualize )
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)
60 fromColumns = NonEmptyTable
61 toColumns (NonEmptyTable a) = a
62 fromResult = fmap (fromResult @_ @a) . hunvectorize unvectorizer
63 toResult = hvectorize vectorizer . fmap (toResult @_ @a)
66instance (Recontextualize from to a b, from ~ from', to ~ to') =>
67 Recontextualize from to (NonEmptyTable from' a) (NonEmptyTable to' b)
70instance (EqTable a, context ~ Expr) =>
71 EqTable (NonEmptyTable context a)
72 where
73 eqTable =
74 hvectorize
75 (\SSpec {nullity} (Identity Dict) -> case nullity of
76 Null -> Dict
77 NotNull -> Dict)
78 (Identity (eqTable @a))
81instance (OrdTable a, context ~ Expr) =>
82 OrdTable (NonEmptyTable context a)
83 where
84 ordTable =
85 hvectorize
86 (\SSpec {nullity} (Identity Dict) -> case nullity of
87 Null -> Dict
88 NotNull -> Dict)
89 (Identity (ordTable @a))
92instance (ToExprs exprs a, context ~ Expr) =>
93 ToExprs (NonEmptyTable context exprs) (NonEmpty a)
96instance context ~ Expr => AltTable (NonEmptyTable context) where
97 (<|>:) = (<>)
100instance (Table Expr a, context ~ Expr) =>
101 Semigroup (NonEmptyTable context a)
102 where
103 NonEmptyTable as <> NonEmptyTable bs = NonEmptyTable $
104 happend (\_ _ (E a) (E b) -> E (sappend1 a b)) as bs
107-- | Construct a @NonEmptyTable@ from a non-empty list of expressions.
108nonEmptyTable :: Table Expr a => NonEmpty a -> NonEmptyTable Expr a
109nonEmptyTable =
110 NonEmptyTable .
111 hvectorize (\SSpec {info} -> E . snonEmptyOf info . fmap unE) .
112 fmap toColumns
115-- | Construct a 'NonEmptyTable' in the 'Name' context. This can be useful if
116-- you have a 'NonEmptyTable' that you are storing in a table and need to
117-- construct a 'TableSchema'.
118nameNonEmptyTable
119 :: Table Name a
120 => a -- ^ The names of the columns of elements of the list.
121 -> NonEmptyTable Name a
122nameNonEmptyTable =
123 NonEmptyTable .
124 hvectorize (\_ (Identity (N (Name a))) -> N (Name a)) .
125 pure .
126 toColumns