@@ -24,6 +24,12 @@ type family Repr (ty :: JType) :: * where
2424 Repr 'JText = String -- because of matchRegex
2525 Repr 'JNumber = Double
2626
27+type family CRepr (jty :: JType) :: * where
28+ CRepr JText = TextConstraint
29+ CRepr JNumber = NumberConstraint
30+ CRepr JObject = (String, Schema)
31+ CRepr JArray = ArrayConstraint
32+
2733class Constrained (ty :: JType) c where
2834 cRep :: Proxy ty -> Proxy c -> CRepr ty
2935
@@ -39,6 +45,9 @@ data Gt nat
3945instance KnownNat nat => Constrained 'JNumber (Gt nat) where
4046 cRep _ _ = Gt $ natVal (Proxy @nat)
4147
48+instance KnownNat nat => Constrained 'JArray (LengthEqNat nat) where
49+ cRep _ _ = LengthArrEq $ natVal (Proxy @nat)
50+
4251-- /Validators
4352
4453data Field field ty schema
@@ -65,6 +74,13 @@ instance
6574instance Verifiable jty '[] where
6675 schema _ _ = []
6776
77+instance
78+ ( Constrained 'JArray c
79+ , Verifiable 'JArray cs )
80+ => Verifiable 'JArray (c ': cs) where
81+ schema _ _ = cRep (Proxy @'JArray) (Proxy @c)
82+ : schema (Proxy @'JArray) (Proxy @cs)
83+
6884instance
6985 ( SchemaConstructor jty
7086 , Verifiable 'JObject fs
@@ -76,11 +92,6 @@ instance
7692 fieldName = symbolVal (Proxy @field)
7793 fieldSchema = constructor (Proxy @jty) $ schema (Proxy @jty) (Proxy @cs)
7894
79−type family CRepr (jty :: JType) :: * where
80− CRepr JText = TextConstraint
81− CRepr JNumber = NumberConstraint
82− CRepr JObject = (String, Schema)
83−
8495data TextConstraint
8596 = LengthEq Integer
8697 | LengthLe Integer
@@ -93,11 +104,15 @@ data NumberConstraint
93104 | Eq Integer
94105 deriving (Show, Eq)
95106
107+data ArrayConstraint
108+ = LengthArrEq Integer
109+ deriving (Show, Eq)
110+
96111data Schema
97112 = SchemaText [TextConstraint]
98113 | SchemaNumber [NumberConstraint]
99114 | SchemaObject [(String, Schema)]
100− | SchemaArray Schema
115+ | SchemaArray [ArrayConstraint] Schema
101116 deriving (Show, Eq)
102117
103118-- | Apply constraint for each element of list
@@ -117,7 +132,7 @@ instance SchemaConstructor 'JNumber where
117132instance SchemaConstructor 'JObject where
118133 constructor _ = SchemaObject
119134
120−class (SchemaConstructor (JT ty)) => Schematic ty where
135+class Schematic ty where
121136 type JT (ty :: k) :: JType
122137 build :: Proxy ty -> Schema
123138
@@ -131,9 +146,13 @@ data SNumber cs
131146
132147instance (Verifiable 'JNumber cs) => Schematic (SNumber cs) where
133148 type JT (SNumber cs) = 'JNumber
134− build _ = constructor (Proxy @(JT (SNumber cs))) $ schema (Proxy @'JNumber) (Proxy @cs)
149+ build _ = constructor (Proxy @(JT (SNumber cs)))
150+ $ schema (Proxy @'JNumber) (Proxy @cs)
135151
136−instance (Verifiable (JT ty) cs, SchemaConstructor (JT ty)) => Schematic (Field field ty cs) where
152+instance
153+ ( Verifiable (JT ty) cs
154+ , SchemaConstructor (JT ty) )
155+ => Schematic (Field field ty cs) where
137156 type JT (Field field ty cs) = JT ty
138157 build _ = constructor (Proxy @(JT (Field field ty cs)))
139158 $ schema (Proxy @(JT (Field field ty cs))) (Proxy @cs)
@@ -146,11 +165,25 @@ instance (Verifiable 'JObject els) => Schematic (SObject els) where
146165 constructor (Proxy @(JT (SObject els)))
147166 $ schema (Proxy @(JT (SObject els))) (Proxy @els)
148167
168+data SArray cs s
169+
170+instance
171+ ( Schematic s
172+ , Verifiable 'JArray cs )
173+ => Schematic (SArray cs s) where
174+ type JT (SArray cs s) = 'JArray
175+ build _ =
176+ SchemaArray
177+ (schema (Proxy @'JArray) (Proxy @cs))
178+ (build (Proxy @s))
179+
149180-- | Shows it's top-level definition according to the json-schema
150181class TopLevel spec
151182
152183instance Schematic (SObject els) => TopLevel (SObject els)
153184
185+instance Schematic (SArray cs s) => TopLevel (SArray cs s)
186+
154187-- | TODO: abstract over objects and arrays
155188-- toSchema
156189-- :: forall els (e :: [k]). (e ~ '[], Verifiable (JT (SObject els)) e, Schematic (SObject els))