git.iko.soy/rel8
on db148ff help sign in
rel8/src/Rel8/Column/NonEmpty.hs
135 lines 4.4 kB history raw
1{-# language DataKinds #-}
2{-# language FlexibleContexts #-}
3{-# language GADTs #-}
4{-# language LambdaCase #-}
5{-# language MultiParamTypeClasses #-}
6{-# language StandaloneKindSignatures #-}
7{-# language TypeFamilies #-}
8{-# language UndecidableInstances #-}
10module Rel8.Column.NonEmpty
11 ( HNonEmpty, AHNonEmpty(..)
12 )
13where
15-- base
16import Data.Kind ( Type )
17import Data.List.NonEmpty ( NonEmpty )
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 ( Unreifiable )
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
55 ( Reifiable context
56 , Table (Reify context) a
57 , Unreifiable (Reify context) a
58 )
59 => Table (Reify context) (AHNonEmpty context a)
60 where
61 type Context (AHNonEmpty context a) = Reify context
62 type Columns (AHNonEmpty context a) = HNonEmptyTable (Columns a)
63 type Unreify (AHNonEmpty context a) = HNonEmpty context (Unreify a)
65 fromColumns = sfromColumnsNonEmpty contextSing
66 toColumns = stoColumnsNonEmpty contextSing
67 reify proof =
68 smapNonEmpty contextSing (reify proof) hreify .
69 AHNonEmpty
70 unreify proof =
71 (\(AHNonEmpty a) -> a) .
72 smapNonEmpty contextSing (unreify proof) hunreify
75instance
76 ( Reifiable context, Reifiable context'
77 , Unreifiable (Reify context) a, Unreifiable (Reify context') a'
78 , Recontextualize (Reify context) (Reify context') a a'
79 ) =>
80 Recontextualize
81 (Reify context)
82 (Reify context')
83 (AHNonEmpty context a)
84 (AHNonEmpty context' a')
87smapNonEmpty :: Congruent a b
88 => SContext context
89 -> (a -> b)
90 -> (HNonEmptyTable (Columns a) (Col (Context a)) -> HNonEmptyTable (Columns b) (Col (Context b)))
91 -> AHNonEmpty context a
92 -> AHNonEmpty context b
93smapNonEmpty = \case
94 SAggregate -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
95 SExpr -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
96 SResult -> \f _ (AHNonEmpty as) -> AHNonEmpty (fmap f as)
97 SInsert -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
98 SName -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
99 SReify context -> \f g (AHNonEmpty as) -> AHNonEmpty (smapNonEmpty context f g as)
102sfromColumnsNonEmpty :: Table (Reify context) a
103 => SContext context
104 -> HNonEmptyTable (Columns a) (Col (Reify context))
105 -> AHNonEmpty context a
106sfromColumnsNonEmpty = \case
107 SAggregate -> AHNonEmpty . NonEmptyTable
108 SExpr -> AHNonEmpty . NonEmptyTable
109 SResult ->
110 AHNonEmpty . fmap (fromColumns . hreify) . fromColumns . hunreify
111 SInsert -> AHNonEmpty . NonEmptyTable
112 SName -> AHNonEmpty . NonEmptyTable
113 SReify context ->
114 AHNonEmpty .
115 smapNonEmpty context (fromColumns . hreify) hreify .
116 sfromColumnsNonEmpty context .
117 hunreify
120stoColumnsNonEmpty :: Table (Reify context) a
121 => SContext context
122 -> AHNonEmpty context a
123 -> HNonEmptyTable (Columns a) (Col (Reify context))
124stoColumnsNonEmpty = \case
125 SAggregate -> \(AHNonEmpty (NonEmptyTable a)) -> a
126 SExpr -> \(AHNonEmpty (NonEmptyTable a)) -> a
127 SResult ->
128 hreify . toColumns . fmap (hunreify . toColumns) . (\(AHNonEmpty a) -> a)
129 SInsert -> \(AHNonEmpty (NonEmptyTable a)) -> a
130 SName -> \(AHNonEmpty (NonEmptyTable a)) -> a
131 SReify context ->
132 hreify .
133 stoColumnsNonEmpty context .
134 smapNonEmpty context (hunreify . toColumns) hunreify .
135 (\(AHNonEmpty a) -> a)