git.iko.soy/typeable/hjsonschema
on 0.7 help sign in
typeable/hjsonschema/Example.hs
74 lines 2.5 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
3module Main where
5import Data.Aeson
6import Data.HashMap.Strict (HashMap)
7import qualified Data.HashMap.Strict as H
8import Data.Monoid
9import Data.Text (Text)
10import qualified Data.Text as T
11import qualified Data.Vector as V
13import qualified Data.JsonSchema as JS
15-- Data.JsonSchema isn't designed to be imported qualified,
16-- but we're doing it here to make it obvious what's coming
17-- from the lib.
19schemaData :: JS.RawSchema
20schemaData = JS.RawSchema
21 { JS._rsURI = ""
22 , JS._rsObject = schemaJSON
23 }
24 where
25 schemaJSON :: HashMap Text Value
26 schemaJSON = H.singleton "uniqueItems" (Bool True)
28badData :: Value
29badData = Array $ V.fromList ["foo", "foo"]
31main :: IO ()
32main = do
34 let currentSchemaCache = H.empty
35 newSchemaCache <- (<> currentSchemaCache) <$> fetchGraph schemaData
37 schema <- compileSchema newSchemaCache schemaData
38 checkResults (JS.validate schema badData)
40 where
42 -- Not necessary in this case, but it serves as an example.
43 --
44 -- Note that Graphs are used to handle internal as well as external references.
45 -- So even if a schema doesn't reference outside documents, you still need
46 -- to generate a real Graph (and not just use mempty) if it refences itself.
47 fetchGraph :: JS.RawSchema -> IO JS.Graph
48 fetchGraph rs = do
49 eitherGraph <- JS.fetchReferencedSchemas JS.draft4 rs H.empty
50 case eitherGraph of
51 Left e -> error $ "Failed to fetch graph with error: " <> T.unpack e
52 Right graph -> return graph
54 compileSchema :: JS.Graph -> JS.RawSchema -> IO (JS.Schema JS.Draft4Failure)
55 compileSchema graph rs =
56 case JS.compileDraft4 graph rs of
57 Left failure -> error $ "Not a valid schema: " <> show failure
58 Right schema -> return schema
60 checkResults :: [JS.ValidationFailure JS.Draft4Failure] -> IO ()
61 checkResults [] = error "OHNO we validated bad data!"
62 checkResults [JS.ValidationFailure JS.UniqueItems (JS.FailureInfo x y)] =
63 putStrLn . unlines $
64 [ ""
65 , "Success. We got a UniqueItems error as expected."
66 , "Here's the relevant part of the bad JSON document:"
67 , ""
68 , " " <> show y
69 , ""
70 , "And here's the content of the validator that caught it:"
71 , ""
72 , " " <> show x
73 ]
74 checkResults x = error $ "OHNO we got a different failure than we expected: " <> show x