git.iko.soy/rel8
on 137ebed help sign in
rel8/src/Rel8/Column/NonEmpty.hs
148 lines 4.8 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 qualified Rel8.Schema.Kind as K
27import Rel8.Schema.Name ( Name )
28import Rel8.Schema.Reify ( Reify, hreify, hunreify )
29import Rel8.Schema.Result ( Result )
30import Rel8.Table
31 ( Table, Columns, Congruent, Context, fromColumns, toColumns
32 , Unreify, reify, unreify
33 )
34import Rel8.Table.NonEmpty ( NonEmptyTable( NonEmptyTable ) )
35import Rel8.Table.Recontextualize ( Recontextualize )
36import Rel8.Table.Unreify ( Unreifiability(..), Unreifiable, unreifiability )
39-- | Nest a 'NonEmpty' list within a 'Rel8able'. @HNonEmpty f a@ will produce a
40-- 'NonEmptyTable' @a@ in the 'Expr' context, and a 'NonEmpty' @a@ in the
41-- 'Result' context.
42type HNonEmpty :: K.Context -> Type -> Type
43type family HNonEmpty context where
44 HNonEmpty (Reify context) = AHNonEmpty context
45 HNonEmpty Aggregate = NonEmptyTable
46 HNonEmpty Expr = NonEmptyTable
47 HNonEmpty Name = NonEmptyTable
48 HNonEmpty Result = NonEmpty
51type AHNonEmpty :: K.Context -> Type -> Type
52newtype AHNonEmpty context a = AHNonEmpty (HNonEmpty context a)
55instance (Reifiable context, Unreifiable a, Table (Reify context) a) =>
56 Table (Reify context) (AHNonEmpty context a)
57 where
58 type Context (AHNonEmpty context a) = Reify context
59 type Columns (AHNonEmpty context a) = HNonEmptyTable (Columns a)
60 type Unreify (AHNonEmpty context a) = HNonEmpty context (Unreify a)
62 fromColumns = sfromColumnsNonEmpty contextSing
63 toColumns = stoColumnsNonEmpty contextSing
65 reify _ = sreifyNonEmpty (unreifiability contextSing)
66 unreify _ = sunreifyNonEmpty (unreifiability contextSing)
69instance
70 ( Reifiable context, Reifiable context'
71 , Unreifiable a, Unreifiable a'
72 , Recontextualize (Reify context) (Reify context') a a'
73 )
74 => Recontextualize
75 (Reify context)
76 (Reify context')
77 (AHNonEmpty context a)
78 (AHNonEmpty context' a')
81smapNonEmpty :: Congruent a b
82 => SContext context
83 -> (a -> b)
84 -> (HNonEmptyTable (Columns a) (Col (Context a)) -> HNonEmptyTable (Columns b) (Col (Context b)))
85 -> AHNonEmpty context a
86 -> AHNonEmpty context b
87smapNonEmpty = \case
88 SAggregate -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
89 SExpr -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
90 SResult -> \f _ (AHNonEmpty as) -> AHNonEmpty (fmap f as)
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 SName -> AHNonEmpty . NonEmptyTable
105 SReify context ->
106 AHNonEmpty .
107 smapNonEmpty context (fromColumns . hreify) hreify .
108 sfromColumnsNonEmpty context .
109 hunreify
112stoColumnsNonEmpty :: Table (Reify context) a
113 => SContext context
114 -> AHNonEmpty context a
115 -> HNonEmptyTable (Columns a) (Col (Reify context))
116stoColumnsNonEmpty = \case
117 SAggregate -> \(AHNonEmpty (NonEmptyTable a)) -> a
118 SExpr -> \(AHNonEmpty (NonEmptyTable a)) -> a
119 SResult ->
120 hreify . toColumns . fmap (hunreify . toColumns) . (\(AHNonEmpty a) -> a)
121 SName -> \(AHNonEmpty (NonEmptyTable a)) -> a
122 SReify context ->
123 hreify .
124 stoColumnsNonEmpty context .
125 smapNonEmpty context (hunreify . toColumns) hunreify .
126 (\(AHNonEmpty a) -> a)
129sreifyNonEmpty :: Table (Reify context) a
130 => Unreifiability context a
131 -> HNonEmpty context (Unreify a)
132 -> AHNonEmpty context a
133sreifyNonEmpty = \case
134 UResult -> AHNonEmpty . fmap (reify Refl)
135 Unreifiability context ->
136 smapNonEmpty context (reify Refl) hreify .
137 AHNonEmpty
140sunreifyNonEmpty :: Table (Reify context) a
141 => Unreifiability context a
142 -> AHNonEmpty context a
143 -> HNonEmpty context (Unreify a)
144sunreifyNonEmpty = \case
145 UResult -> fmap (unreify Refl) . (\(AHNonEmpty a) -> a)
146 Unreifiability context ->
147 (\(AHNonEmpty a) -> a) .
148 smapNonEmpty context (unreify Refl) hunreify