on e48c73e help sign in
rel8/src/Rel8/Kind/Labels.hs
57 lines 1.3 kB history raw
1{-# language DataKinds #-}
2{-# language FlexibleContexts #-}
3{-# language FlexibleInstances #-}
4{-# language GADTs #-}
5{-# language LambdaCase #-}
6{-# language StandaloneKindSignatures #-}
7{-# language TypeOperators #-}
9module Rel8.Kind.Labels
10 ( Labels
11 , SLabels( SNil, SCons )
12 , KnownLabels( labelsSing )
13 , renderLabels
14 )
15where
17-- base
18import Data.Kind ( Constraint, Type )
19import Data.List.NonEmpty ( NonEmpty, nonEmpty )
20import Data.Maybe ( fromMaybe )
21import Data.Proxy ( Proxy( Proxy ) )
22import GHC.TypeLits ( KnownSymbol, Symbol, symbolVal )
23import Prelude
26type Labels :: Type
27type Labels = [Symbol]
30type SLabels :: Labels -> Type
31data SLabels labels where
32 SNil :: SLabels '[]
33 SCons :: KnownSymbol label => Proxy label -> SLabels labels -> SLabels (label ': labels)
36type KnownLabels :: Labels -> Constraint
37class KnownLabels labels where
38 labelsSing :: SLabels labels
41instance KnownLabels '[] where
42 labelsSing = SNil
45instance (KnownSymbol label, KnownLabels labels) =>
46 KnownLabels (label ': labels)
47 where
48 labelsSing = SCons Proxy labelsSing
51renderLabels :: SLabels labels -> NonEmpty String
52renderLabels = fromMaybe (pure "anon") . nonEmpty . go
53 where
54 go :: SLabels labels -> [String]
55 go = \case
56 SNil -> []
57 SCons label labels -> symbolVal label : go labels