@@ -7,10 +7,12 @@ module Data.Schematic
77 , decodeAndValidateJson
88 , parseAndValidateJson
99 , parseAndValidateVersionedJson
10+ , parseAndValidateTopVersionJson
1011 , isValid
1112 , isDecodingError
1213 , isValidationError
1314 , ParseResult(..)
15+ , Migratable
1416 ) where
1517
1618import Control.Monad.Validation
@@ -42,27 +44,6 @@ parseAndValidateJson v =
4244 Left em -> ValidationError em
4345 Right () -> Valid jsonRepr
4446
45−parseAndValidateJsonBySing
46− :: forall schema proxy
47− . (J.FromJSON (JsonRepr schema), TopLevel schema)
48− => Sing schema
49− -> J.Value
50− -> ParseResult (JsonRepr schema)
51−parseAndValidateJsonBySing sschema v = case parseEither parseJSON v of
52− Left s -> DecodingError $ T.pack s
53− Right jsonRepr ->
54− let
55− validate = validateJsonRepr sschema [] jsonRepr
56− res = runIdentity . runValidationTEither $ validate
57− in case res of
58− Left em -> ValidationError em
59− Right () -> Valid jsonRepr
60−
61−-- parseAndValidateVersionedJson
62−-- :: MList (m ': ms)
63−-- -> J.Value
64−-- -> ParseResult (JsonRepr)
65−
6647parseAndValidateTopVersionJson
6748 :: forall proxy (v :: Versioned)
6849 . (SingI (TopVersion (AllVersions v)))
@@ -81,32 +62,30 @@ parseAndValidateTopVersionJson _ v =
8162 Left em -> ValidationError em
8263 Right () -> Valid jsonRepr
8364
84−-- [("top version", schemaTopVersion), ("n-1 version", schemaNminusOneVersion), ...]
85−
86−-- type family Migratable (rs :: [(Revision, Schema)]) :: Constraint where
87−-- -- constraint duplication
88−-- Migratable ('(r,s) ': '(r', s') ': tl) =
89−-- (SingI s, MigrateSchema s s', TopLevel s, Migratable ('(r',s') ': tl))
90−-- Migratable ('(r,s) ': '[]) = (TopLevel s, SingI s)
91−-- -- Migratable '[] = ('True ~ 'False)
92−
9365class Migratable (revisions :: [(Revision, Schema)]) where
94− mparse :: Sing revisions -> J.Value -> Either String (JsonRepr (Snd (Head revisions)))
66+ mparse
67+ :: Sing revisions
68+ -> J.Value
69+ -> ParseResult (JsonRepr (Snd (Head revisions)))
9570
96−instance {-# OVERLAPPING #-} (Migratable (Tail revisions), MigrateSchema (Snd (Head (Tail revisions))) (Snd (Head revisions)), SingI (Snd (Head revisions))) => Migratable revisions where
71+instance {-# OVERLAPPING #-}
72+ ( Migratable (Tail revisions)
73+ , MigrateSchema (Snd (Head (Tail revisions))) (Snd (Head revisions))
74+ , SingI (Snd (Head revisions)))
75+ => Migratable revisions where
9776 mparse s v = case parseEither parseJSON v of
9877 Left _ -> migrate <$> mparse (sTail s) v
99− Right x -> Right x
78+ Right x -> Valid x
10079
10180instance {-# OVERLAPPABLE #-} (TopLevel (Snd rev), SingI (Snd rev)) => Migratable '[rev] where
102− mparse _ = parseEither parseJSON
81+ mparse _ = parseAndValidateJson
10382
10483parseAndValidateVersionedJson
10584 :: forall proxy v. (SingI (AllVersions v), Migratable (AllVersions v))
10685 => proxy v
10786 -> J.Value
108− -> Either String (JsonRepr (Snd (Head (AllVersions v))))
109−parseAndValidateVersionedJson s v = mparse (sing :: Sing (AllVersions v)) v
87+ -> ParseResult (JsonRepr (Snd (Head (AllVersions v))))
88+parseAndValidateVersionedJson _ v = mparse (sing :: Sing (AllVersions v)) v
11089
11190decodeAndValidateJson
11291 :: forall schema