git.iko.soy/rel8
on master help sign in
Simplify Labels
commitdb148ff18d5bf380d31a602427edd3eaa63b35a7 authorShane O'Brien <shane.obrien@circuithub.com> dateWed 5 May 2021, 15:04 (6 years ago) parentcfe8a70
3 files changed+21−26
compare with master
unifiedsplit
src/Rel8/Kind/Labels.hs+14−18 src/Rel8/Schema/HTable/Label.hs+2−2 src/Rel8/Schema/HTable/Type.hs+5−6
src/Rel8/Kind/Labels.hs+14−18
@@ -8,7 +8,7 @@
88
99module Rel8.Kind.Labels
1010 ( Labels
11− , SLabels( SLabel, SLabels )
11+ , SLabels( SNil, SCons )
1212 , KnownLabels( labelsSing )
1313 , renderLabels
1414 )
@@ -16,7 +16,8 @@ where
1616
1717-- base
1818import Data.Kind ( Constraint, Type )
19−import Data.List.NonEmpty ( NonEmpty( (:|) ), (<|) )
19+import Data.List.NonEmpty ( NonEmpty, nonEmpty )
20+import Data.Maybe ( fromMaybe )
2021import Data.Proxy ( Proxy( Proxy ) )
2122import GHC.TypeLits ( KnownSymbol, Symbol, symbolVal )
2223import Prelude
@@ -28,8 +29,8 @@ type Labels = [Symbol]
2829
2930type SLabels :: Labels -> Type
3031data SLabels labels where
31− SLabel :: KnownSymbol label => Proxy label -> SLabels '[label]
32− SLabels :: KnownSymbol label => Proxy label -> SLabels labels -> SLabels (label ': labels)
32+ SNil :: SLabels '[]
33+ SCons :: KnownSymbol label => Proxy label -> SLabels labels -> SLabels (label ': labels)
3334
3435
3536type KnownLabels :: Labels -> Constraint
@@ -37,25 +38,20 @@ class KnownLabels labels where
3738 labelsSing :: SLabels labels
3839
3940
40−instance KnownSymbol label => KnownLabels (label ': '[]) where
41− labelsSing = SLabel Proxy
41+instance KnownLabels '[] where
42+ labelsSing = SNil
4243
4344
44−instance (KnownSymbol label, KnownLabels (label_ ': labels)) =>
45− KnownLabels (label ': (label_ ': labels))
45+instance (KnownSymbol label, KnownLabels labels) =>
46+ KnownLabels (label ': labels)
4647 where
47− labelsSing = SLabels Proxy labelsSing
48+ labelsSing = SCons Proxy labelsSing
4849
4950
5051renderLabels :: SLabels labels -> NonEmpty String
51−renderLabels = cleanup . go
52+renderLabels = fromMaybe (pure "anon") . nonEmpty . go
5253 where
53− go :: SLabels labels -> NonEmpty String
54+ go :: SLabels labels -> [String]
5455 go = \case
55− SLabel label -> pure (symbolVal label)
56− SLabels label labels -> symbolVal label <| go labels
57−
58− cleanup ("" :| []) = "anon" :| []
59− cleanup (a :| []) = a :| []
60− cleanup (a :| [""]) = a :| []
61− cleanup (a :| (b : c)) = a <| cleanup (b :| c)
56+ SNil -> []
57+ SCons label labels -> symbolVal label : go labels
src/Rel8/Schema/HTable/Label.hs+2−2
@@ -28,7 +28,7 @@ import GHC.TypeLits ( KnownSymbol, Symbol )
2828import Prelude
2929
3030-- rel8
31−import Rel8.Kind.Labels ( SLabels( SLabels ) )
31+import Rel8.Kind.Labels ( SLabels( SCons ) )
3232import Rel8.Schema.HTable
3333 ( HTable
3434 , hfield, htabulate, hspecs
@@ -54,7 +54,7 @@ type instance Eval (Label label ('Spec labels necessity a)) = 'Spec (label : lab
5454
5555instance KnownSymbol l => MapSpec (Label l) where
5656 mapInfo = \case
57− SSpec {..} -> SSpec {labels = SLabels Proxy labels, ..}
57+ SSpec {..} -> SSpec {labels = SCons Proxy labels, ..}
5858
5959
6060hlabel :: (HTable t, KnownSymbol label)
src/Rel8/Schema/HTable/Type.hs+5−6
@@ -11,11 +11,10 @@ where
1111
1212-- base
1313import Data.Kind ( Type )
14−import Data.Proxy ( Proxy( Proxy ) )
1514import Prelude
1615
1716-- rel8
18−import Rel8.Kind.Labels ( SLabels( SLabel ) )
17+import Rel8.Kind.Labels ( SLabels( SNil ) )
1918import Rel8.Kind.Necessity ( Necessity( Required ), SNecessity( SRequired ) )
2019import Rel8.Schema.Dict ( Dict( Dict ) )
2120import Rel8.Schema.HTable
@@ -30,17 +29,17 @@ import Rel8.Type ( DBType, typeInformation )
3029
3130type HType :: Type -> K.HTable
3231newtype HType a context = HType
33− { unHType :: context ('Spec '[""] 'Required a)
32+ { unHType :: context ('Spec '[] 'Required a)
3433 }
3534
3635
3736type HTypeField :: Type -> Spec -> Type
3837data HTypeField a spec where
39− HTypeField :: HTypeField a ('Spec '[""] 'Required a)
38+ HTypeField :: HTypeField a ('Spec '[] 'Required a)
4039
4140
4241instance Sql DBType a => HTable (HType a) where
43− type HConstrainTable (HType a) c = c ('Spec '[""] 'Required a)
42+ type HConstrainTable (HType a) c = c ('Spec '[] 'Required a)
4443 type HField (HType a) = HTypeField a
4544
4645 hfield (HType a) HTypeField = a
@@ -48,7 +47,7 @@ instance Sql DBType a => HTable (HType a) where
4847 htraverse f (HType a) = HType <$> f a
4948 hdicts = HType Dict
5049 hspecs = HType SSpec
51− { labels = SLabel Proxy
50+ { labels = SNil
5251 , necessity = SRequired
5352 , info = typeInformation
5453 , nullity = nullable