git.iko.soy/rel8
on ae2ce41 help sign in
rel8/src/Rel8/Column/NonEmpty.hs
150 lines 4.9 kB history raw
1{-# language DataKinds #-}
2{-# language FlexibleContexts #-}
3{-# language LambdaCase #-}
4{-# language MultiParamTypeClasses #-}
5{-# language StandaloneKindSignatures #-}
6{-# language TypeFamilies #-}
7{-# language UndecidableInstances #-}
9module Rel8.Column.NonEmpty
10 ( HNonEmpty, AHNonEmpty(..)
11 )
12where
14-- base
15import Data.Kind ( Type )
16import Data.List.NonEmpty ( NonEmpty )
17import Data.Type.Equality ( (:~:)( Refl ) )
18import Prelude
20-- rel8
21import Rel8.Aggregate ( Aggregate )
22import Rel8.Expr ( Expr )
23import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
24import Rel8.Schema.Context ( Col )
25import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
26import Rel8.Schema.Insert ( Insert )
27import qualified Rel8.Schema.Kind as K
28import Rel8.Schema.Name ( Name )
29import Rel8.Schema.Reify ( Reify, hreify, hunreify )
30import Rel8.Schema.Result ( Result )
31import Rel8.Table
32 ( Table, Columns, Congruent, Context, fromColumns, toColumns
33 , Unreify, reify, unreify
34 )
35import Rel8.Table.NonEmpty ( NonEmptyTable( NonEmptyTable ) )
36import Rel8.Table.Recontextualize ( Recontextualize )
37import Rel8.Table.Unreify ( Unreifiability(..), Unreifiable, unreifiability )
40type HNonEmpty :: K.Context -> Type -> Type
41type family HNonEmpty context where
42 HNonEmpty (Reify context) = AHNonEmpty context
43 HNonEmpty Aggregate = NonEmptyTable
44 HNonEmpty Expr = NonEmptyTable
45 HNonEmpty Insert = NonEmptyTable
46 HNonEmpty Name = NonEmptyTable
47 HNonEmpty Result = NonEmpty
50type AHNonEmpty :: K.Context -> Type -> Type
51newtype AHNonEmpty context a = AHNonEmpty (HNonEmpty context a)
54instance (Reifiable context, Unreifiable a, Table (Reify context) a) =>
55 Table (Reify context) (AHNonEmpty context a)
56 where
57 type Context (AHNonEmpty context a) = Reify context
58 type Columns (AHNonEmpty context a) = HNonEmptyTable (Columns a)
59 type Unreify (AHNonEmpty context a) = HNonEmpty context (Unreify a)
61 fromColumns = sfromColumnsNonEmpty contextSing
62 toColumns = stoColumnsNonEmpty contextSing
64 reify _ = sreifyNonEmpty (unreifiability contextSing)
65 unreify _ = sunreifyNonEmpty (unreifiability contextSing)
68instance
69 ( Reifiable context, Reifiable context'
70 , Unreifiable a, Unreifiable a'
71 , Recontextualize (Reify context) (Reify context') a a'
72 )
73 => Recontextualize
74 (Reify context)
75 (Reify context')
76 (AHNonEmpty context a)
77 (AHNonEmpty context' a')
80smapNonEmpty :: Congruent a b
81 => SContext context
82 -> (a -> b)
83 -> (HNonEmptyTable (Columns a) (Col (Context a)) -> HNonEmptyTable (Columns b) (Col (Context b)))
84 -> AHNonEmpty context a
85 -> AHNonEmpty context b
86smapNonEmpty = \case
87 SAggregate -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
88 SExpr -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
89 SResult -> \f _ (AHNonEmpty as) -> AHNonEmpty (fmap f as)
90 SInsert -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
91 SName -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
92 SReify context -> \f g (AHNonEmpty as) -> AHNonEmpty (smapNonEmpty context f g as)
95sfromColumnsNonEmpty :: Table (Reify context) a
96 => SContext context
97 -> HNonEmptyTable (Columns a) (Col (Reify context))
98 -> AHNonEmpty context a
99sfromColumnsNonEmpty = \case
100 SAggregate -> AHNonEmpty . NonEmptyTable
101 SExpr -> AHNonEmpty . NonEmptyTable
102 SResult ->
103 AHNonEmpty . fmap (fromColumns . hreify) . fromColumns . hunreify
104 SInsert -> AHNonEmpty . NonEmptyTable
105 SName -> AHNonEmpty . NonEmptyTable
106 SReify context ->
107 AHNonEmpty .
108 smapNonEmpty context (fromColumns . hreify) hreify .
109 sfromColumnsNonEmpty context .
110 hunreify
113stoColumnsNonEmpty :: Table (Reify context) a
114 => SContext context
115 -> AHNonEmpty context a
116 -> HNonEmptyTable (Columns a) (Col (Reify context))
117stoColumnsNonEmpty = \case
118 SAggregate -> \(AHNonEmpty (NonEmptyTable a)) -> a
119 SExpr -> \(AHNonEmpty (NonEmptyTable a)) -> a
120 SResult ->
121 hreify . toColumns . fmap (hunreify . toColumns) . (\(AHNonEmpty a) -> a)
122 SInsert -> \(AHNonEmpty (NonEmptyTable a)) -> a
123 SName -> \(AHNonEmpty (NonEmptyTable a)) -> a
124 SReify context ->
125 hreify .
126 stoColumnsNonEmpty context .
127 smapNonEmpty context (hunreify . toColumns) hunreify .
128 (\(AHNonEmpty a) -> a)
131sreifyNonEmpty :: Table (Reify context) a
132 => Unreifiability context a
133 -> HNonEmpty context (Unreify a)
134 -> AHNonEmpty context a
135sreifyNonEmpty = \case
136 UResult -> AHNonEmpty . fmap (reify Refl)
137 Unreifiability context ->
138 smapNonEmpty context (reify Refl) hreify .
139 AHNonEmpty
142sunreifyNonEmpty :: Table (Reify context) a
143 => Unreifiability context a
144 -> AHNonEmpty context a
145 -> HNonEmpty context (Unreify a)
146sunreifyNonEmpty = \case
147 UResult -> fmap (unreify Refl) . (\(AHNonEmpty a) -> a)
148 Unreifiability context ->
149 (\(AHNonEmpty a) -> a) .
150 smapNonEmpty context (unreify Refl) hunreify