git.iko.soy/rel8
on 00a36f5 help sign in
rel8/src/Rel8/Kind/Labels.hs
61 lines 1.6 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( SLabel, SLabels )
12 , KnownLabels( labelsSing )
13 , renderLabels
14 )
15where
17-- base
18import Data.Kind ( Constraint, Type )
19import Data.List.NonEmpty ( NonEmpty( (:|) ), (<|) )
20import Data.Proxy ( Proxy( Proxy ) )
21import GHC.TypeLits ( KnownSymbol, Symbol, symbolVal )
22import Prelude
25type Labels :: Type
26type Labels = [Symbol]
29type SLabels :: Labels -> Type
30data SLabels labels where
31 SLabel :: KnownSymbol label => Proxy label -> SLabels '[label]
32 SLabels :: KnownSymbol label => Proxy label -> SLabels labels -> SLabels (label ': labels)
35type KnownLabels :: Labels -> Constraint
36class KnownLabels labels where
37 labelsSing :: SLabels labels
40instance KnownSymbol label => KnownLabels (label ': '[]) where
41 labelsSing = SLabel Proxy
44instance (KnownSymbol label, KnownLabels (label_ ': labels)) =>
45 KnownLabels (label ': (label_ ': labels))
46 where
47 labelsSing = SLabels Proxy labelsSing
50renderLabels :: SLabels labels -> NonEmpty String
51renderLabels = cleanup . go
52 where
53 go :: SLabels labels -> NonEmpty String
54 go = \case
55 SLabel label -> pure (symbolVal label)
56 SLabels label labels -> symbolVal label <| go labels
58 cleanup ("" :| []) = "anon" :| []
59 cleanup (a :| []) = a :| []
60 cleanup (a :| [""]) = a :| []
61 cleanup (a :| (b : c)) = a <| cleanup (b :| c)