@@ -9,6 +9,7 @@ import Control.Applicative ((<|>))
99import Control.Monad
1010import Data.Aeson as J
1111import Data.Aeson.Types as J
12+import Data.Coerce
1213import Data.HashMap.Strict as H
1314import Data.Kind
1415import Data.Maybe
@@ -324,79 +325,122 @@ type family USubsets (u :: [k]) :: Constraint where
324325 USubsets '[] = ()
325326 USubsets (h ': tl) = (USubset tl (h ': tl) (V.RImage tl (h ': tl)), USubsets tl)
326327
327−data JsonRepr :: Schema -> Type where
328− ReprText :: Text -> JsonRepr ('SchemaText cs)
329− ReprNumber :: Scientific -> JsonRepr ('SchemaNumber cs)
330− ReprBoolean :: Bool -> JsonRepr 'SchemaBoolean
331− ReprNull :: JsonRepr 'SchemaNull
332− ReprArray :: V.Vector (JsonRepr s) -> JsonRepr ('SchemaArray cs s)
333− ReprObject :: Rec FieldRepr fs -> JsonRepr ('SchemaObject fs)
334− ReprOptional :: Maybe (JsonRepr s) -> JsonRepr ('SchemaOptional s)
335− ReprUnion :: Union JsonRepr (h ': tl) -> JsonRepr ('SchemaUnion (h ': tl))
328+class JsonRepresentable (schema :: Schema) where
329+ type ReprType schema :: *
330+ data JsonRepr schema :: *
331+ wrap :: ReprType schema -> JsonRepr schema
332+
333+instance JsonRepresentable ('SchemaText cs) where
334+ type ReprType ('SchemaText cs) = Text
335+ newtype JsonRepr ('SchemaText cs) = ReprText (ReprType ('SchemaText cs))
336+ wrap = ReprText
337+
338+instance JsonRepresentable ('SchemaNumber cs) where
339+ type ReprType ('SchemaNumber cs) = Scientific
340+ newtype JsonRepr ('SchemaNumber cs) = ReprNumber (ReprType ('SchemaNumber cs))
341+ wrap = ReprNumber
342+
343+instance JsonRepresentable 'SchemaBoolean where
344+ type ReprType 'SchemaBoolean = Bool
345+ newtype JsonRepr 'SchemaBoolean = ReprBoolean (ReprType 'SchemaBoolean)
346+ wrap = ReprBoolean
347+
348+instance JsonRepresentable 'SchemaNull where
349+ type ReprType 'SchemaNull = ()
350+ newtype JsonRepr 'SchemaNull = ReprNull (ReprType 'SchemaNull)
351+ wrap = ReprNull
352+
353+instance JsonRepresentable s => JsonRepresentable ('SchemaArray cs s) where
354+ type ReprType ('SchemaArray cs s) = V.Vector (JsonRepr s)
355+ newtype JsonRepr ('SchemaArray cs s) = ReprArray (ReprType ('SchemaArray cs s))
356+ wrap = ReprArray
357+
358+instance JsonRepresentable ('SchemaObject fs) where
359+ type ReprType ('SchemaObject fs) = Rec FieldRepr fs
360+ newtype JsonRepr ('SchemaObject fs) = ReprObject (ReprType ('SchemaObject fs))
361+ wrap = ReprObject
362+
363+instance JsonRepresentable s => JsonRepresentable ('SchemaOptional s) where
364+ type ReprType ('SchemaOptional s) = Maybe (JsonRepr s)
365+ newtype JsonRepr ('SchemaOptional s) = ReprOptional (ReprType ('SchemaOptional s))
366+ wrap = ReprOptional
367+
368+instance JsonRepresentable ('SchemaUnion (h ': tl)) where
369+ type ReprType ('SchemaUnion (h ': tl)) = Union JsonRepr (h ': tl)
370+ newtype JsonRepr ('SchemaUnion (h ': tl)) = ReprUnion (ReprType ('SchemaUnion (h ': tl)))
371+ wrap = ReprUnion
372+
373+-- data JsonRepr :: Schema -> Type where
374+-- ReprText :: Text -> JsonRepr ('SchemaText cs)
375+-- ReprNumber :: Scientific -> JsonRepr ('SchemaNumber cs)
376+-- ReprBoolean :: Bool -> JsonRepr 'SchemaBoolean
377+-- ReprNull :: JsonRepr 'SchemaNull
378+-- ReprArray :: V.Vector (JsonRepr s) -> JsonRepr ('SchemaArray cs s)
379+-- ReprObject :: Rec FieldRepr fs -> JsonRepr ('SchemaObject fs)
380+-- ReprOptional :: Maybe (JsonRepr s) -> JsonRepr ('SchemaOptional s)
381+-- ReprUnion :: Union JsonRepr (h ': tl) -> JsonRepr ('SchemaUnion (h ': tl))
336382
337383-- | Move to the union package
338−instance Show (JsonRepr ('SchemaText cs)) where
339− show (ReprText t) = "ReprText " P.++ show t
384+-- instance Show (JsonRepr ('SchemaText cs)) where
385+-- show (ReprText t) = "ReprText " P.++ show t
340386
341−instance Show (JsonRepr ('SchemaNumber cs)) where
342− show (ReprNumber n) = "ReprNumber " P.++ show n
387+-- instance Show (JsonRepr ('SchemaNumber cs)) where
388+-- show (ReprNumber n) = "ReprNumber " P.++ show n
343389
344−instance Show (JsonRepr 'SchemaNull) where show _ = "ReprNull"
390+-- instance Show (JsonRepr 'SchemaNull) where show _ = "ReprNull"
345391
346−instance Show (JsonRepr s) => Show (JsonRepr ('SchemaArray acs s)) where
347− show (ReprArray v) = "ReprArray " P.++ show v
392+-- instance Show (JsonRepr s) => Show (JsonRepr ('SchemaArray acs s)) where
393+-- show (ReprArray v) = "ReprArray " P.++ show v
348394
349−instance V.RecAll FieldRepr fs Show => Show (JsonRepr ('SchemaObject fs)) where
350− show (ReprObject fs) = "ReprObject " P.++ show fs
395+-- instance V.RecAll FieldRepr fs Show => Show (JsonRepr ('SchemaObject fs)) where
396+-- show (ReprObject fs) = "ReprObject " P.++ show fs
351397
352−instance Show (JsonRepr s) => Show (JsonRepr ('SchemaOptional s)) where
353− show (ReprOptional s) = "ReprOptional " P.++ show s
398+-- instance Show (JsonRepr s) => Show (JsonRepr ('SchemaOptional s)) where
399+-- show (ReprOptional s) = "ReprOptional " P.++ show s
354400
355−instance (Monad m, Serial m Text)
356− => Serial m (JsonRepr ('SchemaText cs)) where
357− series = cons1 ReprText
401+-- instance (Monad m, Serial m Text)
402+-- => Serial m (JsonRepr ('SchemaText cs)) where
403+-- series = cons1 ReprText
358404
359−instance (Monad m, Serial m Scientific)
360− => Serial m (JsonRepr ('SchemaNumber cs)) where
361− series = cons1 ReprNumber
405+-- instance (Monad m, Serial m Scientific)
406+-- => Serial m (JsonRepr ('SchemaNumber cs)) where
407+-- series = cons1 ReprNumber
362408
363−instance Monad m => Serial m (JsonRepr 'SchemaNull) where
364− series = cons0 ReprNull
409+-- instance Monad m => Serial m (JsonRepr 'SchemaNull) where
410+-- series = cons0 ReprNull
365411
366−instance (Serial m (V.Vector (JsonRepr s)))
367− => Serial m (JsonRepr ('SchemaArray cs s)) where
368− series = cons1 ReprArray
412+-- instance (Serial m (V.Vector (JsonRepr s)))
413+-- => Serial m (JsonRepr ('SchemaArray cs s)) where
414+-- series = cons1 ReprArray
369415
370−instance (Serial m (JsonRepr s))
371− => Serial m (JsonRepr ('SchemaOptional s)) where
372− series = cons1 ReprOptional
416+-- instance (Serial m (JsonRepr s))
417+-- => Serial m (JsonRepr ('SchemaOptional s)) where
418+-- series = cons1 ReprOptional
373419
374−instance (Monad m, Serial m (Rec FieldRepr fs))
375− => Serial m (JsonRepr ('SchemaObject fs)) where
376− series = cons1 ReprObject
420+-- instance (Monad m, Serial m (Rec FieldRepr fs))
421+-- => Serial m (JsonRepr ('SchemaObject fs)) where
422+-- series = cons1 ReprObject
377423
378−instance Eq (Rec FieldRepr fs) => Eq (JsonRepr ('SchemaObject fs)) where
379− ReprObject a == ReprObject b = a == b
424+-- instance Eq (Rec FieldRepr fs) => Eq (JsonRepr ('SchemaObject fs)) where
425+-- ReprObject a == ReprObject b = a == b
380426
381−instance Eq (JsonRepr ('SchemaText cs)) where
382− ReprText a == ReprText b = a == b
427+-- instance Eq (JsonRepr ('SchemaText cs))
383428
384−instance Eq (JsonRepr ('SchemaNumber cs)) where
385− ReprNumber a == ReprNumber b = a == b
429+-- instance Eq (JsonRepr ('SchemaNumber cs))
386430
387−instance Eq (JsonRepr 'SchemaNull) where
388− ReprNull == ReprNull = True
431+-- instance Eq (JsonRepr 'SchemaNull) where
432+-- ReprNull == ReprNull = True
389433
390−instance Eq (JsonRepr s) => Eq (JsonRepr ('SchemaArray as s)) where
391− ReprArray a == ReprArray b = a == b
434+-- instance Eq (JsonRepr s) => Eq (JsonRepr ('SchemaArray as s)) where
435+-- ReprArray a == ReprArray b = a == b
392436
393−instance Eq (JsonRepr s) => Eq (JsonRepr ('SchemaOptional s)) where
394− ReprOptional a == ReprOptional b = a == b
437+-- instance Eq (JsonRepr s) => Eq (JsonRepr ('SchemaOptional s)) where
438+-- ReprOptional a == ReprOptional b = a == b
395439
396440instance IsList (JsonRepr ('SchemaArray cs s)) where
397441 type Item (JsonRepr ('SchemaArray cs s)) = JsonRepr s
398− fromList = ReprArray . GHC.Exts.fromList
399− toList (ReprArray v) = GHC.Exts.toList v
442+ fromList = GHC.Exts.fromList
443+ toList v = GHC.Exts.toList v
400444
401445instance Num (JsonRepr ('SchemaNumber cs)) where
402446 ReprNumber a + ReprNumber b = ReprNumber $ a + b
@@ -407,7 +451,7 @@ instance Num (JsonRepr ('SchemaNumber cs)) where
407451 fromInteger = ReprNumber . fromIntegral
408452
409453instance IsString (JsonRepr ('SchemaText cs)) where
410− fromString = ReprText . fromString
454+ fromString = fromString
411455
412456fromOptional
413457 :: SingI s
@@ -440,7 +484,7 @@ instance SingI schema => J.FromJSON (JsonRepr schema) where
440484 SSchemaNumber _ -> withScientific "Number" (pure . ReprNumber) value
441485 SSchemaBoolean -> ReprBoolean <$> parseJSON value
442486 SSchemaNull -> case value of
443− J.Null -> pure ReprNull
487+ J.Null -> pure (wrap ())
444488 _ -> typeMismatch "Null" value
445489 so@(SSchemaOptional s) -> withSingI s $ ReprOptional <$> fromOptional so value
446490 SSchemaArray sa sb -> withSingI sa $ withSingI sb
@@ -478,8 +522,8 @@ instance SingI schema => J.FromJSON (JsonRepr schema) where
478522 ReprObject <$> withObject "Object" (demoteFields fs) value
479523 SSchemaUnion ss -> parseUnion ss value
480524
481−instance J.ToJSON (JsonRepr a) where
482− toJSON ReprNull = J.Null
525+instance J.ToJSON (JsonRepr schema) where
526+ toJSON (ReprNull _) = J.Null
483527 toJSON (ReprBoolean b) = J.Bool b
484528 toJSON (ReprText t) = J.String t
485529 toJSON (ReprNumber n) = J.Number n