@@ -16,6 +16,7 @@ import Data.Functor.Classes
1616import Data.HashMap.Strict as H
1717import Data.Kind
1818import Data.Maybe
19+import Data.Schematic.Utils
1920import Data.Scientific
2021import Data.Singletons.Decide
2122import Data.Singletons.Prelude.List
@@ -40,13 +41,19 @@ data TextConstraint
4041 = TEq Nat
4142 | TLe Nat
4243 | TGt Nat
43− | Regex Symbol
44+ | TRegex Symbol
4445 deriving (Generic)
4546
4647data instance Sing (tc :: TextConstraint) where
47− STextLengthEq :: Sing n -> Sing (TEq n)
48− STextLengthLe :: Sing n -> Sing (TLe n)
49− STextLengthGt :: Sing n -> Sing (TGt n)
48+ STEq :: Sing n -> Sing (TEq n)
49+ STLe :: Sing n -> Sing (TLe n)
50+ STGt :: Sing n -> Sing (TGt n)
51+ STRegex :: Sing s -> Sing (TRegex s)
52+
53+instance Known (Sing n) => Known (Sing (TEq n)) where known = STEq known
54+instance Known (Sing n) => Known (Sing (TGt n)) where known = STGt known
55+instance Known (Sing n) => Known (Sing (TLe n)) where known = STLe known
56+instance Known (Sing s) => Known (Sing (TRegex s)) where known = STRegex known
5057
5158instance Eq (Sing (TEq n)) where a == b = True
5259instance Eq (Sing (TLe n)) where a == b = True
@@ -59,9 +66,13 @@ data NumberConstraint
5966 deriving (Generic)
6067
6168data instance Sing (nc :: NumberConstraint) where
62− SNumberEq :: Sing n -> Sing (NEq n)
63− SNumberGt :: Sing n -> Sing (NGt n)
64− SNumberLe :: Sing n -> Sing (NLe n)
69+ SNEq :: Sing n -> Sing (NEq n)
70+ SNGt :: Sing n -> Sing (NGt n)
71+ SNLe :: Sing n -> Sing (NLe n)
72+
73+instance Known (Sing n) => Known (Sing (NEq n)) where known = SNEq known
74+instance Known (Sing n) => Known (Sing (NGt n)) where known = SNGt known
75+instance Known (Sing n) => Known (Sing (NLe n)) where known = SNLe known
6576
6677instance Eq (Sing (NEq n)) where a == b = True
6778instance Eq (Sing (NLe n)) where a == b = True
@@ -72,7 +83,9 @@ data ArrayConstraint
7283 deriving (Generic)
7384
7485data instance Sing (ac :: ArrayConstraint) where
75− SArrayEq :: Sing n -> Sing (AEq n)
86+ SAEq :: Sing n -> Sing (AEq n)
87+
88+instance Known (Sing n) => Known (Sing (AEq n)) where known = SAEq known
7689
7790instance Eq (Sing (AEq n)) where a == b = True
7891
@@ -91,6 +104,17 @@ data instance Sing (schema :: Schema) where
91104 SSchemaObject :: Sing fields -> Sing (SchemaObject fields)
92105 SSchemaNull :: Sing SchemaNull
93106
107+instance Known (Sing sl) => Known (Sing (SchemaText sl)) where
108+ known = SSchemaText known
109+instance Known (Sing sl) => Known (Sing (SchemaNumber sl)) where
110+ known = SSchemaNumber known
111+instance Known (Sing SchemaNull) where
112+ known = SSchemaNull
113+instance (Known (Sing ac), Known (Sing s)) => Known (Sing (SchemaArray ac s)) where
114+ known = SSchemaArray known known
115+instance Known (Sing stl) => Known (Sing (SchemaObject stl)) where
116+ known = SSchemaObject known
117+
94118instance Eq (Sing (SchemaText cs)) where a == b = True
95119instance Eq (Sing (SchemaNumber cs)) where a == b = True
96120instance Eq (Sing SchemaNull) where a == b = True
@@ -131,14 +155,16 @@ instance Eq (JsonRepr SchemaNull) where
131155instance Eq (JsonRepr s) => Eq (JsonRepr (SchemaArray as s)) where
132156 ReprArray a == ReprArray b = a == b
133157
134−instance (SingI schema) => J.FromJSON (JsonRepr schema) where
135− parseJSON value = case sing :: Sing schema of
158+instance Known (Sing schema) => J.FromJSON (JsonRepr schema) where
159+ parseJSON value = case known :: Sing schema of
136160 SSchemaText _ -> withText "String" (pure . ReprText) value
137161 SSchemaNumber _ -> withScientific "Number" (pure . ReprNumber) value
138162 SSchemaNull -> pure ReprNull
139− SSchemaArray c s -> withArray "Array" f value
140− where
141− f = fmap ReprArray . (withSingI s $ traverse parseJSON)
163+ SSchemaArray c s -> do
164+ let
165+ f :: Sing cs -> Sing s -> V.Vector J.Value -> Parser (JsonRepr (SchemaArray cs s))
166+ f _ _ = fmap ReprArray . traverse parseJSON
167+ withArray "Array" (f c s) value
142168 SSchemaObject fs -> ReprObject <$> withObject "Object" (demoteFields fs) value
143169
144170demoteFields