jsonschema-gen 0.3.0.1 → 0.4.0.0
raw patch · 5 files changed
+75/−42 lines, 5 filesdep ~aesondep ~basedep ~bytestring
Dependency ranges changed: aeson, base, bytestring, containers, process, scientific, tagged, text, time, unordered-containers, vector
Files
- changelog.md +6/−0
- jsonschema-gen.cabal +20/−20
- src/Data/JSON/Schema/Generator/Convert.hs +3/−0
- src/Data/JSON/Schema/Generator/Generic.hs +18/−0
- tests/Main.hs +28/−22
changelog.md view
@@ -1,3 +1,9 @@+0.4.0.0++* Remove upper bound on depedencies.+* Add support for `GHC 8.0.*`+* Add support for `aeson-1.0.*`+ 0.3.0.1 * Allow `aeson-0.9.*`
jsonschema-gen.cabal view
@@ -1,5 +1,5 @@ name: jsonschema-gen-version: 0.3.0.1+version: 0.4.0.0 synopsis: JSON Schema generator from Algebraic data type description: This library contains a JSON Schema generator. homepage: https://github.com/yuga/jsonschema-gen@@ -25,23 +25,23 @@ Data.JSON.Schema.Generator.Generic Data.JSON.Schema.Generator.Types - build-depends: base >=4.6 && <4.9- , bytestring >=0.10 && <0.11- , containers >=0.5 && <0.6- , tagged >=0.7 && <0.9- , text >=0.11 && <1.3- , time >=1.4 && <1.6- , unordered-containers >=0.2 && <0.3- , vector >=0.10 && <0.11+ build-depends: base >=4.6 && <4.10+ , bytestring >=0.10+ , containers >=0.5+ , tagged >=0.7+ , text >=0.11+ , time >=1.4+ , unordered-containers >=0.2+ , vector >=0.10 if flag(safe-aeson) build-depends:- aeson >=0.7.0.6 && <0.10- , scientific >=0.3.2.0 && <0.4+ aeson >=0.7.0.6+ , scientific >=0.3.2.0 else build-depends:- aeson >=0.7 && <0.10- , scientific >=0.2 && <0.4+ aeson >=0.7+ , scientific >=0.2 hs-source-dirs: src default-language: Haskell2010@@ -56,14 +56,14 @@ main-is: Main.hs other-modules: Types Values- build-depends: base >=4.6 && <4.9- , aeson >=0.7 && <0.10- , bytestring >=0.10 && <0.11- , containers >=0.5 && <0.6+ build-depends: base >=4.6+ , aeson >=0.7+ , bytestring >=0.10+ , containers >=0.5 , jsonschema-gen- , process >=1.1 && <1.3- , tagged >=0.7 && <0.9- , text >=0.11 && <1.3+ , process >=1.1+ , tagged >=0.7+ , text >=0.11 hs-source-dirs: tests default-language: Haskell2010
src/Data/JSON/Schema/Generator/Convert.hs view
@@ -222,6 +222,9 @@ conAsObject' opts@(A.Options {A.sumEncoding = A.TaggedObject tFld cFld}) sc = conAsTag opts (pack tFld) (pack cFld) sc conAsObject' opts@(A.Options {A.sumEncoding = A.TwoElemArray }) sc = conAsArray opts sc conAsObject' opts@(A.Options {A.sumEncoding = A.ObjectWithSingleField }) sc = conAsMap opts sc+#if MIN_VERSION_aeson(1,0,0)+conAsObject' _opts@(A.Options {A.sumEncoding = A.UntaggedValue }) _sc = error "Unsupported option"+#endif conAsTag :: A.Options -> Text -> Text -> SchemaChoice -> A.Value conAsTag opts tFld cFld (SCChoiceEnum tag _) = object [(tFld, object [("enum", array [tag])]), (cFld, conToArray opts [])]
src/Data/JSON/Schema/Generator/Generic.hs view
@@ -1,7 +1,12 @@ {-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 800+{-# LANGUAGE DataKinds #-}+#endif+{-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-}@@ -11,6 +16,10 @@ {-# LANGUAGE OverlappingInstances #-} #endif +#if __GLASGOW_HASKELL__ >= 800+{-# OPTIONS_GHC -Wno-redundant-constraints #-}+#endif+ {-# OPTIONS_GHC -fno-warn-orphans #-} module Data.JSON.Schema.Generator.Generic () where@@ -36,7 +45,11 @@ import Data.Time (UTCTime) import GHC.Generics ( Datatype(datatypeName, moduleName), Constructor(conName), Selector(selName)+#if MIN_VERSION_base(4,9,0)+ , Meta(MetaSel)+#else , NoSelector+#endif , C1, D1, K1, M1(unM1), S1, U1, (:+:), (:*:) , S) @@ -52,6 +65,7 @@ initEnv :: Env initEnv = Env "" "" "" Nothing + instance (Datatype d, SchemaType f) => GJSONSchemaGen (D1 d f) where gToSchema opts pd = SCSchema { scId = Text.pack $ baseUri opts ++ modName ++ "." ++ typName ++ schemaIdSuffix opts@@ -416,7 +430,11 @@ #if __GLASGOW_HASKELL__ >= 710 instance (IsRecord f isRecord) => IsRecord (f :*: g) isRecord+#if MIN_VERSION_base(4,9,0)+instance {-# OVERLAPPING #-} IsRecord (M1 S ('MetaSel 'Nothing u ss ds) f) False+#else instance {-# OVERLAPPING #-} IsRecord (M1 S NoSelector f) False+#endif instance {-# OVERLAPPABLE #-} (IsRecord f isRecord) => IsRecord (M1 S c f) isRecord instance IsRecord (K1 i c) True instance IsRecord U1 False
tests/Main.hs view
@@ -1,11 +1,9 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main where@@ -25,8 +23,8 @@ import GHC.Generics import System.Exit (ExitCode(ExitSuccess), exitWith) import System.IO (Handle, IOMode(WriteMode), hClose, hPutStr, hPutStrLn, withFile)-import System.Process (CreateProcess(..), CmdSpec(RawCommand), StdStream(CreatePipe, Inherit)- , createProcess, system, waitForProcess)+import System.Process (CreateProcess(..), StdStream(CreatePipe)+ , createProcess, proc, system, waitForProcess) import Types import Values@@ -51,13 +49,21 @@ -- data TestDatum =+#if MIN_VERSION_aeson(1,0,0)+ forall a. (Generic a, A.GToJSON A.Zero (Rep a), SchemaName (Rep a))+#else forall a. (Generic a, A.GToJSON (Rep a), SchemaName (Rep a))+#endif => TestDatum { tdName :: String , tdValue :: a } +#if MIN_VERSION_aeson(1,0,0)+testDatum :: (Generic a, A.GToJSON A.Zero (Rep a), SchemaName (Rep a)) => String -> a -> TestDatum+#else testDatum :: (Generic a, A.GToJSON (Rep a), SchemaName (Rep a)) => String -> a -> TestDatum-testDatum name p = TestDatum name p+#endif+testDatum = TestDatum testData :: [TestDatum] testData =@@ -97,7 +103,11 @@ , A.TwoElemArray ] +#if MIN_VERSION_aeson(1,0,0)+encode :: (Generic a, A.GToJSON A.Zero (Rep a)) => A.Options -> a -> BL.ByteString+#else encode :: (Generic a, A.GToJSON (Rep a)) => A.Options -> a -> BL.ByteString+#endif encode opt a = A.encode (A.genericToJSON opt a) --@@ -121,7 +131,11 @@ go [] _ = [] go (opt:opts') n = (opt, name ++ "_" ++ show n) : go opts' (n + 1) +#if MIN_VERSION_aeson(1,0,0)+printValueAsJson :: (Generic a, A.GToJSON A.Zero (Rep a)) => Handle -> [A.Options] -> String -> a -> IO ()+#else printValueAsJson :: (Generic a, A.GToJSON (Rep a)) => Handle -> [A.Options] -> String -> a -> IO ()+#endif printValueAsJson h opts name value = forM_ (pairsOptSymbol opts name) . uncurry $ \opt symbol -> do hPutStrLn h $ optToStr symbol opt@@ -131,7 +145,7 @@ hPutStrLn h "" printValueAsJsonInPython :: FilePath -> IO ()-printValueAsJsonInPython path = do+printValueAsJsonInPython path = withFile path WriteMode $ \h -> do hPutStrLn h "# -*- coding: utf-8 -*-" hPutStrLn h "import json"@@ -145,14 +159,14 @@ printTypeAsSchema :: (Generic a, G.JSONSchemaGen a, SchemaName (Rep a)) => FilePath -> G.Options -> [A.Options] -> Proxy a -> IO ()-printTypeAsSchema dir opts aoptss a = do+printTypeAsSchema dir opts aoptss a = forM_ aoptss $ \aopts -> do let fa = fmap from a let filename = schemaName opts aopts fa let suffix = "." ++ schemaSuffix opts aopts fa let path = dir ++ "/" ++ filename let opts' = opts { G.schemaIdSuffix = suffix }- withFile path WriteMode $ \h -> do+ withFile path WriteMode $ \h -> BL.hPutStrLn h $ G.generate' opts' aopts a class SchemaName f where@@ -251,7 +265,7 @@ hPutStrLn h $ "mkValidator(" ++ "schema_" ++ schemaSymbol ++ ").validate(jsondata." ++ dataSymbol ++ ")" printValidatorInPython :: FilePath -> IO ()-printValidatorInPython path = do+printValidatorInPython path = withFile path WriteMode $ \h -> do hPutStrLn h "# -*- coding: utf-8 -*-" hPutStrLn h "import codecs"@@ -269,20 +283,12 @@ -- pythonProcess :: FilePath -> CreateProcess-pythonProcess dir =- CreateProcess- { cmdspec = RawCommand "python" [dir ++ "/jsonvalidator.py"]- , cwd = Nothing- , env = Nothing- , std_in = CreatePipe- , std_out = Inherit- , std_err = Inherit- , close_fds = False- , create_group = False+pythonProcess dir = (proc "python" [dir ++ "/jsonvalidator.py"])+ { std_in = CreatePipe #if MIN_VERSION_process(1,2,0)- , delegate_ctlc = True+ , delegate_ctlc = True #endif- }+ } runTest :: FilePath -> IO () runTest dir = do@@ -302,7 +308,7 @@ main = do let dir = "tests" printValueAsJsonInPython (dir ++ "/jsondata.py")- printTypeAsSchemaInJson (dir)+ printTypeAsSchemaInJson dir printValidatorInPython (dir ++ "/jsonvalidator.py") ec <- system "python --version" case ec of