git.iko.soy/rel8
on db148ff help sign in
rel8/src/Rel8/Column/Maybe.hs
130 lines 4.0 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.Maybe
11 ( HMaybe, AHMaybe(..)
12 )
13where
15-- base
16import Data.Kind ( Type )
17import Prelude
19-- rel8
20import Rel8.Aggregate ( Aggregate )
21import Rel8.Expr ( Expr )
22import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
23import Rel8.Schema.Context ( Col )
24import Rel8.Schema.HTable.Maybe ( HMaybeTable )
25import Rel8.Schema.Insert ( Insert )
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, Context, fromColumns, toColumns
32 , Unreify, reify, unreify
33 )
34import Rel8.Table.Maybe ( MaybeTable )
35import Rel8.Table.Recontextualize ( Recontextualize )
38type HMaybe :: K.Context -> Type -> Type
39type family HMaybe context where
40 HMaybe (Reify context) = AHMaybe context
41 HMaybe Aggregate = MaybeTable
42 HMaybe Expr = MaybeTable
43 HMaybe Insert = MaybeTable
44 HMaybe Name = MaybeTable
45 HMaybe Result = Maybe
48type AHMaybe :: K.Context -> Type -> Type
49newtype AHMaybe context a = AHMaybe (HMaybe context a)
52instance Reifiable context => Functor (AHMaybe context) where
53 fmap = smapMaybe contextSing
56instance (Reifiable context, Table (Reify context) a) =>
57 Table (Reify context) (AHMaybe context a)
58 where
59 type Context (AHMaybe context a) = Reify context
60 type Columns (AHMaybe context a) = HMaybeTable (Columns a)
61 type Unreify (AHMaybe context a) = HMaybe context (Unreify a)
63 fromColumns = sfromColumnsMaybe contextSing
64 toColumns = stoColumnsMaybe contextSing
65 reify proof = fmap fmap reify proof . AHMaybe
66 unreify proof = (\(AHMaybe a) -> a) . fmap fmap unreify proof
69instance
70 ( Reifiable context, Reifiable context'
71 , Recontextualize (Reify context) (Reify context') a a'
72 ) =>
73 Recontextualize
74 (Reify context)
75 (Reify context')
76 (AHMaybe context a)
77 (AHMaybe context' a')
80smapMaybe :: ()
81 => SContext context
82 -> (a -> b)
83 -> AHMaybe context a
84 -> AHMaybe context b
85smapMaybe = \case
86 SAggregate -> \f (AHMaybe a) -> AHMaybe (fmap f a)
87 SExpr -> \f (AHMaybe a) -> AHMaybe (fmap f a)
88 SResult -> \f (AHMaybe a) -> AHMaybe (fmap f a)
89 SInsert -> \f (AHMaybe a) -> AHMaybe (fmap f a)
90 SName -> \f (AHMaybe a) -> AHMaybe (fmap f a)
91 SReify context -> \f (AHMaybe a) -> AHMaybe (smapMaybe context f a)
94sfromColumnsMaybe :: Table (Reify context) a
95 => SContext context
96 -> HMaybeTable (Columns a) (Col (Reify context))
97 -> AHMaybe context a
98sfromColumnsMaybe = \case
99 SAggregate -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
100 SExpr -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
101 SResult -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
102 SInsert -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
103 SName -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
104 SReify context ->
105 AHMaybe .
106 smapMaybe context (fromColumns . hreify) .
107 sfromColumnsMaybe context .
108 hunreify
111stoColumnsMaybe :: Table (Reify context) a
112 => SContext context
113 -> AHMaybe context a
114 -> HMaybeTable (Columns a) (Col (Reify context))
115stoColumnsMaybe = \case
116 SAggregate ->
117 hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
118 SExpr ->
119 hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
120 SResult ->
121 hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
122 SInsert ->
123 hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
124 SName ->
125 hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
126 SReify context ->
127 hreify .
128 stoColumnsMaybe context .
129 smapMaybe context (hunreify . toColumns) .
130 (\(AHMaybe a) -> a)