git.iko.soy/rel8
on db148ff help sign in
rel8/src/Rel8/Schema/Context/Label.hs
60 lines 1.6 kB history raw
1{-# language DataKinds #-}
2{-# language FlexibleInstances #-}
3{-# language StandaloneKindSignatures #-}
4{-# language TypeFamilies #-}
5{-# language TypeOperators #-}
7module Rel8.Schema.Context.Label
8 ( Labelable( labeler, unlabeler )
9 , HLabelable( hlabeler, hunlabeler )
10 )
11where
13-- base
14import Data.Kind ( Constraint )
15import Prelude hiding ( null )
17-- rel8
18import Rel8.Schema.Context ( Interpretation )
19import Rel8.Schema.Dict ( Dict( Dict ) )
20import Rel8.Schema.Kind ( Context, HContext )
21import Rel8.Schema.Spec ( Spec( Spec ) )
22import Rel8.Schema.Result ( Col( Result ), Result )
23import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )
26type Labelable :: Context -> Constraint
27class Interpretation context => Labelable context where
28 labeler :: ()
29 => Col context ('Spec labels necessity a)
30 -> Col context ('Spec (label ': labels) necessity a)
32 unlabeler :: ()
33 => Col context ('Spec (label ': labels) necessity a)
34 -> Col context ('Spec labels necessity a)
37instance Labelable Result where
38 labeler (Result a) = Result a
39 unlabeler (Result a) = Result a
42type HLabelable :: HContext -> Constraint
43class HLabelable context where
44 hlabeler :: ()
45 => context ('Spec labels necessity a)
46 -> context ('Spec (label ': labels) necessity a)
48 hunlabeler :: ()
49 => context ('Spec (label ': labels) necessity a)
50 -> context ('Spec labels necessity a)
53instance Labelable context => HLabelable (Col context) where
54 hlabeler = labeler
55 hunlabeler = unlabeler
58instance HLabelable (Dict (ConstrainDBType constraint)) where
59 hlabeler Dict = Dict
60 hunlabeler Dict = Dict