git.iko.soy/rel8
on eb180fa help sign in
rel8/src/Rel8/Schema/Context.hs
100 lines 2.9 kB history raw
1{-# language DataKinds #-}
2{-# language DerivingStrategies #-}
3{-# language FlexibleContexts #-}
4{-# language FlexibleInstances #-}
5{-# language GADTs #-}
6{-# language GeneralizedNewtypeDeriving #-}
7{-# language MultiParamTypeClasses #-}
8{-# language ScopedTypeVariables #-}
9{-# language StandaloneDeriving #-}
10{-# language StandaloneKindSignatures #-}
11{-# language TypeApplications #-}
12{-# language TypeFamilies #-}
13{-# language UndecidableInstances #-}
15module Rel8.Schema.Context
16 ( Col'( .. )
17 , Interpretation, Col
18 , Insertion(..)
19 , Name(..)
20 , IsSpecialContext
21 )
22where
24-- base
25import Data.Functor.Identity ( Identity )
26import Data.Kind ( Constraint )
27import Data.String ( IsString )
28import Prelude
30-- rel8
31import Rel8.Aggregate ( Aggregate )
32import Rel8.Expr ( Expr )
33import Rel8.Kind.Necessity ( Necessity( Optional, Required ) )
34import qualified Rel8.Schema.Kind as K
35import Rel8.Schema.Spec ( Spec( Spec ) )
36import Rel8.Schema.Structure ( Structure )
39type Interpretation' :: Bool -> K.Context -> Constraint
40class IsSpecialContext f ~ isSpecial => Interpretation' isSpecial f where
41 data Col' isSpecial f :: K.HContext
44instance Interpretation' 'True Aggregate where
45 data Col' 'True Aggregate _spec where
46 Aggregation :: ()
47 => Aggregate (Expr a)
48 -> Col' 'True Aggregate ('Spec labels necessity db a)
51instance Interpretation' 'True Expr where
52 data Col' 'True Expr _spec where
53 DB :: ()
54 => { unDB :: Expr a }
55 -> Col' 'True Expr ('Spec labels necessity db a)
58instance Interpretation' 'True Identity where
59 data Col' 'True Identity _spec where
60 Result :: a -> Col' 'True Identity ('Spec labels necessity db a)
63instance Interpretation' 'True Insertion where
64 data Col' 'True Insertion _spec where
65 RequiredInsert :: Expr a -> Col' 'True Insertion ('Spec labels 'Required db a)
66 OptionalInsert :: Maybe (Expr a) -> Col' 'True Insertion ('Spec labels 'Optional db a)
69instance IsSpecialContext f ~ 'False => Interpretation' 'False f where
70 data Col' 'False f _spec where
71 Col :: f a -> Col' 'False f ('Spec labels necessity db a)
74type Interpretation :: K.Context -> Constraint
75class Interpretation' (IsSpecialContext context) context => Interpretation context
76instance Interpretation' (IsSpecialContext context) context => Interpretation context
79type Col :: K.Context -> K.HContext
80type Col context = Col' (IsSpecialContext context) context
83type Insertion :: K.Context
84newtype Insertion a = Insertion (Expr a)
87type Name :: K.Context
88newtype Name a = Name String
89 deriving stock Show
90 deriving newtype (IsString, Monoid, Semigroup)
93type IsSpecialContext :: K.Context -> Bool
94type family IsSpecialContext context where
95 IsSpecialContext Aggregate = 'True
96 IsSpecialContext Expr = 'True
97 IsSpecialContext Insertion = 'True
98 IsSpecialContext Identity = 'True
99 IsSpecialContext Structure = 'True
100 IsSpecialContext _ = 'False