git.iko.soy/rel8
on 2cdc394 help sign in
rel8/src/Rel8/Table/NonEmpty.hs
107 lines 3.2 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 , HNonEmptyTable
15 , nonEmptyTable
16 )
17where
19-- base
20import Data.Functor.Identity ( Identity( Identity ) )
21import Data.Kind ( Type )
22import Data.List.NonEmpty ( NonEmpty )
23import Data.Type.Equality ( (:~:)( Refl ) )
24import Prelude
26-- rel8
27import Rel8.Expr ( Expr, Col(..) )
28import Rel8.Expr.Array ( sappend1, snonEmptyOf )
29import Rel8.Schema.Dict ( Dict( Dict ) )
30import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
31import Rel8.Schema.HTable.Vectorize ( happend, hvectorize )
32import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
33import Rel8.Schema.Reify ( hreify, hunreify )
34import Rel8.Schema.Spec ( SSpec(..) )
35import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullity )
36import Rel8.Table
37 ( Table, Context, Columns, fromColumns, toColumns
38 , reify, unreify
39 )
40import Rel8.Table.Alternative ( AltTable, (<|>:) )
41import Rel8.Table.Eq ( EqTable, eqTable )
42import Rel8.Table.Ord ( OrdTable, ordTable )
43import Rel8.Table.Recontextualize ( Recontextualize )
44import Rel8.Table.Unreify ( Unreifiable )
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, Unreifiable 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 ( Unreifiable from a, Unreifiable 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))
94instance AltTable NonEmptyTable where
95 (<|>:) = (<>)
98instance Table Expr a => Semigroup (NonEmptyTable a) where
99 NonEmptyTable as <> NonEmptyTable bs = NonEmptyTable $
100 happend (\_ _ (DB a) (DB b) -> DB (sappend1 a b)) as bs
103nonEmptyTable :: Table Expr a => NonEmpty a -> NonEmptyTable a
104nonEmptyTable =
105 NonEmptyTable .
106 hvectorize (\SSpec {info} -> DB . snonEmptyOf info . fmap unDB) .
107 fmap toColumns