221ff1e · typeable/hjsonschema

git.iko.soy/typeable/hjsonschema

Improve examples and docs.

commit221ff1e887f9c62bcda03fa6394b1907af4c1e30 authorIan Grant Jeffries <ian@housejeffries.com> dateMon 9 May 2016, 14:24 (10 years ago) parent5f9e758

10 files changed+110−81

compare with master

unifiedsplit

README.md+1−1 examples/CustomSchema.hs+9−6 examples/Full.hs+34 examples/PrettyShowFailure.hs+8−13 examples/Simple.hs+39 examples/Standard.hs−49 examples/json/unique.json+3 hjsonschema.cabal+3−2 src/Data/JsonSchema/Draft4.hs+4−3 test/Local.hs+9−7

README.md+1−1

@@ -8,7 +8,7 @@ NOTE: You CANNOT use untrusted JSON data to make schemas. Schemas with circular

99# Example

1010

11−See [here](https://github.com/seagreen/hjsonschema/blob/master/examples/Standard.hs).

11+See [here](https://github.com/seagreen/hjsonschema/blob/master/examples/Simple.hs).

1212

1313# Tests

1414

examples/CustomSchema.hs+9−6

@@ -1,11 +1,14 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−

3−-- | A custom schema made up of one validator from 'Data.Validator.Draft4'

4−-- and one original validator.

1+-- | A custom schema specification using one validator from

2+-- 'Data.Validator.Draft4' and one original validator.

53--

64-- This is a simple example because it doesn't allow references (so it

75-- doesn't need to define an 'embed' function @Schema -> [Schema]@ for use

86-- with 'fetchReferencedSchemas'.

7+--

8+-- For a full example see 'Data.JsonSchema.Draft4' and its submodules.

9+-- Code use between schema specifications will likely be OK but not great.

10+-- All the 'Data.Validator' code as well as the 'Data.JsonSchema.Fetch' code

11+-- is reusable, but there's a lot of boilerplate to tie it together.

912

1013module CustomSchema where

1114

@@ -36,8 +39,8 @@ data Schema = Schema

3639 , _schemaOddLength :: Maybe Bool

3740 }

3841

39−-- | Since every 'Schema' is valid we don't need to bother defining something

40−-- like 'Data.JsonSchema.Draft4.checkValidity' for this schema.

42+-- | If our 'Schema's themselves could be invalid we might want to write

43+-- something like 'Data.JsonSchema.Draft4.schemaValidityy' for them.

4144validate :: Schema -> Value -> [FR.Failure CustomError]

4245validate s (String x) = concat

4346 [ f _schemaMaxLength (FR.setFailure MaxLength) (fmap maybeToList . VA.maxLength)

examples/Full.hsnew file+34

@@ -0,0 +1,34 @@

1+-- | Step by step validation using 'D4.referencesViaFilesystem' and

2+-- 'D4.checkSchema'. This means the actual validation invovles no IO.

4+module Full where

6+import Data.Aeson

8+import qualified Data.JsonSchema.Draft4 as D4

10+schema :: D4.Schema

11+schema = D4.emptySchema { D4._schemaRef = Just "./unique.json" }

12+

13+schemaContext :: D4.SchemaWithURI D4.Schema

14+schemaContext = D4.SchemaWithURI

15+ { D4._swSchema = schema

16+ , D4._swURI = Just "./examples/json/imaginary.json"

17+ }

18+

19+badData :: Value

20+badData = toJSON (["foo", "foo"] :: [String])

21+

22+example :: IO ()

23+example = do

24+ res <- D4.referencesViaFilesystem schemaContext

25+ case res of

26+ Left _ -> error "Couldn't fetch referenced schemas."

27+ Right references -> do

28+ let validate = case D4.checkSchema references schemaContext of

29+ Left _ -> error "Not a valid schema."

30+ Right f -> f

31+ case validate badData of

32+ [] -> error "We validated bad data."

33+ [D4.Invalid (D4.Ref D4.UniqueItems) _ _] -> return () -- Success.

34+ e -> error "We got a different failure than expected."

examples/PrettyShowFailure.hs+8−13

@@ -1,4 +1,11 @@

1−{-# LANGUAGE OverloadedStrings #-}

1+-- | 'D4.Invalid's contain a JSON Pointer to the subset of the data that

2+-- caused validation to fail, but they don't contain that data itself.

3+--

4+-- If you want to display the invalid subset of the data here's how you

5+-- resolve the JSON Pointer (which has the field name

6+-- 'D4._invalidOffendingData') against the original data.

7+--

8+-- NOTE: You have to have hjsonpointer in your build-depends.

310module PrettyShowFailure where

411

@@ -20,18 +27,6 @@ failure = D4.Invalid

2027

2128example :: IO ()

2229example =

23− -- 'D4.Invalid's contain the sequence of embedded validators that caused

24− -- the invalidation, the contents of the final validator in that sequence,

25− -- and a JSON Pointer to the subset of data that caused validation to fail.

26− --

27− -- They don't actually contain that subset of data, since it can be derived

28− -- from the original data and the JSON Pointer.

29− --

30− -- If you want to display the invalid subset of the data here's how you

31− -- resolve the JSON Pointer (which has the field name

32− -- 'D4._failureOffendingData') against the original data.

33− --

34− -- NOTE: You have to have hjsonpointer in your build-depends.

3530 case AP.resolve (D4._invalidOffendingData failure) badData of

3631 Left _ -> error "Couldn't resolve pointer."

3732 Right _ -> return () -- Success. We could feed the 'Right' value into

examples/Simple.hsnew file+39

@@ -0,0 +1,39 @@

1+-- | Fetch any referenced schemas, check that our original schema is itself

2+-- valid, then validate our data.

3+--

4+-- To fetch schemas using HTTP instead of from the filesystem use

5+-- 'D4.fetchHTTPAndValidate'.

7+module Simple where

9+import Data.Aeson

10+import qualified Data.List.NonEmpty as NE

11+

12+import qualified Data.JsonSchema.Draft4 as D4

13+

14+schema :: D4.Schema

15+schema = D4.emptySchema { D4._schemaRef = Just "./unique.json" }

16+

17+schemaContext :: D4.SchemaWithURI D4.Schema

18+schemaContext = D4.SchemaWithURI

19+ { D4._swSchema = schema

20+ , D4._swURI = Just "./examples/json/imaginary.json"

21+ -- ^ For this example we're pretending we found 'schema' at this location.

22+ -- Its relative links will be resolved from here.

23+ }

24+

25+badData :: Value

26+badData = toJSON (["foo", "foo"] :: [String])

27+

28+example :: IO ()

29+example = do

30+ res <- D4.fetchFilesystemAndValidate schemaContext badData

31+ case res of

32+ Right () -> error "We validated bad data."

33+ Left (D4.FVRead _) -> error ("Error fetching a referenced schema"

34+ ++ " (either during IO or parsing).")

35+ Left (D4.FVSchema _) -> error "Our 'schema' itself was invalid."

36+ Left (D4.FVData failures) ->

37+ case NE.toList failures of

38+ [D4.Invalid (D4.Ref D4.UniqueItems) _ _] -> return () -- Success.

39+ _ -> error "Got more invalidation reasons than we expected."

examples/Standard.hsdeleted−49

@@ -1,49 +0,0 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−

3−module Standard where

4−

5−import Data.Aeson

6−import qualified Data.Vector as V

7−

8−import qualified Data.JsonSchema.Draft4 as D4

9−

10−schema :: D4.Schema

11−schema = D4.emptySchema { D4._schemaUniqueItems = Just True }

12−

13−schemaContext :: D4.SchemaWithURI D4.Schema

14−schemaContext = D4.SchemaWithURI

15− { D4._swSchema = schema

16− , D4._swURI = Nothing

17− -- ^ If your schema has relative references to other schemas

18− -- then you'll need to give its URI here.

19− }

20−

21−badData :: Value

22−badData = Array (V.fromList ["foo", "foo"])

23−

24−example :: IO ()

25−example = do

26− -- Since we know our schema doesn't reference any other schemas we could

27− -- skip this step and use @ReferencedSchemas schema mempty@ instead.

28− --

29− -- If we make a mistake and out schema does include references to other

30− -- schemas then those references will always return 'D4.RefResolution'

31− -- validation failures.

32− cache <- makeCache

33−

34− let validate = case D4.checkSchema cache schemaContext of

35− Left _ -> error "Not a valid schema."

36− Right f -> f

37−

38− case validate badData of

39− [] -> error "We validated bad data."

40− [D4.Invalid D4.UniqueItems _ _] -> return () -- Success.

41− _ -> error "We got a different failure than expected."

42−

43− where

44− makeCache :: IO (D4.ReferencedSchemas D4.Schema)

45− makeCache = do

46− res <- D4.referencesViaHTTP schemaContext

47− case res of

48− Left _ -> error "Couldn't fetch referenced schemas."

49− Right cache -> return cache

examples/json/unique.jsonnew file+3

@@ -0,0 +1,3 @@

1+{

2+ "uniqueItems": true

3+}

hjsonschema.cabal+3−2

@@ -69,9 +69,9 @@ test-suite local

6969 , Shared

7070 -- from ./examples:

7171 , CustomSchema

72+ , Full

7273 , PrettyShowFailure

73− , Standard

74−

74+ , Simple

7575 default-language: Haskell2010

7676 ghc-options: -Wall -fno-warn-orphans

7777 default-extensions: OverloadedStrings

@@ -81,6 +81,7 @@ test-suite local

8181 , filepath

8282 , hjsonpointer

8383 , hjsonschema

84+ , semigroups

8485 , text

8586 , QuickCheck

8687 , unordered-containers

src/Data/JsonSchema/Draft4.hs+4−3

@@ -97,7 +97,9 @@ fetchFilesystemAndValidate sw v = do

9797 Nothing -> Right ()

9898 Just failures -> Left (FVData failures)

9999

100−-- | Check the validity of a schema and return a function to validate data.

100+-- | Check the that a schema itself is valid.

101+--

102+-- Return a function to validate data.

101103checkSchema

102104 :: ReferencedSchemas Schema

103105 -> SchemaWithURI Schema

@@ -120,8 +122,7 @@ referencesViaFilesystem

120122 -> IO (Either FilesystemFailure (ReferencedSchemas Schema))

121123referencesViaFilesystem = FE.referencesViaFilesystem' draft4Spec

122124

123−-- | In normal situations just use 'checkSchema', which is a combination of

124−-- 'schemaValidity' and 'runValidate'.

125+-- | Check that a schema itself is valid.

125126schemaValidity :: Schema -> [Invalid]

126127schemaValidity = IN.runValidate referenced (SchemaWithURI d4 Nothing) . toJSON

127128 where

test/Local.hs+9−7

@@ -12,9 +12,10 @@ import qualified Test.Tasty.HUnit as HU

1212import Test.Tasty.QuickCheck (testProperty)

1313

1414-- Examples

15−import qualified CustomSchema as C

16−import qualified PrettyShowFailure as P

17−import qualified Standard as S

15+import qualified CustomSchema

16+import qualified Full

17+import qualified PrettyShowFailure

18+import qualified Simple

1819

1920import Data.JsonSchema.Draft4

2021import Local.Failure (correctPaths)

@@ -30,7 +31,7 @@ main = do

3031 filenames <- filter isLocal . filter (".json" `isSuffixOf`) <$> getDirectoryContents dir

3132 ts <- readSchemaTests dir filenames

3233 defaultMain . testGroup "Tests not requiring an HTTP server" $

33− testGroup "Check that examples compile" exampleTests

34+ testGroup "Check that examples compile and don't throw errors" exampleTests

3435 : testGroup "QuickCheck tests" quickCheckTests

3536 : testGroup "Report the path to invalid data correctly" correctPaths

3637 : testGroup "Test the referencesViaFilesystem function" fetchFromFilesystem

@@ -46,7 +47,8 @@ quickCheckTests =

4647

4748exampleTests :: [TestTree]

4849exampleTests =

49− [ HU.testCase "Standard Example" S.example

50− , HU.testCase "PrettyShowFailure Example" P.example

51− , HU.testCase "CustomSchema Example" C.example

50+ [ HU.testCase "CustomSchema example" CustomSchema.example

51+ , HU.testCase "Full example" Full.example

52+ , HU.testCase "PrettyShowFailure example" PrettyShowFailure.example

53+ , HU.testCase "Simple example" Simple.example

5254 ]