@@ -1,7 +1,6 @@
11{-# LANGUAGE AllowAmbiguousTypes #-}
22{-# LANGUAGE DataKinds #-}
33{-# LANGUAGE InstanceSigs #-}
4−{-# LANGUAGE TypeInType #-}
54{-# LANGUAGE UndecidableInstances #-}
65{-# OPTIONS_GHC -fprint-explicit-kinds #-}
76
@@ -21,7 +20,6 @@ data JType
2120 | JObject
2221 | JNull
2322
24−
2523type family Repr (ty :: JType) :: * where
2624 Repr 'JText = String -- because of matchRegex
2725 Repr 'JNumber = Double
@@ -45,37 +43,38 @@ instance KnownNat nat => Constrained 'JNumber (Gt nat) where
4543
4644data Field field ty schema
4745
48−instance (SchemaConstructor (JT jty), Verifiable (JT jty) cs, KnownSymbol field)
49− => Constrained JObject (Field field ty cs) where
50− cRep _ _ =
51− (symbolVal (Proxy @field), constructor (Proxy @(JT jty))
52− $ schema (Proxy @(JT jty)) (Proxy @cs))
53−
5446data Empty
5547
5648class Verifiable ty cs where
5749 schema :: Proxy ty -> Proxy cs -> [CRepr ty]
5850
5951instance
60− (Constrained 'JText c, Verifiable 'JText cs) => Verifiable 'JText (c ': cs) where
61− schema _ _ = cRep (Proxy @'JText) (Proxy @c) : schema (Proxy @'JText) (Proxy @cs)
52+ ( Constrained 'JText c
53+ , Verifiable 'JText cs )
54+ => Verifiable 'JText (c ': cs) where
55+ schema _ _ = cRep (Proxy @'JText) (Proxy @c)
56+ : schema (Proxy @'JText) (Proxy @cs)
6257
6358instance
64− (Constrained 'JNumber c, Verifiable 'JNumber cs) => Verifiable 'JNumber (c ': cs) where
65− schema _ _ = cRep (Proxy @'JNumber) (Proxy @c) : schema (Proxy @'JNumber) (Proxy @cs)
59+ ( Constrained 'JNumber c
60+ , Verifiable 'JNumber cs )
61+ => Verifiable 'JNumber (c ': cs) where
62+ schema _ _ = cRep (Proxy @'JNumber) (Proxy @c)
63+ : schema (Proxy @'JNumber) (Proxy @cs)
6664
6765instance Verifiable jty '[] where
6866 schema _ _ = []
6967
7068instance
71− (Constrained 'JObject c, Verifiable 'JObject cs, KnownSymbol field)
72− => Verifiable 'JObject ((Field field jty c) ': cs) where
73− schema _ _ = cRep (Proxy @'JObject) (Proxy @c) : schema (Proxy @'JObject) (Proxy @cs)
74−
75−-- type family VerifiableFields (ty :: JType) (els :: [k]) :: Constraint where
76−-- VerifiableFields ty '[] = ()
77−-- VerifiableFields ty ((Field f jty s) ': elss)
78−-- = (Verifiable jty s, VerifiableFields ty elss)
69+ ( SchemaConstructor jty
70+ , Verifiable 'JObject fs
71+ , KnownSymbol field
72+ , Verifiable jty cs )
73+ => Verifiable 'JObject ((Field field jty cs) ': fs) where
74+ schema _ _ = (fieldName, fieldSchema) : schema (Proxy @'JObject) (Proxy @fs)
75+ where
76+ fieldName = symbolVal (Proxy @field)
77+ fieldSchema = constructor (Proxy @jty) $ schema (Proxy @jty) (Proxy @cs)
7978
8079type family CRepr (jty :: JType) :: * where
8180 CRepr JText = TextConstraint
@@ -102,9 +101,9 @@ data Schema
102101 deriving (Show, Eq)
103102
104103-- | Apply constraint for each element of list
105−type family AllSatisfy (c :: k -> Constraint) (s :: [k]) :: Constraint where
106− AllSatisfy c '[] = ()
107− AllSatisfy c (a ': as) = (c a, AllSatisfy c as)
104+-- type family AllSatisfy (c :: k -> Constraint) (s :: [k]) :: Constraint where
105+-- AllSatisfy c '[] = ()
106+-- AllSatisfy c (a ': as) = (c a, AllSatisfy c as)
108107
109108class SchemaConstructor jty where
110109 constructor :: Proxy jty -> [CRepr jty] -> Schema
@@ -141,8 +140,7 @@ instance (Verifiable (JT ty) cs, SchemaConstructor (JT ty)) => Schematic (Field
141140
142141data SObject els
143142
144−instance (els ~ '[k], Verifiable 'JObject els, AllSatisfy Schematic els)
145− => Schematic (SObject els) where
143+instance (Verifiable 'JObject els) => Schematic (SObject els) where
146144 type JT (SObject els) = 'JObject
147145 build _ =
148146 constructor (Proxy @(JT (SObject els)))