git.iko.soy/rel8
on bdb75e6 help sign in
rel8/src/Rel8/Table/NonEmpty.hs
131 lines 3.9 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, insertNonEmptyTable, 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.Insert ( Inserts )
31import Rel8.Schema.Name ( Col( N ), Name( Name ) )
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.Insert ( toInsert )
43import Rel8.Table.Ord ( OrdTable, ordTable )
44import Rel8.Table.Recontextualize ( Recontextualize )
45import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )
46import Rel8.Table.Unreify ( Unreifies )
49-- | A @NonEmptyTable@ value contains one or more instances of @a@. You
50-- construct @NonEmptyTable@s with 'Rel8.some' or 'nonEmptyAgg'.
51type NonEmptyTable :: Type -> Type
52newtype NonEmptyTable a =
53 NonEmptyTable (HNonEmptyTable (Columns a) (Col (Context a)))
56instance (Table context a, Unreifies context a) =>
57 Table context (NonEmptyTable a)
58 where
59 type Columns (NonEmptyTable a) = HNonEmptyTable (Columns a)
60 type Context (NonEmptyTable a) = Context a
62 fromColumns = NonEmptyTable
63 toColumns (NonEmptyTable a) = a
65 reify Refl (NonEmptyTable a) = NonEmptyTable (hreify a)
66 unreify Refl (NonEmptyTable a) = NonEmptyTable (hunreify a)
69instance
70 ( Unreifies from a, Unreifies to b
71 , Recontextualize from to a b
72 )
73 => Recontextualize from to (NonEmptyTable a) (NonEmptyTable b)
76instance EqTable a => EqTable (NonEmptyTable a) where
77 eqTable =
78 hvectorize
79 (\SSpec {} (Identity dict) -> case dbTypeDict dict of
80 Dict -> case dbTypeNullity dict of
81 Null -> Dict
82 NotNull -> Dict)
83 (Identity (eqTable @a))
86instance OrdTable a => OrdTable (NonEmptyTable a) where
87 ordTable =
88 hvectorize
89 (\SSpec {} (Identity dict) -> case dbTypeDict dict of
90 Dict -> case dbTypeNullity dict of
91 Null -> Dict
92 NotNull -> Dict)
93 (Identity (ordTable @a))
96type instance FromExprs (NonEmptyTable a) = NonEmpty (FromExprs a)
99instance ToExprs exprs a => ToExprs (NonEmptyTable exprs) (NonEmpty a)
100 where
101 fromResult = fmap (fromResult @exprs) . fromColumns
102 toResult = toColumns . fmap (toResult @exprs)
105instance AltTable NonEmptyTable where
106 (<|>:) = (<>)
109instance Table Expr a => Semigroup (NonEmptyTable a) where
110 NonEmptyTable as <> NonEmptyTable bs = NonEmptyTable $
111 happend (\_ _ (E a) (E b) -> E (sappend1 a b)) as bs
114nonEmptyTable :: Table Expr a => NonEmpty a -> NonEmptyTable a
115nonEmptyTable =
116 NonEmptyTable .
117 hvectorize (\SSpec {info} -> E . snonEmptyOf info . fmap unE) .
118 fmap toColumns
121insertNonEmptyTable :: Inserts exprs inserts
122 => NonEmpty exprs -> NonEmptyTable inserts
123insertNonEmptyTable = toInsert . nonEmptyTable
126nameNonEmptyTable :: Table Name a => a -> NonEmptyTable a
127nameNonEmptyTable =
128 NonEmptyTable .
129 hvectorize (\_ (Identity (N (Name a))) -> N (Name a)) .
130 pure .
131 toColumns