git.iko.soy/schematic
on master help sign in
ParseResult instance for servant integrations
commitf7a735dc704851bd2eee69147a506ca743b01276 authorDenis Redozubov <denis.redozubov@gmail.com> dateFri 24 Aug 2018, 17:07 (8 years ago) parente24b45c
2 files changed+29−23
compare with master
unifiedsplit
src/Data/Schematic.hs−23 src/Data/Schematic/Validation.hs+29
src/Data/Schematic.hs−23
@@ -39,29 +39,6 @@ import Data.Tagged
3939import Data.Text as T
4040
4141
42−parseAndValidateJson
43− :: forall schema
44− . (J.FromJSON (JsonRepr schema), TopLevel schema, SingI schema)
45− => J.Value
46− -> ParseResult (JsonRepr schema)
47−parseAndValidateJson v =
48− case parseEither parseJSON v of
49− Left s -> DecodingError $ T.pack s
50− Right jsonRepr ->
51− let
52− validate = validateJsonRepr (sing :: Sing schema) [] jsonRepr
53− res = runIdentity . runValidationTEither $ validate
54− in case res of
55− Left em -> ValidationError em
56− Right () -> Valid jsonRepr
57−
58−parseAndValidateJsonBy
59− :: (J.FromJSON (JsonRepr schema), TopLevel schema, SingI schema)
60− => proxy schema
61− -> J.Value
62− -> ParseResult (JsonRepr schema)
63−parseAndValidateJsonBy _ = parseAndValidateJson
64−
6542parseAndValidateTopVersionJson
6643 :: forall proxy (v :: Versioned)
6744 . (SingI (TopVersion (AllVersions v)))
src/Data/Schematic/Validation.hs+29
@@ -2,6 +2,8 @@ module Data.Schematic.Validation where
22
33import Control.Monad
44import Control.Monad.Validation
5+import Data.Aeson
6+import Data.Aeson.Types
57import Data.Foldable
68import Data.Functor.Identity
79import Data.Monoid
@@ -30,6 +32,10 @@ data ParseResult a
3032 | ValidationError ErrorMap -- runtime
3133 deriving (Show, Eq, Functor, Foldable, Traversable)
3234
35+instance (TopLevel a, SingI a, FromJSON (JsonRepr a))
36+ => FromJSON (ParseResult (JsonRepr a)) where
37+ parseJSON = pure . parseAndValidateJson @a
38+
3339isValid :: ParseResult a -> Bool
3440isValid (Valid _) = True
3541isValid _ = False
@@ -246,3 +252,26 @@ toUnion _ = ReprUnion . urelax
246252
247253umatch' :: UElem a as i => Sing a -> Union f as -> Maybe (f a)
248254umatch' _ u = umatch u
255+
256+parseAndValidateJson
257+ :: forall schema
258+ . (FromJSON (JsonRepr schema), TopLevel schema, SingI schema)
259+ => Value
260+ -> ParseResult (JsonRepr schema)
261+parseAndValidateJson v =
262+ case parseEither parseJSON v of
263+ Left s -> DecodingError $ T.pack s
264+ Right jsonRepr ->
265+ let
266+ validate = validateJsonRepr (sing :: Sing schema) [] jsonRepr
267+ res = runIdentity . runValidationTEither $ validate
268+ in case res of
269+ Left em -> ValidationError em
270+ Right () -> Valid jsonRepr
271+
272+parseAndValidateJsonBy
273+ :: (FromJSON (JsonRepr schema), TopLevel schema, SingI schema)
274+ => proxy schema
275+ -> Value
276+ -> ParseResult (JsonRepr schema)
277+parseAndValidateJsonBy _ = parseAndValidateJson