git.iko.soy/rel8
on 8a680c9 help sign in
rel8/src/Rel8/Table/NonEmpty.hs
117 lines 3.5 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.Serialize ( FromExprs, ToExprs, fromResult, toResult )
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))
95type instance FromExprs (NonEmptyTable a) = NonEmpty (FromExprs a)
98instance ToExprs exprs a => ToExprs (NonEmptyTable exprs) (NonEmpty a)
99 where
100 fromResult = fmap (fromResult @exprs) . fromColumns
101 toResult = toColumns . fmap (toResult @exprs)
104instance AltTable NonEmptyTable where
105 (<|>:) = (<>)
108instance Table Expr a => Semigroup (NonEmptyTable a) where
109 NonEmptyTable as <> NonEmptyTable bs = NonEmptyTable $
110 happend (\_ _ (DB a) (DB b) -> DB (sappend1 a b)) as bs
113nonEmptyTable :: Table Expr a => NonEmpty a -> NonEmptyTable a
114nonEmptyTable =
115 NonEmptyTable .
116 hvectorize (\SSpec {info} -> DB . snonEmptyOf info . fmap unDB) .
117 fmap toColumns