git.iko.soy/rel8
on be54907 help sign in
rel8/src/Rel8/Table/NonEmpty.hs
153 lines 4.7 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 Control.Category ( id )
20import Data.Functor.Identity ( Identity( Identity ) )
21import Data.Kind ( Type )
22import Data.List.NonEmpty ( NonEmpty )
23import Data.Type.Equality ( (:~:)( Refl ), apply )
24import Prelude hiding ( id )
26-- rel8
27import Rel8.Expr ( Expr, Col( E, unE ) )
28import Rel8.Expr.Array ( sappend1, snonEmptyOf )
29import Rel8.Schema.Context.Abstract ( Abstract, exclusivity, virtual )
30import Rel8.Schema.Dict ( Dict( Dict ) )
31import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
32import Rel8.Schema.HTable.Vectorize ( happend, hvectorize )
33import qualified Rel8.Schema.Kind as K
34import Rel8.Schema.Name ( Col( N ), Name( Name ) )
35import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
36import Rel8.Schema.Reify ( hreify, hunreify )
37import Rel8.Schema.Spec ( SSpec(..) )
38import Rel8.Table
39 ( Table, Context, Columns, fromColumns, toColumns
40 , reify, unreify, coherence, congruence
41 )
42import Rel8.Table.Alternative ( AltTable, (<|>:) )
43import Rel8.Table.Eq ( EqTable, eqTable )
44import Rel8.Table.Ord ( OrdTable, ordTable )
45import Rel8.Table.Recontextualize ( Recontextualize )
46import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )
49-- | A @NonEmptyTable@ value contains one or more instances of @a@. You
50-- construct @NonEmptyTable@s with 'Rel8.some' or 'nonEmptyAgg'.
51type NonEmptyTable :: K.Context -> Type -> Type
52newtype NonEmptyTable context a =
53 NonEmptyTable (HNonEmptyTable (Columns a) (Col (Context a)))
56instance (Table context a, Abstract context, context ~ context') =>
57 Table context' (NonEmptyTable context a)
58 where
59 type Columns (NonEmptyTable context a) = HNonEmptyTable (Columns a)
60 type Context (NonEmptyTable context a) = Context a
62 fromColumns = NonEmptyTable
63 toColumns (NonEmptyTable a) = a
65 reify proof@Refl (NonEmptyTable a) =
66 case coherence @context @a proof abstract of
67 Refl -> case congruence @context @a proof abstract of
68 Refl -> NonEmptyTable (hreify a)
69 where
70 abstract = exclusivity virtual
72 unreify proof@Refl (NonEmptyTable a) =
73 case coherence @context @a proof abstract of
74 Refl -> case congruence @context @a proof abstract of
75 Refl -> NonEmptyTable (hunreify a)
76 where
77 abstract = exclusivity virtual
79 coherence = coherence @context @a
80 congruence proof abstract = id `apply` congruence @context @a proof abstract
83instance
84 ( Recontextualize from to a b
85 , Abstract from, from ~ from'
86 , Abstract to, to ~ to'
87 )
88 => Recontextualize from to (NonEmptyTable from' a) (NonEmptyTable to' b)
91instance (EqTable a, context ~ Expr) =>
92 EqTable (NonEmptyTable context a)
93 where
94 eqTable =
95 hvectorize
96 (\SSpec {nullity} (Identity Dict) -> case nullity of
97 Null -> Dict
98 NotNull -> Dict)
99 (Identity (eqTable @a))
102instance (OrdTable a, context ~ Expr) =>
103 OrdTable (NonEmptyTable context a)
104 where
105 ordTable =
106 hvectorize
107 (\SSpec {nullity} (Identity Dict) -> case nullity of
108 Null -> Dict
109 NotNull -> Dict)
110 (Identity (ordTable @a))
113type instance FromExprs (NonEmptyTable _context a) = NonEmpty (FromExprs a)
116instance (ToExprs exprs a, context ~ Expr) =>
117 ToExprs (NonEmptyTable context exprs) (NonEmpty a)
118 where
119 fromResult = fmap (fromResult @exprs) . fromColumns
120 toResult = toColumns . fmap (toResult @exprs)
123instance context ~ Expr => AltTable (NonEmptyTable context) where
124 (<|>:) = (<>)
127instance (Table Expr a, context ~ Expr) =>
128 Semigroup (NonEmptyTable context a)
129 where
130 NonEmptyTable as <> NonEmptyTable bs = NonEmptyTable $
131 happend (\_ _ (E a) (E b) -> E (sappend1 a b)) as bs
134-- | Construct a @NonEmptyTable@ from a non-empty list of expressions.
135nonEmptyTable :: Table Expr a => NonEmpty a -> NonEmptyTable Expr a
136nonEmptyTable =
137 NonEmptyTable .
138 hvectorize (\SSpec {info} -> E . snonEmptyOf info . fmap unE) .
139 fmap toColumns
142-- | Construct a 'NonEmptyTable' in the 'Name' context. This can be useful if
143-- you have a 'NonEmptyTable' that you are storing in a table and need to
144-- construct a 'TableSchema'.
145nameNonEmptyTable
146 :: Table Name a
147 => a -- ^ The names of the columns of elements of the list.
148 -> NonEmptyTable Name a
149nameNonEmptyTable =
150 NonEmptyTable .
151 hvectorize (\_ (Identity (N (Name a))) -> N (Name a)) .
152 pure .
153 toColumns