json-schema 0.7.4.0 → 0.7.4.1
raw patch · 5 files changed
+45/−30 lines, 5 filesdep ~aesondep ~generic-derivingdep ~tasty
Dependency ranges changed: aeson, generic-deriving, tasty, tasty-hunit, time, vector
Files
- CHANGELOG.md +4/−0
- json-schema.cabal +5/−5
- src/Data/JSON/Schema/Generic.hs +23/−18
- src/Data/JSON/Schema/Validate.hs +6/−6
- tests/Main.hs +7/−1
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Changelog +#### 0.7.4.1++* aeson-0.10 produces new error messages so the test-suite was updated to reflect this.+ ### 0.7.4.0 * Raise upper length limit of `UTCTime` since aeson-0.9 increased the precision.
json-schema.cabal view
@@ -1,5 +1,5 @@ name: json-schema-version: 0.7.4.0+version: 0.7.4.1 synopsis: Types and type classes for defining JSON schemas. description: Types and type classes for defining JSON schemas. .@@ -35,10 +35,10 @@ Data.JSON.Schema.Validate build-depends: base >= 4.4 && < 5- , aeson >= 0.7 && < 0.10+ , aeson >= 0.7 && < 0.11 , containers >= 0.3 && < 0.6 , generic-aeson == 0.2.*- , generic-deriving >= 1.6 && < 1.9+ , generic-deriving >= 1.6 && < 1.10 , mtl >= 2.1 && < 2.3 , scientific == 0.3.* , text >= 0.10 && < 1.3@@ -63,13 +63,13 @@ Test.Validate build-depends: base >= 4.4 && < 5- , aeson >= 0.7 && < 0.10+ , aeson >= 0.7 && < 0.11 , aeson-utils >= 0.2 && < 0.4 , attoparsec >= 0.10 && < 0.14 , bytestring >= 0.10 && < 0.12 , generic-aeson == 0.2.* , json-schema- , tasty == 0.10.*+ , tasty >= 0.10 && < 0.12 , tasty-hunit == 0.9.* , tasty-th == 0.1.* , text >= 0.10 && < 1.3
src/Data/JSON/Schema/Generic.hs view
@@ -55,8 +55,8 @@ gSchema' _ _ _ _ = empty instance (GJSONSchema f, GJSONSchema g) => GJSONSchema (f :+: g) where- gSchema' set enm names p =- gSchema' set enm names (gL <$> p)+ gSchema' set enm names p+ = gSchema' set enm names (gL <$> p) <|> gSchema' set enm names (gR <$> p) where gL :: (f :+: g) r -> f r@@ -65,19 +65,28 @@ gR _ = undefined instance (GJSONSchema f, GJSONSchema g) => GJSONSchema (f :*: g) where- gSchema' set enm names p = gSchema' set enm names (gFst <$> p) `merge` gSchema' set enm names (gSnd <$> p)+ gSchema' set enm names p = gSchema' set enm names (gFst <$> p)+ `merge` gSchema' set enm names (gSnd <$> p)+ where+ gFst :: (f :*: g) r -> f r+ gFst (f :*: _) = f + gSnd :: (f :*: g) r -> g r+ gSnd (_ :*: g) = g+ instance (Constructor c, GJSONSchema f) => GJSONSchema (M1 C c f) where- gSchema' set True _ = toConstant set . conNameT set . pv- gSchema' set enm names = wrap . gSchema' set enm names . fmap unM1- where- wrap = if multipleCons names- then field (conNameT set (undefined :: M1 C c f p)) True- else id+ gSchema' set enm names+ | enm = toConstant set . conNameT set . pv+ | otherwise = wrap . gSchema' set enm names . fmap unM1+ where+ wrap = if multipleCons names+ then field (conNameT set (undefined :: M1 C c f p)) True+ else id instance GJSONSchema f => GJSONSchema (M1 D c f) where- gSchema' set True names p | multipleCons names = const (Choice . fmap (toConstant set) $ names) $ p- gSchema' set enm names p = gSchema' set enm names . fmap unM1 $ p+ gSchema' set enm names p+ | enm && multipleCons names = Choice $ toConstant set <$> names+ | otherwise = gSchema' set enm names . fmap unM1 $ p instance (Selector c, JSONSchema a) => GJSONSchema (M1 S c (K1 i (Maybe a))) where gSchema' set _ _ =@@ -87,7 +96,8 @@ where maybeElemSchema :: Proxy (M1 S c (K1 i (Maybe a)) p) -> Schema maybeElemSchema = s- where s = schema . fmap (fromJust . unK1 . unM1)+ where+ s = schema . fmap (fromJust . unK1 . unM1) instance Selector c => GJSONSchema (M1 S c (K1 i (Maybe String))) where gSchema' set _ _ _ =@@ -98,16 +108,11 @@ instance (Selector c, GJSONSchema f) => GJSONSchema (M1 S c f) where gSchema' set enm names = wrap . gSchema' set enm names . fmap unM1 where- wrap = maybe id (\s -> field s True) $ selNameT set (undefined :: M1 S c f p)+ wrap = maybe id (`field` True) $ selNameT set (undefined :: M1 S c f p) toConstant :: Settings -> Text -> Schema toConstant set = Constant . Aeson.String . formatLabel set -gFst :: (f :*: g) r -> f r-gFst (f :*: _) = f--gSnd :: (f :*: g) r -> g r-gSnd (_ :*: g) = g pv :: Proxy a -> a pv _ = undefined
src/Data/JSON/Schema/Validate.hs view
@@ -68,7 +68,7 @@ cond e p = if p then ok else err e nestPath :: Text -> M a -> M a-nestPath p m = local (`V.snoc` p) $ m+nestPath p = local (`V.snoc` p) validate' :: Schema -> Value -> M () validate' sch val = case (sch, val) of@@ -101,7 +101,7 @@ do inLowerLength b (V.length vs) inUpperLength b (V.length vs) if u then unique vs else ok- sequence_ $ zipWith+ zipWithM_ (\i -> nestPath (T.pack (show i)) . validate' s) [(0::Int)..] (V.toList vs) ( S.Boolean {}, _ ) -> err $ Mismatch sch val@@ -126,24 +126,24 @@ inLower :: S.Bound -> Scientific -> M () inLower b v =- if (maybe True ((<= v) . fromIntegral) . S.lower $ b)+ if maybe True ((<= v) . fromIntegral) . S.lower $ b then ok else err (BoundError b v) inUpper :: S.Bound -> Scientific -> M () inUpper b v =- if (maybe True ((>= v) . fromIntegral) . S.upper $ b)+ if maybe True ((>= v) . fromIntegral) . S.upper $ b then ok else err (BoundError b v) inLowerLength :: S.LengthBound -> Int -> M () inLowerLength b v =- if (maybe True (<= v) . S.lowerLength $ b)+ if maybe True (<= v) . S.lowerLength $ b then ok else err (LengthBoundError b v) inUpperLength :: S.LengthBound -> Int -> M () inUpperLength b v =- if (maybe True (>= v) . S.upperLength $ b)+ if maybe True (>= v) . S.upperLength $ b then ok else err (LengthBoundError b v)
tests/Main.hs view
@@ -1,6 +1,7 @@ {-# OPTIONS -fno-warn-missing-signatures #-} {-# LANGUAGE- DeriveGeneric+ CPP+ , DeriveGeneric , OverloadedStrings , ScopedTypeVariables , TemplateHaskell@@ -267,8 +268,13 @@ bidir "[null,2]" b valid b +#if MIN_VERSION_aeson(0,10,0)+ eq (Left "Error in $: expected Int, encountered Boolean" :: Either String X)+ (eitherDecode "[true,2]")+#else eq (Left "when expecting a Int, encountered Boolean instead" :: Either String X) (eitherDecode "[true,2]")+#endif eq (Tuple [nullable number, number]) (schema (Proxy :: Proxy X))