hjsonschema 0.1.1.0 → 0.2.0.0

raw patch · 6 files changed

+81/−52 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +1/−1
• hjsonschema.cabal +1/−1
• src/Data/JsonSchema.hs +37/−42
• src/Data/JsonSchema/Core.hs +5/−3
• src/Data/JsonSchema/Validators.hs +35/−3
• tests/Lib.hs +2/−2

@@ -6,7 +6,7 @@  Still in development. Lacks documentation, example code, and real error messages. -Also while all the official tests pass, its implementation of the `$ref` and `id` keywords is incomplete.+Also while the official tests pass, its handling of the `id` keyword is incomplete.  # Install Tests 

@@ -1,5 +1,5 @@ name:                   hjsonschema-version:                0.1.1.0+version:                0.2.0.0 synopsis:               Haskell implementation of JSON Schema v4. homepage:               https://github.com/seagreen/hjsonschema license:                MIT

@@ -4,7 +4,6 @@   ) where  import           Control.Applicative-import           Data.Aeson import           Data.Foldable import qualified Data.HashMap.Strict           as H import           Data.JsonSchema.Core@@ -12,7 +11,6 @@ import           Data.JsonSchema.Utils import           Data.JsonSchema.Validators import           Data.Maybe-import           Data.Text                     (Text) import qualified Data.Text                     as T import           Data.Vector                   (Vector) import qualified Data.Vector                   as V@@ -20,50 +18,47 @@  draft4 :: Spec draft4 = Spec $ H.fromList-  [ ("$ref", ref)-  , ("multipleOf", multipleOf)-  , ("maximum", maximumVal)-  , ("minimum", minimumVal)-  , ("maxLength", maxLength)-  , ("minLength", minLength)-  , ("pattern", pattern)-  , ("items", items)-  , ("maxItems", maxItems)-  , ("minItems", minItems)-  , ("uniqueItems", uniqueItems)-  , ("maxProperties", maxProperties)-  , ("minProperties", minProperties)-  , ("required", required)-  , ("properties", properties)-  , ("patternProperties", patternProperties)-  , ("additionalProperties", additionalProperties)-  , ("dependencies", dependencies)-  , ("enum", enum)-  , ("type", typeVal)-  , ("allOf", allOf)-  , ("anyOf", anyOf)-  , ("oneOf", oneOf)-  , ("not", notValidator)+  [ ("$ref"                , (ref                 , noEm))+  , ("multipleOf"          , (multipleOf          , noEm))+  , ("maximum"             , (maximumVal          , noEm))+  , ("minimum"             , (minimumVal          , noEm))+  , ("maxLength"           , (maxLength           , noEm))+  , ("minLength"           , (minLength           , noEm))+  , ("pattern"             , (pattern             , noEm))+  , ("additionalItems"     , (noVal               , objEmbed))+  , ("items"               , (items               , objOrArrayEmbed))+  , ("maxItems"            , (maxItems            , noEm))+  , ("minItems"            , (minItems            , noEm))+  , ("uniqueItems"         , (uniqueItems         , noEm))+  , ("maxProperties"       , (maxProperties       , noEm))+  , ("minProperties"       , (minProperties       , noEm))+  , ("required"            , (required            , noEm))+  , ("properties"          , (properties          , objMembersEmbed))+  , ("patternProperties"   , (patternProperties   , objMembersEmbed))+  , ("additionalProperties", (additionalProperties, objEmbed))+  , ("dependencies"        , (dependencies        , objMembersEmbed))+  , ("enum"                , (enum                , noEm))+  , ("type"                , (typeVal             , noEm))+  , ("allOf"               , (allOf               , arrayEmbed))+  , ("anyOf"               , (anyOf               , arrayEmbed))+  , ("oneOf"               , (oneOf               , arrayEmbed))+  , ("not"                 , (notValidator        , objEmbed))+  , ("definitions"         , (noVal               , objMembersEmbed))   ] -fetchRefs :: RawSchema -> Graph -> IO Graph-fetchRefs a graph =-  let newGraph = H.insert (_rsURI a) (_rsObject a) graph-      rSchema = allEmbedded (_rsURI a, Object $ _rsObject a) V.empty-  in foldlM fetch newGraph rSchema+fetchRefs :: Spec -> RawSchema -> Graph -> IO Graph+fetchRefs spec a graph =+  let startingGraph = H.insert (_rsURI a) (_rsObject a) graph+  in foldlM fetch startingGraph (includeEmbedded a)    where     -- TODO: optimize-    allEmbedded :: (Text, Value) -> Vector RawSchema -> Vector RawSchema-    allEmbedded (t, Object o) rs =-      let t' = updateId t o-          r = RawSchema t' o-          ns = (\x -> (t',x)) <$> V.fromList (H.elems o)-      in foldr allEmbedded (V.snoc rs r) ns-    allEmbedded (t, Array vs) rs =-      let ns = (\x -> (t,x)) <$> vs-      in foldr allEmbedded rs ns-    allEmbedded _ rs = rs+    includeEmbedded :: RawSchema -> Vector RawSchema+    includeEmbedded r =+      let newId = updateId (_rsURI r) (_rsObject r)+          xs = H.intersectionWith (\(_,f) x -> f newId x) (_unSpec spec) (_rsObject r)+          ys = V.concat . H.elems $ xs+      in V.cons r . V.concat . V.toList $ includeEmbedded <$> ys      fetch :: Graph -> RawSchema -> IO Graph     fetch g r =@@ -76,5 +71,5 @@             else do               eResp <- fetchRef t               case eResp of-                Right obj -> fetchRefs (RawSchema t obj) g+                Right obj -> fetchRefs spec (RawSchema t obj) g                 _         -> return g

@@ -9,7 +9,9 @@ import           Data.Vector                   (Vector) import qualified Data.Vector                   as V -newtype Spec = Spec { _unSpec :: HashMap Text ValidatorGen }+newtype Spec = Spec+  { _unSpec :: HashMap Text (ValidatorGen, Text -> Value -> Vector RawSchema)+  }  -- | Set of potentially mutually recursive schemas. type Graph = HashMap Text (HashMap Text Value)@@ -31,8 +33,8 @@ compile spec g (RawSchema t o) =   V.fromList . catMaybes . H.elems $ H.intersectionWith f (_unSpec spec) o   where-    f :: ValidatorGen -> Value -> Maybe Validator-    f vGen = vGen spec g $ RawSchema (updateId t o) o+    f :: (ValidatorGen, a) -> Value -> Maybe Validator+    f (vGen,_) = vGen spec g $ RawSchema (updateId t o) o  validate :: Schema -> Value -> Vector ValErr validate s x = s >>= ($ x)

@@ -8,11 +8,15 @@ -- This module exposes three types of functions. To describe -- them we'll use the properties validators as an example. ----- 1. Functions that aren't followed by apostrophes have the+-- 1. Functions which describe how subschemas (if any)+-- are embedded in this validator. This is how 'fetchRefs'+-- is able to find "$refs" and "ids".+--+-- 2. Functions that aren't followed by apostrophes have the -- type 'ValidatorGen' and are meant to be used in a 'Spec'. -- Examples are 'properties' and 'additionalProperties'. ----- 2. Functions that are followed by a single apostrophe, such+-- 3. Functions that are followed by a single apostrophe, such -- as 'additionalProperties'', aren't meant to be used standalone -- in a 'Spec'. Instead they're used by other validators. For -- instance, 'additionalProperties' disables itself if the key@@ -21,7 +25,7 @@ -- 'additionalProperties' in 'additionalProperties'' allows for -- code reuse between 'properties' and 'additionalProperties'. ----- 3. Functions that are followed by a double apostrophe, such+-- 4. Functions that are followed by a double apostrophe, such -- as 'patternProperties''', return an enhanced validator. It -- not only reports errors, but also the parts of the target -- data that it matches. These functions also aren't used in@@ -50,6 +54,31 @@ import           Text.RegexPR  --------------------------------------------------+-- Embedded Schema Layouts+--------------------------------------------------++noEm :: Text -> Value -> Vector RawSchema+noEm _ _ = V.empty++objEmbed :: Text -> Value -> Vector RawSchema+objEmbed t (Object o) = V.singleton $ RawSchema t o+objEmbed _ _ = V.empty++-- TODO: optimize+arrayEmbed :: Text -> Value -> Vector RawSchema+arrayEmbed t (Array vs) = V.concat . V.toList $ (\o -> objEmbed t o) <$> vs+arrayEmbed _ _ = V.empty++objOrArrayEmbed :: Text -> Value -> Vector RawSchema+objOrArrayEmbed t v@(Object _) = objEmbed t v+objOrArrayEmbed t v@(Array _) = arrayEmbed t v+objOrArrayEmbed _ _ = V.empty++objMembersEmbed :: Text -> Value -> Vector RawSchema+objMembersEmbed t (Object o) = V.concat $ (\x -> objEmbed t x) <$> H.elems o+objMembersEmbed _ _ = V.empty++-------------------------------------------------- -- Number Validators -------------------------------------------------- @@ -495,3 +524,6 @@         (Object o) -> Just $ RawSchema (_rsURI rawS) o         _           -> Nothing ref _ _ _ _ = Nothing++noVal :: ValidatorGen+noVal = (\_ _ _ _ -> Just (const V.empty))

@@ -82,11 +82,11 @@  assertValid, assertInvalid :: RawSchema -> Value -> HU.Assertion assertValid r v = do-  g <- fetchRefs r H.empty+  g <- fetchRefs draft4 r H.empty   let es = validate (compile draft4 g r) v   unless (V.length es == 0) $ HU.assertFailure (show es) assertInvalid r v = do-  g <- fetchRefs r H.empty+  g <- fetchRefs draft4 r H.empty   let es = validate (compile draft4 g r) v   when (V.length es == 0) $ HU.assertFailure "expected a validation error"