on fce7213 help sign in
67 lines 1.6 kB history raw
1{-# language DataKinds #-}
2{-# language LambdaCase #-}
3{-# language FlexibleInstances #-}
4{-# language MultiParamTypeClasses #-}
5{-# language StandaloneKindSignatures #-}
6{-# language TypeFamilies #-}
7{-# language TypeOperators #-}
9module Rel8.Schema.Context.Label
10 ( Labelable( labeler, unlabeler )
11 )
12where
14-- base
15import Data.Kind ( Constraint )
16import Prelude hiding ( null )
18-- rel8
19import Rel8.Schema.Context
20 ( Aggregation( Aggregation )
21 , DB( DB )
22 , Insertion( RequiredInsert, OptionalInsert )
23 , Name( Name )
24 , Result( Result )
25 )
26import Rel8.Schema.Spec ( Context, Spec( Spec ) )
29type Labelable :: Context -> Constraint
30class Labelable context where
31 labeler :: ()
32 => context ('Spec labels necessity db a)
33 -> context ('Spec (label ': labels) necessity db a)
35 unlabeler :: ()
36 => context ('Spec (label ': labels) necessity db a)
37 -> context ('Spec labels necessity db a)
40instance Labelable Aggregation where
41 labeler (Aggregation aggregate) = Aggregation aggregate
42 unlabeler (Aggregation aggregate) = Aggregation aggregate
45instance Labelable DB where
46 labeler (DB a) = DB a
47 unlabeler (DB a) = DB a
50instance Labelable Insertion where
51 labeler = \case
52 RequiredInsert a -> RequiredInsert a
53 OptionalInsert ma -> OptionalInsert ma
55 unlabeler = \case
56 RequiredInsert a -> RequiredInsert a
57 OptionalInsert ma -> OptionalInsert ma
60instance Labelable Name where
61 labeler (Name name) = Name name
62 unlabeler (Name name) = Name name
65instance Labelable Result where
66 labeler (Result a) = Result a
67 unlabeler (Result a) = Result a