@@ -27,36 +27,41 @@ withRepr :: Constructor a
2727withRepr = ReprObject . rmap (unTagged . getCompose) . fcast
2828
2929class Representable s where
30− type Repr s :: Type
31− construct :: Sing fn -> Proxy s -> Repr s -> FieldRepr '(fn, s)
30+ constructField :: Sing fn -> Proxy s -> Repr s -> FieldRepr '(fn, s)
3231
3332instance SingI so => Representable ('SchemaObject so) where
34− type Repr ('SchemaObject so) = Rec FieldRepr so
35− construct sfn _ o = withKnownSymbol sfn $ FieldRepr $ ReprObject o
33+ constructField sfn _ o = withKnownSymbol sfn $ FieldRepr $ ReprObject o
3634
3735instance (SingI cs, SingI sa) => Representable ('SchemaArray cs sa) where
38− type Repr ('SchemaArray cs sa) = V.Vector (JsonRepr sa)
39− construct sfn _ a = withKnownSymbol sfn $ FieldRepr $ ReprArray a
36+ constructField sfn _ a = withKnownSymbol sfn $ FieldRepr $ ReprArray a
4037
4138instance SingI cs => Representable ('SchemaText cs) where
42− type Repr ('SchemaText cs) = Text
43− construct sfn _ t = withKnownSymbol sfn $ FieldRepr $ ReprText t
39+ constructField sfn _ t = withKnownSymbol sfn $ FieldRepr $ ReprText t
4440
4541instance SingI cs => Representable ('SchemaNumber cs) where
46− type Repr ('SchemaNumber cs) = Scientific
47− construct sfn _ n = withKnownSymbol sfn $ FieldRepr $ ReprNumber n
42+ constructField sfn _ n = withKnownSymbol sfn $ FieldRepr $ ReprNumber n
4843
4944instance Representable 'SchemaBoolean where
50− type Repr 'SchemaBoolean = Bool
51− construct sfn _ b = withKnownSymbol sfn $ FieldRepr $ ReprBoolean b
45+ constructField sfn _ b = withKnownSymbol sfn $ FieldRepr $ ReprBoolean b
5246
5347instance SingI so => Representable ('SchemaOptional so) where
54− type Repr ('SchemaOptional so) = Maybe (JsonRepr so)
55− construct sfn _ o = withKnownSymbol sfn $ FieldRepr $ ReprOptional o
48+ constructField sfn _ o = withKnownSymbol sfn $ FieldRepr $ ReprOptional o
5649
5750instance SingI (h ': tl) => Representable ('SchemaUnion (h ': tl)) where
58− type Repr ('SchemaUnion (h ': tl)) = Union JsonRepr (h ': tl)
59− construct sfn _ u = withKnownSymbol sfn $ FieldRepr $ ReprUnion u
51+ constructField sfn _ u = withKnownSymbol sfn $ FieldRepr $ ReprUnion u
52+
53+construct :: Sing s -> Repr s -> JsonRepr s
54+construct s r = case s of
55+ SSchemaObject _ -> ReprObject r
56+ SSchemaArray _ _ -> ReprArray r
57+ SSchemaText _ -> ReprText r
58+ SSchemaNumber _ -> ReprNumber r
59+ SSchemaBoolean -> ReprBoolean r
60+ SSchemaOptional _ -> ReprOptional r
61+ SSchemaNull -> ReprNull
62+ SSchemaUnion ss -> case ss of
63+ SNil -> error "unconstructable union"
64+ SCons _ _ -> ReprUnion r
6065
6166type family FieldsOf (s :: Schema) :: [(Symbol, Schema)] where
6267 FieldsOf ('SchemaObject fs) = fs
@@ -67,4 +72,13 @@ type FieldConstructor fn =
6772 -> (Tagged fs :. FieldRepr) '(fn, (ByField fn fs (FIndex fn fs)))
6873
6974field :: forall fn. KnownSymbol fn => FieldConstructor fn
70−field = Compose . Tagged . construct (sing :: Sing fn) Proxy
75+field = Compose . Tagged . constructField (sing :: Sing fn) Proxy
76+
77+type family Repr (s :: Schema) = (ty :: Type) where
78+ Repr ('SchemaObject so) = Rec FieldRepr so
79+ Repr ('SchemaArray cs sa) = V.Vector (JsonRepr sa)
80+ Repr ('SchemaText cs) = Text
81+ Repr ('SchemaNumber cs) = Scientific
82+ Repr 'SchemaBoolean = Bool
83+ Repr ('SchemaOptional so) = Maybe (JsonRepr so)
84+ Repr ('SchemaUnion (h ': tl)) = Union JsonRepr (h ': tl)