tasty-integrate (empty) → 0.0.1
raw patch · 6 files changed
+430/−0 lines, 6 filesdep +QuickCheckdep +aesondep +basesetup-changed
Dependencies added: QuickCheck, aeson, base, bytestring, cmdargs, containers, deepseq, directory, either, haskell-src-exts, language-haskell-extract, lens, mtl, parsec, quickcheck-property-comb, regex-posix, split, stm, stringbuilder, system-filepath, tasty, tasty-quickcheck, text, transformers, unix
Files
- LICENSE +22/−0
- Setup.hs +2/−0
- ide-format/Main.hs +99/−0
- src/Main.hs +180/−0
- tasty-integrate.cabal +102/−0
- test-suites/Suite.hs +25/−0
+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2012-2014, John P. Feltz <jfeltz@gmail.com> +All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met: ++1. Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution. ++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ ide-format/Main.hs view
@@ -0,0 +1,99 @@+-- TODO verbosity options+-- FIXME atm this parser is VERY brittle, please email me if there are any+-- issues -J+module Main where+import System.IO+import System.Posix.IO+import Data.List+import Data.Either+import Text.Parsec.String (Parser)+import Prelude hiding (fail)+import Control.Applicative ((<*>),(<$>))+import Data.String.Indent (indent)++import Text.Parsec.Prim (parse, try, (<|>), many)+import Text.Parsec.Combinator (optionMaybe, count, many1, choice)+import Text.Parsec.Char (alphaNum, char, string, noneOf)+import Text.Parsec.Extra ( natural, eol, whitespace )+import qualified Filesystem.Path.CurrentOS as FS+import Prelude hiding (FilePath)++data Success = Success { successMsg :: String } deriving Show+data Failure = Failure { line :: Int, failureMsg :: String } deriving Show+data Test = Test { test :: String, result :: Either Failure Success }+ deriving Show+data File = File { filepath :: FS.FilePath, tests :: [Test] } deriving Show++fromResult :: FS.FilePath -> Test -> String+fromResult fp (Test t (Left (Failure l msg))) =+ FS.encodeString fp ++ '|':show l ++ " error | " ++ t ++ '\n':indent 1 msg+fromResult _ (Test t (Right (Success msg))) =+ t ++ "\n " ++ msg++fromFile :: File -> String+fromFile f =+ let (failures, successes) = partition failed (tests f) in+ (++) (intercalate "\n" $ map toString failures)+ ('\n': fromSuccesses successes)+ where+ failed :: Test -> Bool+ failed (Test _ (Left (Failure _ _))) = True+ failed (Test _ (Right (Success _))) = False++ toString :: Test -> String+ toString = fromResult (filepath f)++ fromSuccesses :: [Test] -> String+ fromSuccesses [] = []+ fromSuccesses list = FS.encodeString (filepath f) ++ " successes: \n" +++ indent 2 (concatMap toString list)++pathLine :: Parser FS.FilePath+pathLine = do+ count 2 whitespace+ non_ext <- many1 $ noneOf ".\SP\n\r"+ ext <- string ".hs"+ eol+ return . FS.decodeString $ non_ext ++ ext++messages :: Parser [String]+messages = do+ count 6 whitespace+ content <- many $ noneOf "\n\r"+ many1 eol+ rest <- optionMaybe (try messages)+ return $ maybe [content] (content:) rest++testP :: Parser Test+testP = do+ count 4 whitespace+ l <- natural+ char ':'+ whitespace+ string "prop_"+ prop_name <- many1 (alphaNum <|> char '_')+ char ':'+ many1 whitespace ; f <- status prop_name l ; eol+ f . unlines <$> messages+ where+ status :: String -> Int -> Parser (String -> Test)+ status prop_name l = do+ lit <- choice $ map string ["OK", "FAIL"]+ return $+ Test prop_name .+ if lit == "OK" then Right . Success else Left . Failure l++parser :: Parser [File]+parser = do+ string "modules"+ eol+ many1 (File <$> pathLine <*> many1 (try testP))++parseResults :: String -> String+parseResults runner_output =+ case parse parser "tasty consoleRunner output" runner_output of+ Left errors -> show errors+ Right files -> (intercalate "\n" . map fromFile $ files) ++ "\n"++main :: IO ()+main = fdToHandle stdInput >>= hGetContents >>= putStr . parseResults
+ src/Main.hs view
@@ -0,0 +1,180 @@+-- FIXME reconcile issues with reports+{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans -fno-warn-unused-binds -fno-warn-unused-do-bind #-}+{-# LANGUAGE DeriveDataTypeable #-}++import System.Console.CmdArgs hiding (ignore)+import System.Environment+import Control.Monad.Trans.Either++import Control.Monad.IO.Class++import qualified System.Console.CmdArgs.Explicit as Exp+import qualified Data.List as L+import qualified Data.Suite as S++import qualified Data.Integrated as I+import qualified Data.Integrated.IOState as IOS+import Control.Monad.State+import Control.Lens+import qualified Filesystem.Path.CurrentOS as FS+import Prelude hiding (FilePath)+import Data.Aeson hiding (json)+import Data.AesonData+import Data.Suite.Ops+import Data.Integrated.TestModule (Map)+import qualified Data.Map as M+import Data.ModulePath+import Data.Property+import Data.String.Indent+import qualified Data.Suite as Su+import qualified Data.ByteString.Lazy.Char8 as BS++data Args =+ Args {+ json :: Maybe String,+ masking :: Bool,+ ignore :: Bool,+ suite :: String,+ tests :: [String]+ } deriving (Show, Data, Typeable)++integration =+ let+ description =+ "This program set-combines quickcheck property-containing modules with "+ ++ "an IDE parsable test harness."+ in+ Args {+ json =+ def+ -- &= typ "json file path"+ &= help "generate a report of operations on the target suite in JSON"+ &= opt ""+ , masking =+ def &= help "keep existing tests in suite not part of sync"+ , ignore =+ def &= help "ignore test file parse failures (only parsed will be set-combined)"+ , suite =+ def &= typ "<suite file path>" &= argPos 0+ , tests =+ [] &= args &= typ "files/dirs"+ } &= help "The tasty suite file integrator"+ &= program "tasty-integrate"+ &= summary "tasty-integrate v0.0 (C) John P. Feltz"+ &= details [description]+ &= verbosity++fromArgs :: Args -> EitherT String IO I.Integrated+fromArgs a =+ if (L.null . tests) a then+ left "no tests provided"+ else do+ fs_state <- liftIO $ IOS.toState (tests a) (suite a)+ integrated <-+ liftIO $ do+ (maybe_integrated, errors) <- runStateT (ranState fs_state) []+ putStr $ L.intercalate "\n" $ map show errors+ return maybe_integrated+ maybe (left "\n\nHalted due to errors.") right integrated+ where+ fromIgnore :: Bool -> I.ErrorObservance+ fromIgnore True = I.Ignored+ fromIgnore _ = I.Dependent++ ranState = I.toIntegrated (fromIgnore $ ignore a) (masking a)++fromIntegrated :: Maybe Verbosity -> Maybe String -> I.Integrated -> IO ()+fromIntegrated v j i = do+ ops <- I.fromIntegrated (S.toBuf S.tastyImports) i+ let (suite_fp, original_suite) = view I.suiteFile i+ -- Print the summary+ putStrLn ('\n': toSummary original_suite suite_fp ops v)+ -- Write json to console or fileput if necessary+ maybe (return ()) (writeJson suite_fp ops) j+ where+ writeJson :: FS.FilePath -> Ops -> String -> IO ()+ writeJson suite_fp ops p =+ if L.null p then putStr "\n" >> putStrLn encoded else writeFile p encoded+ where+ encoded :: String+ encoded = BS.unpack . encode $ AesonData ops suite_fp++fromProps :: [Property] -> String+fromProps [] = "none"+fromProps non_empty = L.intercalate "\n" . map func $ non_empty++toModuleListing :: Map -> String+toModuleListing m =+ if M.null m then " none" else+ L.intercalate "\n" . map (uncurry fromMod) . M.toList . M.map snd $ m+ where+ fromMod :: ModulePath -> [Property] -> String+ fromMod mp props = show mp ++ '\n':indent 1 (fromProps props)++toNumericListing :: Map -> String+toNumericListing m =+ if M.null m then+ "none"+ else+ indent 1+ (L.intercalate "\n" . map (uncurry fromMod) . M.toList . M.map snd $ m)+ where+ fromMod :: ModulePath -> [Property] -> String+ fromMod mp props =+ show mp ++ ", " ++ (show . L.length $ props) ++ " property(s)"++toSummary :: Su.Suite -> FS.FilePath -> Ops -> Maybe Verbosity -> String+toSummary _ _ _ (Just Quiet) = ""+toSummary s fp ops (Just Loud) = fromOriginal toModuleListing s fp ops ++ "\n"+toSummary s fp ops _ = fromOriginal toNumericListing s fp ops ++ "\n"++fromOps :: (Map -> String) -> Ops -> String+fromOps f ops =+ L.intercalate "\n" $+ map (\(label, l) -> label ++ ": \n" ++ indent 1 (f . view l $ ops)) [+ ("added", added),+ ("removed", removed),+ ("modified", modified),+ ("unmodified", unmodified)+ ]++fromOriginal :: (Map -> String) -> Su.Suite -> FS.FilePath -> Ops -> String+fromOriginal f Su.Uncreated suite_fp ops =+ if not . M.null $ view added ops then+ "(created) suite at: " ++ FS.encodeString suite_fp ++ "\n"+ ++ "with: \n" ++ indent 1 (f (view added ops))+ else+ "no suite created"+fromOriginal f (Su.Suite _) suite_fp ops =+ if mutation then+ "(changed) suite at: " ++ FS.encodeString suite_fp ++ "\n"+ ++ "with: \n" ++ indent 1 (fromOps f ops)+ else+ "(unchanged) suite at: " ++ FS.encodeString suite_fp+ where+ mutation =+ any (not . M.null . ($ ops) . view) [added, removed, modified]++main :: IO ()+main = do+ env_args <- getArgs++ case Exp.process (cmdArgsMode integration) env_args of+ Right parsed_args ->+ case cmdArgsHelp parsed_args of+ (Just h) -> putStr h+ Nothing ->+ let+ program_args = cmdArgsValue parsed_args+ v = cmdArgsVerbosity parsed_args+ in do+ result <- runEitherT . fromArgs $ program_args+ case result of+ Left e ->+ dispatchHelp e+ Right i ->+ fromIntegrated v (json program_args) i+ Left err -> dispatchHelp err+ where+ dispatchHelp :: String -> IO ()+ dispatchHelp err = putStr $ err ++ "\n " ++ "(--help for assistance)\n"
+ tasty-integrate.cabal view
@@ -0,0 +1,102 @@+name: tasty-integrate +version: 0.0.1+license: BSD3+license-file: LICENSE+author: John P. Feltz+maintainer: jfeltz@gmail.com+category: Testing+build-type: Simple+cabal-version: >=1.8+synopsis: automated integration of QuickCheck properties into tasty suites +description: + This brings automated test-suite creation (such as what naturally+ occurs in Eclipse) to the Haskell world. This is a set of programs to automate+ the otherwise manual editing needed to combine new tests (QuickCheck) into+ test-groupings (tasty test framework).+ .+ Given a set of Modules containing properties:+ .+ > $ ls tests/Data/*+ > QcIntegrated.hs QcModulePath.hs QcSuite.hs+ .+ Example use on a suite already importing the Modules above:+ .+ > $ tasty-integrate --masking test-suites/Suites.hs tests/Data/QcIntegrated.hs+ > (changed) suite at: test-suites/Suite.hs+ > with: + > added: + > none+ > removed: + > Data.QcModulePath, 2 property(s)+ > Data.QcSuite, 1 property(s)+ > modified: + > none+ > unmodified: + > Data.QcIntegrated, 3 property(s)+ .+ The created suites are IDE parsable, and errors can resolve to their original file.+ So using the provided ide-format program from this package:+ . + > $ ./build/dist/suite/suite | ide-format + > tests/Data/QcSuite.hs|20 error | buf_isomorphism+ > *** Failed! Falsifiable (after 1 test): ++executable ide-format+ main-is: Main.hs+ build-depends: base >=4.5 && <=4.6.0.1, + unix,+ parsec >= 3.1.5,+ system-filepath >= 0.4.9,+ text+ hs-source-dirs: ide-format, src++executable tasty-integrate+ main-is: Main.hs + build-depends: base >=4.5 && <=4.6.0.1, + containers,+ transformers,+ directory,+ cmdargs == 0.10.2,+ system-filepath >= 0.4.6,+ language-haskell-extract,+ haskell-src-exts,+ regex-posix,+ split,+ mtl,+ text,+ either,+ lens,+ aeson == 0.6.2.1,+ bytestring == 0.10.2.0,+ tasty == 0.7,+ tasty-quickcheck++ ghc-options: -Wall -rtsopts+ hs-source-dirs: src++test-suite suite + type: exitcode-stdio-1.0+ buildable: True+ build-depends: base >=4.5 && <=4.6.0.1, + deepseq == 1.3.0.1,+ stm == 2.4.2,+ QuickCheck == 2.6, + tasty == 0.7,+ tasty-quickcheck,+ containers,+ transformers,+ directory,+ system-filepath >= 0.4.6,+ quickcheck-property-comb,+ stringbuilder,+ lens,+ mtl,+ split,+ text,+ regex-posix,+ haskell-src-exts,+ bytestring == 0.10.2.0+ + ghc-options: -Wall -rtsopts -fno-warn-unused-do-bind+ hs-source-dirs: tests, src, test-suites+ main-is: Suite.hs
+ test-suites/Suite.hs view
@@ -0,0 +1,25 @@+-- WARNING: This file is generated by tasty-integrate+-- Changes made will (probably) not be saved, see documentation.+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+module Main where+import qualified Data.QcIntegrated+ (prop_toPartition, prop_fromPartition,+ prop_fromTestpath_isomorphism)+import qualified Data.QcSuite (prop_buf_isomorphism)+import Test.Tasty+import Test.Tasty.QuickCheck+ +main :: IO ()+main+ = defaultMain+ (testGroup "modules"+ [testGroup "tests/Data/QcIntegrated.hs"+ [testProperty "42: prop_toPartition"+ Data.QcIntegrated.prop_toPartition,+ testProperty "186: prop_fromPartition"+ Data.QcIntegrated.prop_fromPartition,+ testProperty "429: prop_fromTestpath_isomorphism"+ Data.QcIntegrated.prop_fromTestpath_isomorphism],+ testGroup "tests/Data/QcSuite.hs"+ [testProperty "20: prop_buf_isomorphism"+ Data.QcSuite.prop_buf_isomorphism]])