git.iko.soy/schematic
on master help sign in
bytestring combinators
80bbc37Denis Redozubov
schematic.cabal+3−1
compare with master
unifiedsplit
@@ -2,7 +2,7 @@
2-- documentation, see http://haskell.org/cabal/users-guide/
2-- documentation, see http://haskell.org/cabal/users-guide/
3
3
4name: schematic
4name: schematic
5−version: 0.1.0.0
5+version: 0.1.0.1
6synopsis: JSON-biased spec and validation tool
6synopsis: JSON-biased spec and validation tool
7-- description:
7-- description:
8license: BSD3
8license: BSD3
@@ -56,6 +56,7 @@ library
56 , TypeSynonymInstances
56 , TypeSynonymInstances
57 , UndecidableInstances
57 , UndecidableInstances
58 build-depends: base >=4.9 && <4.10
58 build-depends: base >=4.9 && <4.10
59+ , bytestring
59 , aeson >= 1
60 , aeson >= 1
60 , regex-compat
61 , regex-compat
61 , scientific
62 , scientific
@@ -104,6 +105,7 @@ test-suite spec
104 build-depends: HUnit
105 build-depends: HUnit
105 , aeson >= 1
106 , aeson >= 1
106 , base >=4.9 && <4.10
107 , base >=4.9 && <4.10
108+ , bytestring
107 , hspec >= 2.2.0
109 , hspec >= 2.2.0
108 , hspec-core
110 , hspec-core
109 , hspec-discover
111 , hspec-discover
src/Data/Schematic.hs+15
@@ -1,12 +1,18 @@
1module Data.Schematic
1module Data.Schematic
2 ( module Data.Schematic.Schema
2 ( module Data.Schematic.Schema
3 , module Data.Schematic.Utils
3 , module Data.Schematic.Utils
4+ , decodeAndValidateJson
4 , parseAndValidateJson
5 , parseAndValidateJson
6+ , isValid
7+ , isDecodingError
8+ , isValidationError
9+ , ParseResult(..)
5 ) where
10 ) where
6
11
7import Control.Monad.Validation
12import Control.Monad.Validation
8import Data.Aeson as J
13import Data.Aeson as J
9import Data.Aeson.Types as J
14import Data.Aeson.Types as J
15+import Data.ByteString.Lazy as BL
10import Data.Functor.Identity
16import Data.Functor.Identity
11import Data.Schematic.Schema
17import Data.Schematic.Schema
12import Data.Schematic.Utils
18import Data.Schematic.Utils
@@ -29,3 +35,12 @@ parseAndValidateJson v =
29 in case res of
35 in case res of
30 Left em -> ValidationError em
36 Left em -> ValidationError em
31 Right () -> Valid jsonRepr
37 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
28 | ValidationError ErrorMap
28 | ValidationError ErrorMap
29 deriving (Show, Eq, Functor)
29 deriving (Show, Eq, Functor)
30
30
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+
31validateTextConstraint
43validateTextConstraint
32 :: JSONPath
44 :: JSONPath
33 -> Text
45 -> Text
test/SchemaSpec.hs+17−9
@@ -1,6 +1,7 @@
1module SchemaSpec (spec, main) where
1module SchemaSpec (spec, main) where
2
2
3import Control.Monad
3import Control.Monad
4+import Data.ByteString.Lazy
4import Data.Aeson
5import Data.Aeson
5import Data.Proxy
6import Data.Proxy
6import Data.Schematic
7import Data.Schematic
@@ -15,7 +16,7 @@ import Test.SmallCheck.Series.Instances
15type SchemaExample
16type SchemaExample
16 = SchemaObject
17 = SchemaObject
17 '[ '("foo", SchemaArray '[AEq 1] (SchemaNumber '[NGt 10]))
18 '[ '("foo", SchemaArray '[AEq 1] (SchemaNumber '[NGt 10]))
18− , '("bar", SchemaOptional (SchemaText '[TRegex "\\w+"]))]
19+ , '("bar", SchemaOptional (SchemaText '[TRegex "\\w+", TEnum '["foo", "bar"]]))]
19
20
20exampleTest :: JsonRepr (SchemaOptional (SchemaText '[TEq 3]))
21exampleTest :: JsonRepr (SchemaOptional (SchemaText '[TEq 3]))
21exampleTest = ReprOptional (Just (ReprText "lil"))
22exampleTest = ReprOptional (Just (ReprText "lil"))
@@ -26,19 +27,17 @@ exampleNumber = ReprNumber 12
26exampleArray :: JsonRepr (SchemaArray '[AEq 1] (SchemaNumber '[NGt 10]))
27exampleArray :: JsonRepr (SchemaArray '[AEq 1] (SchemaNumber '[NGt 10]))
27exampleArray = ReprArray [exampleNumber]
28exampleArray = ReprArray [exampleNumber]
28
29
29−exampleObject :: JsonRepr SchemaExample
30−exampleObject = ReprObject $ FieldRepr exampleArray
31− :& FieldRepr (ReprOptional (Just (ReprText "barval")))
32− :& RNil
33−
34jsonExample :: JsonRepr SchemaExample
30jsonExample :: JsonRepr SchemaExample
35jsonExample = ReprObject $
31jsonExample = ReprObject $
36 FieldRepr (ReprArray [ReprNumber 12])
32 FieldRepr (ReprArray [ReprNumber 12])
37− :& FieldRepr (ReprOptional (Just (ReprText "tes")))
33+ :& FieldRepr (ReprOptional (Just (ReprText "bar")))
38 :& RNil
34 :& RNil
39
35
40−-- schemaExample :: Sing SchemaExample
36+schemaJson :: ByteString
41−-- schemaExample = known
37+schemaJson = "{\"foo\": [13], \"bar\": null}"
38+
39+schemaJson2 :: ByteString
40+schemaJson2 = "{\"foo\": [3], \"bar\": null}"
42
41
43spec :: Spec
42spec :: Spec
44spec = do
43spec = do
@@ -46,6 +45,15 @@ spec = do
46 -- read (show example) == example
45 -- read (show example) == example
47 it "decode/encode JsonRepr properly" $
46 it "decode/encode JsonRepr properly" $
48 decode (encode jsonExample) == Just jsonExample
47 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
49
57
50main :: IO ()
58main :: IO ()
51main = hspec spec
59main = hspec spec