summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMichalGajda <>2017-11-14 06:40:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-11-14 06:40:00 (GMT)
commitc15ad541b9c13cb0e22d84d52baf68171fc61741 (patch)
tree1f361db6635017541013d39d763817ec4a6093b6
parente211ff3a04a45aea09594879b3a59bc141fe2e11 (diff)
version 1.0.18HEAD1.0.18master
-rw-r--r--CommonCLI.hs18
-rw-r--r--GenerateJSONParser.hs9
-rw-r--r--GenerateTestJSON.hs4
-rw-r--r--changelog.md4
-rw-r--r--json-autotype.cabal56
-rw-r--r--test/TestExamples.hs54
-rw-r--r--test/TestQC.hs (renamed from TestQC.hs)0
7 files changed, 126 insertions, 19 deletions
diff --git a/CommonCLI.hs b/CommonCLI.hs
index 6b2587e..6b04843 100644
--- a/CommonCLI.hs
+++ b/CommonCLI.hs
@@ -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
@@ -20,3 +23,12 @@ tyOptParser = TyOptions
<*> 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)
+
diff --git a/GenerateJSONParser.hs b/GenerateJSONParser.hs
index cb94185..bcd9c29 100644
--- a/GenerateJSONParser.hs
+++ b/GenerateJSONParser.hs
@@ -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.FilePath (splitExtension)
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 @@ data Options = Options {
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 @@ generateHaskellFromJSONs opts inputFilenames outputFilename = do
-- 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 ()
diff --git a/GenerateTestJSON.hs b/GenerateTestJSON.hs
index 15ca065..abfff28 100644
--- a/GenerateTestJSON.hs
+++ b/GenerateTestJSON.hs
@@ -23,7 +23,7 @@ import qualified Data.ByteString.Lazy.Char8 as BSL
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 @@ generateTestJSONs Options {tyOpts=TyOptions {..}, ..}= do
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
diff --git a/changelog.md b/changelog.md
index 6acf3da..a45e95a 100644
--- a/changelog.md
+++ b/changelog.md
@@ -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.
diff --git a/json-autotype.cabal b/json-autotype.cabal
index 64b2b5b..ff2c896 100644
--- a/json-autotype.cabal
+++ b/json-autotype.cabal
@@ -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 @@ library
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 @@ executable json-autotype
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 @@ executable json-autotype
--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,12 +128,51 @@ executable json-autotype
-- 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
+ Data.Aeson.AutoType.Type
+ Data.Aeson.AutoType.Pretty
+ 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,
+ 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 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,
@@ -142,7 +181,7 @@ test-suite json-autotype-qc-test
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,
@@ -152,6 +191,7 @@ test-suite json-autotype-qc-test
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,
@@ -184,7 +224,7 @@ test-suite json-autotype-gen-test
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 @@ test-suite json-autotype-gen-test
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,
diff --git a/test/TestExamples.hs b/test/TestExamples.hs
new file mode 100644
index 0000000..cc33a9d
--- /dev/null
+++ b/test/TestExamples.hs
@@ -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
+
diff --git a/TestQC.hs b/test/TestQC.hs
index 2874ab9..2874ab9 100644
--- a/TestQC.hs
+++ b/test/TestQC.hs