json-autotype 1.0.17 → 1.0.18
raw patch · 8 files changed
+154/−47 lines, 8 filesdep ~basedep ~lensdep ~optparse-applicative
Dependency ranges changed: base, lens, optparse-applicative
Files
- CommonCLI.hs +15/−3
- GenerateJSONParser.hs +3/−6
- GenerateTestJSON.hs +2/−2
- TestQC.hs +0/−28
- changelog.md +4/−0
- json-autotype.cabal +48/−8
- test/TestExamples.hs +54/−0
- test/TestQC.hs +28/−0
CommonCLI.hs view
@@ -1,7 +1,10 @@-module CommonCLI(TypeOpts(..), unflag, tyOptParser) where+module CommonCLI(TypeOpts(..), unflag, tyOptParser, runghc) where -import Data.Monoid((<>))-import Options.Applicative+import Data.Monoid ((<>))+import Options.Applicative+import System.Process (system)+import qualified System.Environment (lookupEnv)+import System.Exit (ExitCode) data TypeOpts = TyOptions { autounify :: Bool@@ -19,4 +22,13 @@ <*> switch (long "debug" <> help "Set this flag to see more debugging info" ) <*> unflag (long "no-test" <> help "Do not run generated parser afterwards" ) <*> unflag (long "no-suggest" <> help "Do not suggest candidates for unification" )++runghc :: [String] -> IO ExitCode+runghc arguments = do+ maybeStack <- System.Environment.lookupEnv "STACK_EXEC"+ maybeCabal <- System.Environment.lookupEnv "CABAL_SANDBOX_CONFIG"+ let execPrefix | Just stackExec <- maybeStack = [stackExec, "exec", "--"]+ | Just cabalConfig <- maybeCabal = ["cabal", "exec", "--"]+ | otherwise = []+ system (unwords $ execPrefix ++ ["runghc"] ++ arguments)
GenerateJSONParser.hs view
@@ -1,8 +1,5 @@--- {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-}--- {-# LANGUAGE DeriveGeneric #-}--- {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main where@@ -19,7 +16,7 @@ import System.Process (system) import qualified Data.ByteString.Lazy.Char8 as BSL import qualified Data.HashMap.Strict as Map-import Data.Aeson --(Value(..), decode, encode, FromJSON(..), ToJSON(..))+import Data.Aeson(Value(..), decode, encode, FromJSON(..), ToJSON(..)) import qualified Data.Text as Text import qualified Data.Text.IO as Text import Data.Text (Text)@@ -59,7 +56,7 @@ optParser :: Parser Options optParser = Options <$> tyOptParser- <*> strOption (short 'o' <> long "output" <> value defaultOutputFilename)+ <*> strOption (short 'o' <> long "output" <> long "outputFilename" <> value defaultOutputFilename) <*> unflag (short 'n' <> long "no-typecheck" <> help "Do not typecheck after unification") <*> switch (long "yaml" <> help "Parse inputs as YAML instead of JSON" ) <*> switch (short 'p' <> long "preprocessor" <> help "Work as GHC preprocessor (and skip preprocessor pragma)" )@@ -153,7 +150,7 @@ -- We start by writing module header writeHaskellModule outputFilename unified when (test $ tyOpts opts) $- exitWith =<< system (unwords $ ["runghc", "-package=aeson", outputFilename] ++ passedTypeCheck)+ exitWith =<< runghc (outputFilename:passedTypeCheck) where -- | Works like @Debug.trace@ when the --debug flag is enabled, and does nothing otherwise. myTrace :: String -> IO ()
GenerateTestJSON.hs view
@@ -23,7 +23,7 @@ import qualified Data.HashMap.Strict as Map import qualified Data.Set as Set import Data.Monoid ((<>))-import Data.Aeson+import Data.Aeson (Value(..), decode, encode, FromJSON(..), ToJSON(..)) import Data.Function (on) import Data.List import qualified Data.Text as Text@@ -174,7 +174,7 @@ writeHaskellModule outputFilename unified if test then do- r <- (==ExitSuccess) <$> system (unwords ["runghc", "-package=aeson", outputFilename, inputFilename])+ r <- (==ExitSuccess) <$> runghc [outputFilename, inputFilename] when r $ mapM_ removeFile [inputFilename, outputFilename] return r else
− TestQC.hs
@@ -1,28 +0,0 @@--- | QuickCheck instances for automatically generating JSON inputs,--- and checking that json-autotype works correctly on these.-module Main(- main- ) where--import Control.Monad-import Data.Aeson-import Data.Aeson.AutoType.Extract-import Data.Aeson.AutoType.Test() -- Arbitrary instance for Value--import Test.QuickCheck-import Test.SmallCheck---import Test.QuickCheck.Arbitrary--prop_typeCheck :: Value -> Bool-prop_typeCheck v = v `typeCheck` extractType v---- | Maximum reasonable depth for quick exhaustive testing-depth = 5--main :: IO ()-main = do smallCheck depth prop_typeCheck- quickCheckWith myArgs prop_typeCheck- where- -- 17 - reasonable size for runghc- --myArgs i = stdArgs { maxSize=i }- myArgs = stdArgs { maxSize=17, maxSuccess=1000 }
changelog.md view
@@ -1,5 +1,9 @@ Changelog =========+ 1.0.18 Nov 2017+ * Fixed unit tests.+ * Fixed import for inclusion in Stackage.+ 1.0.17 Nov 2017 * Fixed build and test issues.
json-autotype.cabal view
@@ -1,6 +1,6 @@ -- Build information for the package. name: json-autotype-version: 1.0.17+version: 1.0.18 synopsis: Automatic type declaration for JSON input data description: Generates datatype declarations with Aeson's "FromJSON" instances from a set of example ".json" files.@@ -68,7 +68,7 @@ filepath >=1.3 && <1.5, hashable >=1.2 && <1.3, ---hint >=0.4 && <0.6,- optparse-applicative >=0.13 && <1.0,+ optparse-applicative >=0.11 && <1.0, lens >=4.1 && <4.16, --mmap >=0.5 && <0.6, mtl >=2.1 && <2.3,@@ -101,7 +101,7 @@ DeriveDataTypeable, DeriveGeneric, RecordWildCards- build-depends: base >=4.3 && <4.10,+ build-depends: base >=4.3 && <4.11, GenericPretty >=1.2 && <1.3, aeson >=0.7 && <1.3, bytestring >=0.9 && <0.11,@@ -111,7 +111,7 @@ --hint >=0.4 && <0.6, lens >=4.1 && <4.16, mtl >=2.1 && <2.3,- optparse-applicative >=0.13 && <1.0,+ optparse-applicative >=0.12 && <1.0, pretty >=1.1 && <1.3, process >=1.1 && <1.7, scientific >=0.3 && <0.5,@@ -128,7 +128,7 @@ -- and extracted types. test-suite json-autotype-qc-test type: exitcode-stdio-1.0- main-is: TestQC.hs+ main-is: test/TestQC.hs other-modules: Data.Aeson.AutoType.Util Data.Aeson.AutoType.Extract Data.Aeson.AutoType.Test@@ -142,7 +142,7 @@ DeriveDataTypeable, DeriveGeneric, RecordWildCards- build-depends: base >=4.3 && <4.10,+ build-depends: base >=4.3 && <4.11, GenericPretty >=1.2 && <1.3, aeson >=0.7 && <1.3, bytestring >=0.9 && <0.11,@@ -164,6 +164,46 @@ -- hs-source-dirs: default-language: Haskell2010 +test-suite json-autotype-examples+ type: exitcode-stdio-1.0+ main-is: test/TestExamples.hs+ other-modules: Data.Aeson.AutoType.Util+ Data.Aeson.AutoType.Extract+ Data.Aeson.AutoType.Test+ Data.Aeson.AutoType.Type+ Data.Aeson.AutoType.Pretty+ CommonCLI+ other-extensions: TemplateHaskell,+ ScopedTypeVariables,+ OverloadedStrings,+ FlexibleInstances,+ MultiParamTypeClasses,+ DeriveDataTypeable,+ DeriveGeneric,+ RecordWildCards+ build-depends: base >=4.3 && <4.11,+ GenericPretty >=1.2 && <1.3,+ aeson >=0.7 && <1.3,+ bytestring >=0.9 && <0.11,+ containers >=0.3 && <0.6,+ directory >=1.1 && <1.4,+ filepath >=1.3 && <1.5,+ hashable >=1.2 && <1.3,+ lens >=4.1 && <4.16,+ mtl >=2.1 && <2.3,+ optparse-applicative >=0.11 && <1.0,+ pretty >=1.1 && <1.3,+ process >=1.1 && <1.7,+ scientific >=0.3 && <0.5,+ smallcheck >=1.0 && <1.2,+ text >=1.1 && <1.4,+ uniplate >=1.6 && <1.7,+ unordered-containers >=0.2 && <0.3,+ vector >=0.9 && <0.13,+ QuickCheck >=2.4 && <3.0+ -- hs-source-dirs:+ default-language: Haskell2010+ -- Test suite with Haskell code generation and compilation test-suite json-autotype-gen-test type: exitcode-stdio-1.0@@ -184,7 +224,7 @@ DeriveDataTypeable, DeriveGeneric, RecordWildCards- build-depends: base >=4.3 && <4.10,+ build-depends: base >=4.3 && <4.11, GenericPretty >=1.2 && <1.3, aeson >=0.7 && <1.3, bytestring >=0.9 && <0.11,@@ -192,7 +232,7 @@ directory >=1.1 && <1.4, filepath >=1.3 && <1.5, hashable >=1.2 && <1.3,- optparse-applicative >=0.13 && <1.0,+ optparse-applicative >=0.12 && <1.0, lens >=4.1 && <4.16, mtl >=2.1 && <2.3, pretty >=1.1 && <1.3,
+ test/TestExamples.hs view
@@ -0,0 +1,54 @@+-- Test over all files in examples/ directory+module Main(main) where++import Control.Monad(forM)+import Data.Char(toUpper)+import Data.Functor ((<$>))+import Data.List(isPrefixOf, isSuffixOf)+import System.Directory(doesDirectoryExist, getDirectoryContents)+import System.FilePath(dropExtension, (</>), (<.>))+import System.Exit(exitSuccess, exitWith, ExitCode(..))++import CommonCLI++-- | <http://book.realworldhaskell.org/read/io-case-study-a-library-for-searching-the-filesystem.html>+getRecursiveContents :: FilePath -> IO [FilePath]+getRecursiveContents topdir = do+ ex<-doesDirectoryExist topdir+ if ex + then do+ names <- getDirectoryContents topdir+ let properNames = filter (not . isPrefixOf ".") names+ paths <- forM properNames $ \name -> do+ let path = topdir </> name+ isDirectory <- doesDirectoryExist path+ if isDirectory+ then getRecursiveContents path+ else return [path]+ return (concat paths) + else return []++capitalize :: String -> String+capitalize (s:ss) = toUpper s:ss++main :: IO ()+main = do+ filenames <- filter (isSuffixOf ".json")+ <$> getRecursiveContents "examples"+ results <- forM filenames $ \filename -> do+ let outputFilename = capitalize (dropExtension filename) <.> "hs"+ genResult <- runghc ["GenerateJSONParser.hs", filename, "--outputFilename", outputFilename]+ return 0+ if genResult == ExitSuccess+ then return 0 -- number of failures so far+ else do+ parserResult <- runghc [outputFilename, filename]+ if parserResult == ExitSuccess+ then return 0+ else return 1+ exitCode $ sum results++exitCode :: Int -> IO ()+exitCode 0 = exitSuccess+exitCode n = exitWith $ ExitFailure n+
+ test/TestQC.hs view
@@ -0,0 +1,28 @@+-- | QuickCheck instances for automatically generating JSON inputs,+-- and checking that json-autotype works correctly on these.+module Main(+ main+ ) where++import Control.Monad+import Data.Aeson+import Data.Aeson.AutoType.Extract+import Data.Aeson.AutoType.Test() -- Arbitrary instance for Value++import Test.QuickCheck+import Test.SmallCheck+--import Test.QuickCheck.Arbitrary++prop_typeCheck :: Value -> Bool+prop_typeCheck v = v `typeCheck` extractType v++-- | Maximum reasonable depth for quick exhaustive testing+depth = 5++main :: IO ()+main = do smallCheck depth prop_typeCheck+ quickCheckWith myArgs prop_typeCheck+ where+ -- 17 - reasonable size for runghc+ --myArgs i = stdArgs { maxSize=i }+ myArgs = stdArgs { maxSize=17, maxSuccess=1000 }