git.iko.soy/rel8
on 6c20afa help sign in
rel8/src/Rel8/Table/NonEmpty.hs
108 lines 3.2 kB history raw
1{-# language DataKinds #-}
2{-# language FlexibleContexts #-}
3{-# language FlexibleInstances #-}
4{-# language MultiParamTypeClasses #-}
5{-# language NamedFieldPuns #-}
6{-# language QuantifiedConstraints #-}
7{-# language ScopedTypeVariables #-}
8{-# language StandaloneKindSignatures #-}
9{-# language TypeApplications #-}
10{-# language TypeFamilies #-}
11{-# language UndecidableInstances #-}
13module Rel8.Table.NonEmpty
14 ( NonEmptyTable(..)
15 , HNonEmptyTable
16 , nonEmptyTable
17 )
18where
20-- base
21import Data.Functor.Identity ( Identity( Identity ) )
22import Data.Kind ( Type )
23import Data.List.NonEmpty ( NonEmpty )
24import Data.Type.Equality ( (:~:)( Refl ) )
25import Prelude
27-- rel8
28import Rel8.Expr ( Expr, Col(..) )
29import Rel8.Expr.Array ( sappend1, snonEmptyOf )
30import Rel8.Schema.Dict ( Dict( Dict ) )
31import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
32import Rel8.Schema.HTable.Vectorize ( happend, hvectorize )
33import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
34import Rel8.Schema.Reify ( hreify, hunreify )
35import Rel8.Schema.Spec ( SSpec(..) )
36import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullity )
37import Rel8.Table
38 ( Table, Context, Columns, fromColumns, toColumns
39 , reify, unreify
40 )
41import Rel8.Table.Alternative ( AltTable, (<|>:) )
42import Rel8.Table.Eq ( EqTable, eqTable )
43import Rel8.Table.Ord ( OrdTable, ordTable )
44import Rel8.Table.Recontextualize ( Recontextualize )
45import Rel8.Table.Unreify ( Unreifiable )
48-- | A @NonEmptyTable@ value contains one or more instances of @a@. You
49-- construct @NonEmptyTable@s with 'Rel8.some' or 'nonEmptyAgg'.
50type NonEmptyTable :: Type -> Type
51newtype NonEmptyTable a =
52 NonEmptyTable (HNonEmptyTable (Columns a) (Col (Context a)))
55instance (Table context a, Unreifiable context a) =>
56 Table context (NonEmptyTable a)
57 where
58 type Columns (NonEmptyTable a) = HNonEmptyTable (Columns a)
59 type Context (NonEmptyTable a) = Context a
61 fromColumns = NonEmptyTable
62 toColumns (NonEmptyTable a) = a
64 reify Refl (NonEmptyTable a) = NonEmptyTable (hreify a)
65 unreify Refl (NonEmptyTable a) = NonEmptyTable (hunreify a)
68instance
69 ( Unreifiable from a, Unreifiable to b
70 , Recontextualize from to a b
71 )
72 => Recontextualize from to (NonEmptyTable a) (NonEmptyTable b)
75instance EqTable a => EqTable (NonEmptyTable a) where
76 eqTable =
77 hvectorize
78 (\SSpec {} (Identity dict) -> case dbTypeDict dict of
79 Dict -> case dbTypeNullity dict of
80 Null -> Dict
81 NotNull -> Dict)
82 (Identity (eqTable @a))
85instance OrdTable a => OrdTable (NonEmptyTable a) where
86 ordTable =
87 hvectorize
88 (\SSpec {} (Identity dict) -> case dbTypeDict dict of
89 Dict -> case dbTypeNullity dict of
90 Null -> Dict
91 NotNull -> Dict)
92 (Identity (ordTable @a))
95instance AltTable NonEmptyTable where
96 (<|>:) = (<>)
99instance Table Expr a => Semigroup (NonEmptyTable a) where
100 NonEmptyTable as <> NonEmptyTable bs = NonEmptyTable $
101 happend (\_ _ (DB a) (DB b) -> DB (sappend1 a b)) as bs
104nonEmptyTable :: Table Expr a => NonEmpty a -> NonEmptyTable a
105nonEmptyTable =
106 NonEmptyTable .
107 hvectorize (\SSpec {info} -> DB . snonEmptyOf info . fmap unDB) .
108 fmap toColumns