git.iko.soy/typeable/hjsonschema
on 0.8 help sign in
typeable/hjsonschema/Example.hs
103 lines 3.3 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
3module Main where
5import Control.Applicative
6import Data.Aeson
7import Data.HashMap.Strict (HashMap)
8import qualified Data.HashMap.Strict as H
9import Data.Monoid
10import Data.Text (Text)
11import qualified Data.Text as T
12import qualified Data.Vector as V
14import qualified Data.JsonSchema as JS
16-- Data.JsonSchema is designed to be imported unqualified.
17-- We're just being explicit here for example purposes.
19main :: IO ()
20main = do
21 simpleExample
22 fullExample
24--------------------------------------------------
25-- * Example Schema and Data
26--------------------------------------------------
28schemaData :: JS.RawSchema
29schemaData = JS.RawSchema
30 { JS._rsURI = Nothing
31 -- ^ If your schema has relative references to other schemas
32 -- then you'll need to include this.
33 , JS._rsData = schemaJSON
34 }
35 where
36 schemaJSON :: HashMap Text Value
37 schemaJSON = H.singleton "uniqueItems" (Bool True)
39badData :: Value
40badData = Array $ V.fromList ["foo", "foo"]
42--------------------------------------------------
43-- * Simple Example
44--------------------------------------------------
46-- | Since our schema contains no references to other schemas,
47-- we can skip the fetchGraph step.
48simpleExample :: IO ()
49simpleExample = do
50 schema <- compileSchema (JS.SchemaGraph schemaData H.empty) schemaData
51 checkResults (JS.validate schema badData)
53--------------------------------------------------
54-- * Full Example
55--------------------------------------------------
57-- | For a schema that might contain references to other schemas.
58fullExample :: IO ()
59fullExample = do
60 let currentSchemaCache = H.empty
61 schemaGraph <- fetchGraph currentSchemaCache schemaData
63 -- We aren't going to use it for anything this time, but if we were caching
64 -- remote schemas this would be our new cache.
65 --
66 -- let newSchemaCache = _cachedSchemas schemaData <> currentSchemaGraph
68 schema <- compileSchema schemaGraph schemaData
69 checkResults (JS.validate schema badData)
71 where
72 fetchGraph :: HashMap Text (HashMap Text Value) -> JS.RawSchema -> IO JS.SchemaGraph
73 fetchGraph graph rs = do
74 eitherGraph <- JS.fetchReferencedSchemas JS.draft4 graph rs
75 case eitherGraph of
76 Left e -> error $ "Failed to fetch graph with error: " <> T.unpack e
77 Right g -> return g
79--------------------------------------------------
80-- * Helper Functions
81--------------------------------------------------
83compileSchema :: JS.SchemaGraph -> JS.RawSchema -> IO (JS.Schema JS.Draft4Failure)
84compileSchema graph rs =
85 case JS.compileDraft4 graph rs of
86 Left failure -> error $ "Not a valid schema: " <> show failure
87 Right schema -> return schema
89checkResults :: [JS.ValidationFailure JS.Draft4Failure] -> IO ()
90checkResults [] = error "OHNO we validated bad data!"
91checkResults [JS.ValidationFailure JS.UniqueItems (JS.FailureInfo x y)] =
92 putStrLn . unlines $
93 [ ""
94 , "Success. We got a UniqueItems error as expected."
95 , "Here's the relevant part of the bad JSON document:"
96 , ""
97 , " " <> show y
98 , ""
99 , "And here's the content of the validator that caught it:"
100 , ""
101 , " " <> show x
102 ]
103checkResults x = error $ "OHNO we got a different failure than we expected: " <> show x