git.iko.soy/schematic
on master help sign in
ParseResult instance for servant integrations
f7a735dDenis Redozubov
src/Data/Schematic.hs−23
compare with master
unifiedsplit
@@ -39,29 +39,6 @@ import Data.Tagged
39import Data.Text as T
39import Data.Text as T
40
40
41
41
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−
65parseAndValidateTopVersionJson
42parseAndValidateTopVersionJson
66 :: forall proxy (v :: Versioned)
43 :: forall proxy (v :: Versioned)
67 . (SingI (TopVersion (AllVersions v)))
44 . (SingI (TopVersion (AllVersions v)))
src/Data/Schematic/Validation.hs+29
@@ -2,6 +2,8 @@ module Data.Schematic.Validation where
2
2
3import Control.Monad
3import Control.Monad
4import Control.Monad.Validation
4import Control.Monad.Validation
5+import Data.Aeson
6+import Data.Aeson.Types
5import Data.Foldable
7import Data.Foldable
6import Data.Functor.Identity
8import Data.Functor.Identity
7import Data.Monoid
9import Data.Monoid
@@ -30,6 +32,10 @@ data ParseResult a
30 | ValidationError ErrorMap -- runtime
32 | ValidationError ErrorMap -- runtime
31 deriving (Show, Eq, Functor, Foldable, Traversable)
33 deriving (Show, Eq, Functor, Foldable, Traversable)
32
34
35+instance (TopLevel a, SingI a, FromJSON (JsonRepr a))
36+ => FromJSON (ParseResult (JsonRepr a)) where
37+ parseJSON = pure . parseAndValidateJson @a
38+
33isValid :: ParseResult a -> Bool
39isValid :: ParseResult a -> Bool
34isValid (Valid _) = True
40isValid (Valid _) = True
35isValid _ = False
41isValid _ = False
@@ -246,3 +252,26 @@ toUnion _ = ReprUnion . urelax
246
252
247umatch' :: UElem a as i => Sing a -> Union f as -> Maybe (f a)
253umatch' :: UElem a as i => Sing a -> Union f as -> Maybe (f a)
248umatch' _ u = umatch u
254umatch' _ 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