git.iko.soy/rel8
on ca7aaef help sign in
rel8/src/Rel8/Table/NonEmpty.hs
92 lines 2.8 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 , HNonEmptyTable
14 , nonEmptyTable
15 )
16where
18-- base
19import Data.Functor.Identity ( Identity( Identity ) )
20import Data.Kind ( Type )
21import Data.List.NonEmpty ( NonEmpty )
22import Prelude
24-- rel8
25import Rel8.Expr ( Expr, Col(..) )
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.Nullability ( Nullability( Nullable, NonNullable ) )
31import Rel8.Schema.Spec ( SSpec(..) )
32import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullability )
33import Rel8.Table ( Table, Context, Columns, fromColumns, toColumns )
34import Rel8.Table.Alternative ( AltTable, (<|>:) )
35import Rel8.Table.Eq ( EqTable, eqTable )
36import Rel8.Table.Ord ( OrdTable, ordTable )
37import Rel8.Table.Recontextualize ( Recontextualize )
40-- | A @NonEmptyTable@ value contains one or more instances of @a@. You
41-- construct @NonEmptyTable@s with 'some' or 'nonEmptyAgg'.
42type NonEmptyTable :: Type -> Type
43newtype NonEmptyTable a =
44 NonEmptyTable (HNonEmptyTable (Columns a) (Col (Context a)))
47instance Table context a => Table context (NonEmptyTable a) where
48 type Columns (NonEmptyTable a) = HNonEmptyTable (Columns a)
49 type Context (NonEmptyTable a) = Context a
51 fromColumns = NonEmptyTable
52 toColumns (NonEmptyTable a) = a
55instance Recontextualize from to a b =>
56 Recontextualize from to (NonEmptyTable a) (NonEmptyTable b)
59instance EqTable a => EqTable (NonEmptyTable a) where
60 eqTable =
61 hvectorize
62 (\SSpec {} (Identity dict) -> case dbTypeDict dict of
63 Dict -> case dbTypeNullability dict of
64 Nullable -> Dict
65 NonNullable -> Dict)
66 (Identity (eqTable @a))
69instance OrdTable a => OrdTable (NonEmptyTable a) where
70 ordTable =
71 hvectorize
72 (\SSpec {} (Identity dict) -> case dbTypeDict dict of
73 Dict -> case dbTypeNullability dict of
74 Nullable -> Dict
75 NonNullable -> Dict)
76 (Identity (ordTable @a))
79instance AltTable NonEmptyTable where
80 (<|>:) = (<>)
83instance Table Expr a => Semigroup (NonEmptyTable a) where
84 NonEmptyTable as <> NonEmptyTable bs = NonEmptyTable $
85 happend (\_ _ (DB a) (DB b) -> DB (sappend1 a b)) as bs
88nonEmptyTable :: Table Expr a => NonEmpty a -> NonEmptyTable a
89nonEmptyTable =
90 NonEmptyTable .
91 hvectorize (\SSpec {info} -> DB . snonEmptyOf info . fmap unDB) .
92 fmap toColumns