80bbc37 · typeable/schematic

git.iko.soy/typeable/schematic

bytestring combinators

commit80bbc37e0811a0a6f6318a3475fe2896fdcaf75a authorDenis Redozubov <denis.redozubov@gmail.com> dateWed 24 May 2017, 10:33 (9 years ago) parent83ff5c8

4 files changed+47−10

compare with master

unifiedsplit

schematic.cabal+3−1 src/Data/Schematic.hs+15 src/Data/Schematic/Validation.hs+12 test/SchemaSpec.hs+17−9

schematic.cabal+3−1

@@ -2,7 +2,7 @@

22-- documentation, see http://haskell.org/cabal/users-guide/

44name: schematic

5−version: 0.1.0.0

5+version: 0.1.0.1

66synopsis: JSON-biased spec and validation tool

77-- description:

88license: BSD3

@@ -56,6 +56,7 @@ library

5656 , TypeSynonymInstances

5757 , UndecidableInstances

5858 build-depends: base >=4.9 && <4.10

59+ , bytestring

5960 , aeson >= 1

6061 , regex-compat

6162 , scientific

@@ -104,6 +105,7 @@ test-suite spec

104105 build-depends: HUnit

105106 , aeson >= 1

106107 , base >=4.9 && <4.10

108+ , bytestring

107109 , hspec >= 2.2.0

108110 , hspec-core

109111 , hspec-discover

src/Data/Schematic.hs+15

@@ -1,12 +1,18 @@

11module Data.Schematic

22 ( module Data.Schematic.Schema

33 , module Data.Schematic.Utils

4+ , decodeAndValidateJson

45 , parseAndValidateJson

6+ , isValid

7+ , isDecodingError

8+ , isValidationError

9+ , ParseResult(..)

510 ) where

611

712import Control.Monad.Validation

813import Data.Aeson as J

914import Data.Aeson.Types as J

15+import Data.ByteString.Lazy as BL

1016import Data.Functor.Identity

1117import Data.Schematic.Schema

1218import Data.Schematic.Utils

@@ -29,3 +35,12 @@ parseAndValidateJson v =

2935 in case res of

3036 Left em -> ValidationError em

3137 Right () -> Valid jsonRepr

38+

39+decodeAndValidateJson

40+ :: forall schema

41+ . (J.FromJSON (JsonRepr schema), TopLevel schema, Known (Sing schema))

42+ => BL.ByteString

43+ -> ParseResult (JsonRepr schema)

44+decodeAndValidateJson bs = case decode bs of

45+ Nothing -> DecodingError "invalid json"

46+ Just x -> parseAndValidateJson x

src/Data/Schematic/Validation.hs+12

@@ -28,6 +28,18 @@ data ParseResult a

2828 | ValidationError ErrorMap

2929 deriving (Show, Eq, Functor)

3030

31+isValid :: ParseResult a -> Bool

32+isValid (Valid _) = True

33+isValid _ = False

34+

35+isDecodingError :: ParseResult a -> Bool

36+isDecodingError (DecodingError _) = True

37+isDecodingError _ = False

38+

39+isValidationError :: ParseResult a -> Bool

40+isValidationError (ValidationError _) = True

41+isValidationError _ = False

42+

3143validateTextConstraint

3244 :: JSONPath

3345 -> Text

test/SchemaSpec.hs+17−9

@@ -1,6 +1,7 @@

11module SchemaSpec (spec, main) where

33import Control.Monad

4+import Data.ByteString.Lazy

45import Data.Aeson

56import Data.Proxy

67import Data.Schematic

@@ -15,7 +16,7 @@ import Test.SmallCheck.Series.Instances

1516type SchemaExample

1617 = SchemaObject

1718 '[ '("foo", SchemaArray '[AEq 1] (SchemaNumber '[NGt 10]))

18− , '("bar", SchemaOptional (SchemaText '[TRegex "\\w+"]))]

19+ , '("bar", SchemaOptional (SchemaText '[TRegex "\\w+", TEnum '["foo", "bar"]]))]

1920

2021exampleTest :: JsonRepr (SchemaOptional (SchemaText '[TEq 3]))

2122exampleTest = ReprOptional (Just (ReprText "lil"))

@@ -26,19 +27,17 @@ exampleNumber = ReprNumber 12

2627exampleArray :: JsonRepr (SchemaArray '[AEq 1] (SchemaNumber '[NGt 10]))

2728exampleArray = ReprArray [exampleNumber]

2829

29−exampleObject :: JsonRepr SchemaExample

30−exampleObject = ReprObject $ FieldRepr exampleArray

31− :& FieldRepr (ReprOptional (Just (ReprText "barval")))

32− :& RNil

33−

3430jsonExample :: JsonRepr SchemaExample

3531jsonExample = ReprObject $

3632 FieldRepr (ReprArray [ReprNumber 12])

37− :& FieldRepr (ReprOptional (Just (ReprText "tes")))

33+ :& FieldRepr (ReprOptional (Just (ReprText "bar")))

3834 :& RNil

3935

40−-- schemaExample :: Sing SchemaExample

41−-- schemaExample = known

36+schemaJson :: ByteString

37+schemaJson = "{\"foo\": [13], \"bar\": null}"

38+

39+schemaJson2 :: ByteString

40+schemaJson2 = "{\"foo\": [3], \"bar\": null}"

4241

4342spec :: Spec

4443spec = do

@@ -46,6 +45,15 @@ spec = do

4645 -- read (show example) == example

4746 it "decode/encode JsonRepr properly" $

4847 decode (encode jsonExample) == Just jsonExample

48+ it "validates correct representation" $

49+ ((decodeAndValidateJson schemaJson) :: ParseResult (JsonRepr SchemaExample))

50+ `shouldSatisfy` isValid

51+ it "returns decoding error on structurally incorrect input" $

52+ ((decodeAndValidateJson "{}") :: ParseResult (JsonRepr SchemaExample))

53+ `shouldSatisfy` isDecodingError

54+ it "validates incorrect representation" $

55+ ((decodeAndValidateJson schemaJson2) :: ParseResult (JsonRepr SchemaExample))

56+ `shouldSatisfy` isValidationError

4957

5058main :: IO ()

5159main = hspec spec