@@ -8,28 +8,11 @@ module Data.Schematic.Schema where
88
99import Data.Kind hiding (Type)
1010import Data.Proxy
11+import Data.Schematic.Validation
1112import Data.Text (Text)
1213import GHC.TypeLits (KnownNat, natVal, KnownSymbol, symbolVal, Symbol, Nat)
1314
1415
15−-- | Type Tags
16−data JType
17− = JText
18− | JNumber
19− | JArray
20− | JObject
21− | JNull
22−
23−type family Repr (ty :: JType) :: * where
24− Repr 'JText = String -- because of matchRegex
25− Repr 'JNumber = Double
26−
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−
3316class Constrained (ty :: JType) c where
3417 cRep :: Proxy ty -> Proxy c -> CRepr ty
3518
@@ -92,45 +75,17 @@ instance
9275 fieldName = symbolVal (Proxy @field)
9376 fieldSchema = constructor (Proxy @jty) $ schema (Proxy @jty) (Proxy @cs)
9477
95−data TextConstraint
96− = LengthEq Integer
97− | LengthLe Integer
98− | LengthGt Integer
99− deriving (Show, Eq)
100−
101−data NumberConstraint
102− = Le Integer
103− | Gt Integer
104− | Eq Integer
105− deriving (Show, Eq)
106−
107−data ArrayConstraint
108− = LengthArrEq Integer
109− deriving (Show, Eq)
110−
111−data Schema
112− = SchemaText [TextConstraint]
113− | SchemaNumber [NumberConstraint]
114− | SchemaObject [(String, Schema)]
115− | SchemaArray [ArrayConstraint] Schema
116− deriving (Show, Eq)
117−
118−-- | Apply constraint for each element of list
119−-- type family AllSatisfy (c :: k -> Constraint) (s :: [k]) :: Constraint where
120−-- AllSatisfy c '[] = ()
121−-- AllSatisfy c (a ': as) = (c a, AllSatisfy c as)
122−
12378class SchemaConstructor jty where
12479 constructor :: Proxy jty -> [CRepr jty] -> Schema
12580
12681instance SchemaConstructor 'JText where
127− constructor _ = SchemaText
82+ constructor _ = SchemaText SJText
12883
12984instance SchemaConstructor 'JNumber where
130− constructor _ = SchemaNumber
85+ constructor _ = SchemaNumber SJNumber
13186
13287instance SchemaConstructor 'JObject where
133− constructor _ = SchemaObject
88+ constructor _ = SchemaObject SJObject
13489
13590class Schematic ty where
13691 type JT (ty :: k) :: JType
@@ -174,6 +129,7 @@ instance
174129 type JT (SArray cs s) = 'JArray
175130 build _ =
176131 SchemaArray
132+ SJArray
177133 (schema (Proxy @'JArray) (Proxy @cs))
178134 (build (Proxy @s))
179135