git.iko.soy/rel8
on 70ce05d help sign in
rel8/src/Rel8/Table/NonEmpty.hs
131 lines 4.0 kB history raw
1{-# language FlexibleContexts #-}
2{-# language FlexibleInstances #-}
3{-# language MultiParamTypeClasses #-}
4{-# language NamedFieldPuns #-}
5{-# language ScopedTypeVariables #-}
6{-# language StandaloneKindSignatures #-}
7{-# language TypeApplications #-}
8{-# language TypeFamilies #-}
9{-# language UndecidableInstances #-}
11module Rel8.Table.NonEmpty
12 ( NonEmptyTable(..)
13 , nonEmptyTable, nameNonEmptyTable
14 )
15where
17-- base
18import Data.Functor.Identity ( Identity( Identity ) )
19import Data.Kind ( Type )
20import Data.List.NonEmpty ( NonEmpty )
21import Data.Type.Equality ( (:~:)( Refl ) )
22import Prelude
24-- rel8
25import Rel8.Expr ( Expr, Col( 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 )
30import Rel8.Schema.Name ( Col( N ), Name( Name ) )
31import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
32import Rel8.Schema.Reify ( hreify, hunreify )
33import Rel8.Schema.Spec ( SSpec(..) )
34import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullity )
35import Rel8.Table
36 ( Table, Context, Columns, fromColumns, toColumns
37 , reify, unreify
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 ( FromExprs, ToExprs, fromResult, toResult )
44import Rel8.Table.Unreify ( Unreifies )
47-- | A @NonEmptyTable@ value contains one or more instances of @a@. You
48-- construct @NonEmptyTable@s with 'Rel8.some' or 'nonEmptyAgg'.
49type NonEmptyTable :: Type -> Type
50newtype NonEmptyTable a =
51 NonEmptyTable (HNonEmptyTable (Columns a) (Col (Context a)))
54instance (Table context a, Unreifies context a) =>
55 Table context (NonEmptyTable a)
56 where
57 type Columns (NonEmptyTable a) = HNonEmptyTable (Columns a)
58 type Context (NonEmptyTable a) = Context a
60 fromColumns = NonEmptyTable
61 toColumns (NonEmptyTable a) = a
63 reify Refl (NonEmptyTable a) = NonEmptyTable (hreify a)
64 unreify Refl (NonEmptyTable a) = NonEmptyTable (hunreify a)
67instance
68 ( Unreifies from a, Unreifies to b
69 , Recontextualize from to a b
70 )
71 => Recontextualize from to (NonEmptyTable a) (NonEmptyTable b)
74instance EqTable a => EqTable (NonEmptyTable a) where
75 eqTable =
76 hvectorize
77 (\SSpec {} (Identity dict) -> case dbTypeDict dict of
78 Dict -> case dbTypeNullity dict of
79 Null -> Dict
80 NotNull -> Dict)
81 (Identity (eqTable @a))
84instance OrdTable a => OrdTable (NonEmptyTable a) where
85 ordTable =
86 hvectorize
87 (\SSpec {} (Identity dict) -> case dbTypeDict dict of
88 Dict -> case dbTypeNullity dict of
89 Null -> Dict
90 NotNull -> Dict)
91 (Identity (ordTable @a))
94type instance FromExprs (NonEmptyTable a) = NonEmpty (FromExprs a)
97instance ToExprs exprs a => ToExprs (NonEmptyTable exprs) (NonEmpty a)
98 where
99 fromResult = fmap (fromResult @exprs) . fromColumns
100 toResult = toColumns . fmap (toResult @exprs)
103instance AltTable NonEmptyTable where
104 (<|>:) = (<>)
107instance Table Expr a => Semigroup (NonEmptyTable a) where
108 NonEmptyTable as <> NonEmptyTable bs = NonEmptyTable $
109 happend (\_ _ (E a) (E b) -> E (sappend1 a b)) as bs
112-- | Construct a @NonEmptyTable@ from a non-empty list of expressions.
113nonEmptyTable :: Table Expr a => NonEmpty a -> NonEmptyTable a
114nonEmptyTable =
115 NonEmptyTable .
116 hvectorize (\SSpec {info} -> E . snonEmptyOf info . fmap unE) .
117 fmap toColumns
120-- | Construct a 'NonEmptyTable' in the 'Name' context. This can be useful if
121-- you have a 'NonEmptyTable' that you are storing in a table and need to
122-- construct a 'TableSchema'.
123nameNonEmptyTable
124 :: Table Name a
125 => a -- ^ The names of the columns of elements of the list.
126 -> NonEmptyTable a
127nameNonEmptyTable =
128 NonEmptyTable .
129 hvectorize (\_ (Identity (N (Name a))) -> N (Name a)) .
130 pure .
131 toColumns