From 2c1f7ca1a856d8a8dd839abda51fc5efa5ce9512 Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 16 Feb 2019 15:57:16 -0700 Subject: [PATCH 01/36] add gitignore --- .gitignore | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 .gitignore diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..fa9c82d --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +dist +dist-* +.ghc.* From 3b79c7ca13266646b7b08420fe38961fdd44fa50 Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 16 Feb 2019 15:57:27 -0700 Subject: [PATCH 02/36] add cabal project file --- cabal.project | 1 + 1 file changed, 1 insertion(+) create mode 100644 cabal.project diff --git a/cabal.project b/cabal.project new file mode 100644 index 0000000..03afc6f --- /dev/null +++ b/cabal.project @@ -0,0 +1 @@ +packages: chell/, chell-hunit/, chell-quickcheck/ From 790574002a76caf7ca32ee900d60b9e2c59dc5d9 Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 16 Feb 2019 15:57:41 -0700 Subject: [PATCH 03/36] add stack.yaml --- stack.yaml | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 stack.yaml diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..bf68b6b --- /dev/null +++ b/stack.yaml @@ -0,0 +1,3 @@ +resolver: "lts-13.7" +packages: [chell, chell-hunit, chell-quickcheck] +extra-deps: [patience-0.2.1.0] From a37f10d5b7a60d2ecc4b1b6bb567887fda4ad017 Mon Sep 17 00:00:00 2001 From: Felix Yan Date: Mon, 21 Jan 2019 01:15:45 +0800 Subject: [PATCH 04/36] Fix compatibility with QuickCheck 2.12 --- chell-quickcheck/Test/Chell/QuickCheck.hs | 12 ++++++++++++ chell-quickcheck/chell-quickcheck.cabal | 2 +- 2 files changed, 13 insertions(+), 1 deletion(-) diff --git a/chell-quickcheck/Test/Chell/QuickCheck.hs b/chell-quickcheck/Test/Chell/QuickCheck.hs index 0ec25b0..aaf35fb 100644 --- a/chell-quickcheck/Test/Chell/QuickCheck.hs +++ b/chell-quickcheck/Test/Chell/QuickCheck.hs @@ -53,8 +53,16 @@ property name prop = Chell.test name $ \opts -> do , State.computeSize = computeSize (QuickCheck.maxSize args) (QuickCheck.maxSuccess args) , State.numSuccessTests = 0 , State.numDiscardedTests = 0 +#if MIN_VERSION_QuickCheck(2,12,0) + , State.classes = mempty + , State.tables = mempty + , State.requiredCoverage = mempty + , State.expected = True + , State.coverageConfidence = Nothing +#else , State.collected = [] , State.expectedFailure = False +#endif #if MIN_VERSION_QuickCheck(2,7,0) , State.randomSeed = QCRandom.mkQCGen seed @@ -77,12 +85,16 @@ property name prop = Chell.test name $ \opts -> do #endif } +#if MIN_VERSION_QuickCheck(2,12,0) + result <- Test.test state (QuickCheck.property prop) +#else #if MIN_VERSION_QuickCheck(2,7,0) let genProp = unProperty (QuickCheck.property prop) #else let genProp = QuickCheck.property prop #endif result <- Test.test state (Gen.unGen genProp) +#endif let output = Test.output result let notes = [("seed", show seed)] let failure = Chell.failure { Chell.failureMessage = output } diff --git a/chell-quickcheck/chell-quickcheck.cabal b/chell-quickcheck/chell-quickcheck.cabal index 5b5482c..673363e 100644 --- a/chell-quickcheck/chell-quickcheck.cabal +++ b/chell-quickcheck/chell-quickcheck.cabal @@ -27,7 +27,7 @@ library build-depends: base >= 4.0 && < 5.0 , chell >= 0.3 && < 0.5 - , QuickCheck >= 2.3 && < 2.11 + , QuickCheck >= 2.3 && < 2.13 , random exposed-modules: From 957ec6343faa4a567f36dba75aee5b1aea0a412b Mon Sep 17 00:00:00 2001 From: Felix Yan Date: Tue, 4 Dec 2018 16:21:48 +0800 Subject: [PATCH 05/36] Migrade to patience 0.2 (#1) --- chell/Test/Chell.hs | 3 ++- chell/chell.cabal | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/chell/Test/Chell.hs b/chell/Test/Chell.hs index 5a28259..d02e24a 100644 --- a/chell/Test/Chell.hs +++ b/chell/Test/Chell.hs @@ -123,7 +123,6 @@ import qualified Control.Exception import Control.Exception (Exception) import Control.Monad (ap, liftM) import Control.Monad.IO.Class (MonadIO, liftIO) -import qualified Data.Algorithm.Patience as Patience import qualified Data.ByteString.Char8 import qualified Data.ByteString.Lazy.Char8 import Data.Foldable (Foldable, foldMap) @@ -136,6 +135,8 @@ import qualified Data.Text.Lazy import qualified Language.Haskell.TH as TH +import qualified Patience + import Test.Chell.Main (defaultMain) import Test.Chell.Types diff --git a/chell/chell.cabal b/chell/chell.cabal index b2df441..126975c 100644 --- a/chell/chell.cabal +++ b/chell/chell.cabal @@ -69,7 +69,7 @@ library base >= 4.1 && < 5.0 , bytestring >= 0.9 , options >= 1.0 && < 2.0 - , patience >= 0.1 && < 0.2 + , patience >= 0.2 && < 0.3 , random >= 1.0 , template-haskell >= 2.3 , text From 81c0fb3ac130f094d2d386f93709327d621cb9b7 Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 16 Feb 2019 16:01:27 -0700 Subject: [PATCH 06/36] raise ansi-terminal upper bound --- chell/chell.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/chell/chell.cabal b/chell/chell.cabal index 126975c..ea5fc22 100644 --- a/chell/chell.cabal +++ b/chell/chell.cabal @@ -77,7 +77,7 @@ library if flag(color-output) build-depends: - ansi-terminal >= 0.5 && < 0.8 + ansi-terminal >= 0.5 && < 0.9 exposed-modules: Test.Chell From 772031de01e6c52483b79e11a2de05ef6a47586b Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 16 Feb 2019 16:02:49 -0700 Subject: [PATCH 07/36] upgrade HUnit --- chell-hunit/Test/Chell/HUnit.hs | 10 +++++----- chell-hunit/chell-hunit.cabal | 2 +- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/chell-hunit/Test/Chell/HUnit.hs b/chell-hunit/Test/Chell/HUnit.hs index bcb5880..5270abc 100644 --- a/chell-hunit/Test/Chell/HUnit.hs +++ b/chell-hunit/Test/Chell/HUnit.hs @@ -3,7 +3,7 @@ module Test.Chell.HUnit ) where import qualified Test.Chell as Chell -import Test.HUnit.Lang (Assertion, performTestCase) +import Test.HUnit.Lang (Assertion, Result (..), performTestCase) -- | Convert a sequence of HUnit assertions (embedded in IO) to a Chell -- 'Chell.Test'. @@ -23,7 +23,7 @@ hunit name io = Chell.test name chell_io where chell_io _ = do result <- performTestCase io return $ case result of - Nothing -> Chell.TestPassed [] - Just err -> parseError err - parseError (True, msg) = Chell.TestFailed [] [Chell.failure { Chell.failureMessage = msg }] - parseError (False, msg) = Chell.TestAborted [] msg + Success -> Chell.TestPassed [] + Failure _ msg -> Chell.TestFailed [] + [Chell.failure { Chell.failureMessage = msg }] + Error _ msg -> Chell.TestAborted [] msg diff --git a/chell-hunit/chell-hunit.cabal b/chell-hunit/chell-hunit.cabal index 80e0b6e..99edf85 100644 --- a/chell-hunit/chell-hunit.cabal +++ b/chell-hunit/chell-hunit.cabal @@ -27,7 +27,7 @@ library build-depends: base >= 4.0 && < 5.0 , chell >= 0.3 && < 0.5 - , HUnit >= 1.1 && < 1.3 + , HUnit >= 1.3 && < 1.7 exposed-modules: Test.Chell.HUnit From 54b3f0766c19c44ede5389750655ee971ac20b03 Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 16 Feb 2019 16:21:14 -0700 Subject: [PATCH 08/36] remove trailing spaces --- chell-quickcheck/Test/Chell/QuickCheck.hs | 6 +-- chell/Test/Chell.hs | 40 ++++++++++---------- chell/Test/Chell/Main.hs | 46 +++++++++++------------ chell/Test/Chell/Output.hs | 4 +- chell/Test/Chell/Types.hs | 44 +++++++++++----------- 5 files changed, 70 insertions(+), 70 deletions(-) diff --git a/chell-quickcheck/Test/Chell/QuickCheck.hs b/chell-quickcheck/Test/Chell/QuickCheck.hs index aaf35fb..16a7720 100644 --- a/chell-quickcheck/Test/Chell/QuickCheck.hs +++ b/chell-quickcheck/Test/Chell/QuickCheck.hs @@ -37,9 +37,9 @@ property name prop = Chell.test name $ \opts -> property name prop = Chell.test name $ \opts -> do term <- Text.newNullTerminal #endif - + let seed = Chell.testOptionSeed opts - + let args = QuickCheck.stdArgs let state = State.MkState { State.terminal = term @@ -84,7 +84,7 @@ property name prop = Chell.test name $ \opts -> do , State.numTotMaxShrinks = QuickCheck.maxShrinks args #endif } - + #if MIN_VERSION_QuickCheck(2,12,0) result <- Test.test state (QuickCheck.property prop) #else diff --git a/chell/Test/Chell.hs b/chell/Test/Chell.hs index d02e24a..315e7a6 100644 --- a/chell/Test/Chell.hs +++ b/chell/Test/Chell.hs @@ -38,21 +38,21 @@ -- >PASS: 2 tests run, 2 tests passed module Test.Chell ( - + -- * Main defaultMain - + -- * Test suites , Suite , suite , suiteName , suiteTests - + -- ** Skipping some tests , SuiteOrTest , skipIf , skipWhen - + -- * Basic testing library , Assertions , assertions @@ -68,7 +68,7 @@ module Test.Chell , afterTest , requireLeft , requireRight - + -- ** Built-in assertions , equal , notEqual @@ -88,29 +88,29 @@ module Test.Chell , IsText , equalLines , equalLinesWith - + -- * Custom test types , Test , test , testName , runTest - + -- ** Test results , TestResult (..) - + -- *** Failures , Failure , failure , failureLocation , failureMessage - + -- *** Failure locations , Location , location , locationFile , locationModule , locationLine - + -- ** Test options , TestOptions , defaultTestOptions @@ -207,9 +207,9 @@ assertions :: String -> Assertions a -> Test assertions name testm = test name $ \opts -> do noteRef <- newIORef [] afterTestRef <- newIORef [] - + let getNotes = fmap reverse (readIORef noteRef) - + let getResult = do res <- unAssertions testm (noteRef, afterTestRef, []) case res of @@ -219,7 +219,7 @@ assertions name testm = test name $ \opts -> do (_, (_, _, fs)) -> do notes <- getNotes return (TestFailed notes (reverse fs)) - + Control.Exception.finally (handleJankyIO opts getResult getNotes) (runAfterTest afterTestRef) @@ -414,7 +414,7 @@ notEqual x y = assertBool (x /= y) ("notEqual: " ++ show x ++ " is equal to " ++ equalWithin :: (Real a, Show a) => a -> a -> a -- ^ delta -> Assertion -equalWithin x y delta = assertBool +equalWithin x y delta = assertBool ((x - delta <= y) && (x + delta >= y)) ("equalWithin: " ++ show x ++ " is not within " ++ show delta ++ " of " ++ show y) @@ -498,15 +498,15 @@ equalDiff' label norm x y = checkDiff (items x) (items y) where items = norm . foldMap (:[]) checkDiff xs ys = case checkItems (Patience.diff xs ys) of (same, diff) -> assertBool same diff - + checkItems diffItems = case foldl' checkItem (True, []) diffItems of (same, diff) -> (same, errorMsg (intercalate "\n" (reverse diff))) - + checkItem (same, acc) item = case item of Patience.Old t -> (False, ("\t- " ++ show t) : acc) Patience.New t -> (False, ("\t+ " ++ show t) : acc) Patience.Both t _-> (same, ("\t " ++ show t) : acc) - + errorMsg diff = label ++ ": items differ\n" ++ diff -- | Class for types which can be treated as text; see 'equalLines'. @@ -551,13 +551,13 @@ checkLinesDiff :: (Ord a, IsText a) => String -> [a] -> [a] -> Assertion checkLinesDiff label = go where go xs ys = case checkItems (Patience.diff xs ys) of (same, diff) -> assertBool same diff - + checkItems diffItems = case foldl' checkItem (True, []) diffItems of (same, diff) -> (same, errorMsg (intercalate "\n" (reverse diff))) - + checkItem (same, acc) item = case item of Patience.Old t -> (False, ("\t- " ++ unpack t) : acc) Patience.New t -> (False, ("\t+ " ++ unpack t) : acc) Patience.Both t _-> (same, ("\t " ++ unpack t) : acc) - + errorMsg diff = label ++ ": lines differ\n" ++ diff diff --git a/chell/Test/Chell/Main.hs b/chell/Test/Chell/Main.hs index 328db5b..901db5d 100644 --- a/chell/Test/Chell/Main.hs +++ b/chell/Test/Chell/Main.hs @@ -49,20 +49,20 @@ instance Options MainOptions where , optionDefault = False , optionDescription = "Print more output." }) - + <*> simpleOption "xml-report" "" "Write a parsable report to a given path, in XML." <*> simpleOption "json-report" "" "Write a parsable report to a given path, in JSON." <*> simpleOption "text-report" "" "Write a human-readable report to a given path." - + <*> simpleOption "seed" Nothing "The seed used for random numbers in (for example) quickcheck." - + <*> simpleOption "timeout" Nothing "The maximum duration of a test, in milliseconds." - + <*> defineOption optionType_ColorMode (\o -> o { optionLongFlags = ["color"] , optionDefault = ColorModeAuto @@ -88,13 +88,13 @@ defaultMain suites = runCommand $ \opts args -> do { testOptionSeed = seed , testOptionTimeout = timeout } - + -- find which tests to run let allTests = concatMap suiteTests suites let tests = if null args then allTests else filter (matchesFilter args) allTests - + -- output mode output <- case optColor opts of ColorModeNever -> return (plainOutput (optVerbose opts)) @@ -104,14 +104,14 @@ defaultMain suites = runCommand $ \opts args -> do return $ if isTerm then colorOutput (optVerbose opts) else plainOutput (optVerbose opts) - + -- run tests results <- forM tests $ \t -> do outputStart output t result <- runTest t testOptions outputResult output t result return (t, result) - + -- generate reports let reports = getReports opts forM_ reports $ \(path, fmt, toText) -> @@ -119,11 +119,11 @@ defaultMain suites = runCommand $ \opts args -> do when (optVerbose opts) $ do putStrLn ("Writing " ++ fmt ++ " report to " ++ show path) hPutStr h (toText results) - + let stats = resultStatistics results let (_, _, failed, aborted) = stats putStrLn (formatResultStatistics stats) - + if failed == 0 && aborted == 0 then exitSuccess else exitFailure @@ -150,12 +150,12 @@ getReports opts = concat [xml, json, text] where jsonReport :: [(Test, TestResult)] -> String jsonReport results = Writer.execWriter writer where tell = Writer.tell - + writer = do tell "{\"test-runs\": [" commas results tellResult tell "]}" - + tellResult (t, result) = case result of TestPassed notes -> do tell "{\"test\": \"" @@ -201,13 +201,13 @@ jsonReport results = Writer.execWriter writer where tellNotes notes tell "}" _ -> return () - + escapeJSON = concatMap (\c -> case c of '"' -> "\\\"" '\\' -> "\\\\" _ | ord c <= 0x1F -> printf "\\u%04X" (ord c) _ -> [c]) - + tellNotes notes = do tell ", \"notes\": [" commas notes $ \(key, value) -> do @@ -217,7 +217,7 @@ jsonReport results = Writer.execWriter writer where tell (escapeJSON value) tell "\"}" tell "]" - + commas xs block = State.evalStateT (commaState xs block) False commaState xs block = forM_ xs $ \x -> do let tell' = lift . Writer.tell @@ -231,13 +231,13 @@ jsonReport results = Writer.execWriter writer where xmlReport :: [(Test, TestResult)] -> String xmlReport results = Writer.execWriter writer where tell = Writer.tell - + writer = do tell "\n" tell "\n" mapM_ tellResult results tell "" - + tellResult (t, result) = case result of TestPassed notes -> do tell "\t "&" '<' -> "<" @@ -291,7 +291,7 @@ xmlReport results = Writer.execWriter writer where '"' -> """ '\'' -> "'" _ -> [c]) - + tellNotes notes = forM_ notes $ \(key, value) -> do tell "\t\t String textReport results = Writer.execWriter writer where tell = Writer.tell - + writer = do forM_ results tellResult let stats = resultStatistics results tell (formatResultStatistics stats) - + tellResult (t, result) = case result of TestPassed notes -> do tell (replicate 70 '=') @@ -357,7 +357,7 @@ textReport results = Writer.execWriter writer where tell msg tell "\n\n" _ -> return () - + tellNotes notes = forM_ notes $ \(key, value) -> do tell key tell "=" @@ -374,7 +374,7 @@ formatResultStatistics stats = Writer.execWriter writer where let putNum comma n what = Writer.tell $ if n == 1 then comma ++ "1 test " ++ what else comma ++ show n ++ " tests " ++ what - + let total = sum [passed, skipped, failed, aborted] putNum "" total "run" (putNum ", " passed "passed") diff --git a/chell/Test/Chell/Output.hs b/chell/Test/Chell/Output.hs index fef676a..5e56d2c 100644 --- a/chell/Test/Chell/Output.hs +++ b/chell/Test/Chell/Output.hs @@ -4,9 +4,9 @@ module Test.Chell.Output ( Output , outputStart , outputResult - + , ColorMode(..) - + , plainOutput , colorOutput ) where diff --git a/chell/Test/Chell/Types.hs b/chell/Test/Chell/Types.hs index fb16f07..991ce28 100644 --- a/chell/Test/Chell/Types.hs +++ b/chell/Test/Chell/Types.hs @@ -2,36 +2,36 @@ module Test.Chell.Types ( Test , test , testName - + , TestOptions , defaultTestOptions , testOptionSeed , testOptionTimeout - + , TestResult(TestPassed, TestSkipped, TestFailed, TestAborted) - + , Failure , failure , failureLocation , failureMessage - + , Location , location , locationFile , locationModule , locationLine - + , Suite , suite , suiteName , suiteTests - + , SuiteOrTest , skipIf , skipWhen - + , runTest - + , handleJankyIO ) where @@ -58,7 +58,7 @@ testName (Test name _) = name -- test should be run. data TestOptions = TestOptions { - + -- | Get the RNG seed for this test run. The seed is generated once, in -- 'defaultMain', and used for all tests. It is also logged to reports -- using a note. @@ -69,7 +69,7 @@ data TestOptions = TestOptions -- 'testOptionSeed' is a field accessor, and can be used to update -- a 'TestOptions' value. testOptionSeed :: Int - + -- | An optional timeout, in millseconds. Tests which run longer than -- this timeout will be aborted. -- @@ -106,18 +106,18 @@ defaultTestOptions = TestOptions data TestResult -- | The test passed, and generated the given notes. = TestPassed [(String, String)] - + -- | The test did not run, because it was skipped with 'skipIf' -- or 'skipWhen'. | TestSkipped - + -- | The test failed, generating the given notes and failures. | TestFailed [(String, String)] [Failure] - + -- | The test aborted with an error message, and generated the given -- notes. | TestAborted [(String, String)] String - + -- Not exported; used to generate GHC warnings for users who don't -- provide a default case. | TestResultCaseMustHaveDefault @@ -132,7 +132,7 @@ data Failure = Failure -- 'failureLocation' is a field accessor, and can be used to update -- a 'Failure' value. failureLocation :: Maybe Location - + -- | If given, a message which explains why the test failed. -- -- 'failureMessage' is a field accessor, and can be used to update @@ -153,13 +153,13 @@ data Location = Location -- 'locationFile' is a field accessor, and can be used to update -- a 'Location' value. locationFile :: String - + -- | A Haskell module name, or empty if not provided. -- -- 'locationModule' is a field accessor, and can be used to update -- a 'Location' value. , locationModule :: String - + -- | A line number, or Nothing if not provided. -- -- 'locationLine' is a field accessor, and can be used to update @@ -280,9 +280,9 @@ suiteTests = go "" where prefixed prefix str = if null prefix then str else prefix ++ "." ++ str - + go prefix (Suite name children) = concatMap (step (prefixed prefix name)) children - + step prefix (Test name io) = [Test (prefixed prefix name) io] -- | Run a test, wrapped in error handlers. This will return 'TestAborted' if @@ -295,11 +295,11 @@ handleJankyIO opts getResult getNotes = do let withTimeout = case testOptionTimeout opts of Just time -> timeout (time * 1000) Nothing -> fmap Just - + let hitTimeout = str where str = "Test timed out after " ++ show time ++ " milliseconds" Just time = testOptionTimeout opts - + tried <- withTimeout (try getResult) case tried of Just (Right ret) -> return ret @@ -314,6 +314,6 @@ try :: IO a -> IO (Either String a) try io = catches (fmap Right io) [Handler handleAsync, Handler handleExc] where handleAsync :: Control.Exception.AsyncException -> IO a handleAsync = throwIO - + handleExc :: SomeException -> IO (Either String a) handleExc exc = return (Left ("Test aborted due to exception: " ++ show exc)) From 35ae86debc2a844d88f8b70fe0771238dc37efcb Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 16 Feb 2019 16:36:33 -0700 Subject: [PATCH 09/36] replace tabs with 2 spaces in import lists --- chell-hunit/Test/Chell/HUnit.hs | 4 +- chell-quickcheck/Test/Chell/QuickCheck.hs | 4 +- chell/Test/Chell.hs | 160 +++++++++++----------- chell/Test/Chell/Main.hs | 4 +- chell/Test/Chell/Output.hs | 14 +- chell/Test/Chell/Types.hs | 54 ++++---- 6 files changed, 120 insertions(+), 120 deletions(-) diff --git a/chell-hunit/Test/Chell/HUnit.hs b/chell-hunit/Test/Chell/HUnit.hs index 5270abc..ab95865 100644 --- a/chell-hunit/Test/Chell/HUnit.hs +++ b/chell-hunit/Test/Chell/HUnit.hs @@ -1,6 +1,6 @@ module Test.Chell.HUnit - ( hunit - ) where + ( hunit + ) where import qualified Test.Chell as Chell import Test.HUnit.Lang (Assertion, Result (..), performTestCase) diff --git a/chell-quickcheck/Test/Chell/QuickCheck.hs b/chell-quickcheck/Test/Chell/QuickCheck.hs index 16a7720..e1aed28 100644 --- a/chell-quickcheck/Test/Chell/QuickCheck.hs +++ b/chell-quickcheck/Test/Chell/QuickCheck.hs @@ -1,8 +1,8 @@ {-# LANGUAGE CPP #-} module Test.Chell.QuickCheck - ( property - ) where + ( property + ) where import Data.Monoid (mempty) import System.Random (mkStdGen) diff --git a/chell/Test/Chell.hs b/chell/Test/Chell.hs index 315e7a6..6871376 100644 --- a/chell/Test/Chell.hs +++ b/chell/Test/Chell.hs @@ -37,86 +37,86 @@ -- >$ ./chell-example -- >PASS: 2 tests run, 2 tests passed module Test.Chell - ( - - -- * Main - defaultMain - - -- * Test suites - , Suite - , suite - , suiteName - , suiteTests - - -- ** Skipping some tests - , SuiteOrTest - , skipIf - , skipWhen - - -- * Basic testing library - , Assertions - , assertions - , IsAssertion - , Assertion - , assertionPassed - , assertionFailed - , assert - , expect - , die - , trace - , note - , afterTest - , requireLeft - , requireRight - - -- ** Built-in assertions - , equal - , notEqual - , equalWithin - , just - , nothing - , left - , right - , throws - , throwsEq - , greater - , greaterEqual - , lesser - , lesserEqual - , sameItems - , equalItems - , IsText - , equalLines - , equalLinesWith - - -- * Custom test types - , Test - , test - , testName - , runTest - - -- ** Test results - , TestResult (..) - - -- *** Failures - , Failure - , failure - , failureLocation - , failureMessage - - -- *** Failure locations - , Location - , location - , locationFile - , locationModule - , locationLine - - -- ** Test options - , TestOptions - , defaultTestOptions - , testOptionSeed - , testOptionTimeout - ) where + ( + + -- * Main + defaultMain + + -- * Test suites + , Suite + , suite + , suiteName + , suiteTests + + -- ** Skipping some tests + , SuiteOrTest + , skipIf + , skipWhen + + -- * Basic testing library + , Assertions + , assertions + , IsAssertion + , Assertion + , assertionPassed + , assertionFailed + , assert + , expect + , die + , trace + , note + , afterTest + , requireLeft + , requireRight + + -- ** Built-in assertions + , equal + , notEqual + , equalWithin + , just + , nothing + , left + , right + , throws + , throwsEq + , greater + , greaterEqual + , lesser + , lesserEqual + , sameItems + , equalItems + , IsText + , equalLines + , equalLinesWith + + -- * Custom test types + , Test + , test + , testName + , runTest + + -- ** Test results + , TestResult (..) + + -- *** Failures + , Failure + , failure + , failureLocation + , failureMessage + + -- *** Failure locations + , Location + , location + , locationFile + , locationModule + , locationLine + + -- ** Test options + , TestOptions + , defaultTestOptions + , testOptionSeed + , testOptionTimeout + ) where import qualified Control.Applicative import qualified Control.Exception diff --git a/chell/Test/Chell/Main.hs b/chell/Test/Chell/Main.hs index 901db5d..f97d134 100644 --- a/chell/Test/Chell/Main.hs +++ b/chell/Test/Chell/Main.hs @@ -1,6 +1,6 @@ module Test.Chell.Main - ( defaultMain - ) where + ( defaultMain + ) where import Control.Applicative import Control.Monad (forM, forM_, when) diff --git a/chell/Test/Chell/Output.hs b/chell/Test/Chell/Output.hs index 5e56d2c..562896b 100644 --- a/chell/Test/Chell/Output.hs +++ b/chell/Test/Chell/Output.hs @@ -1,15 +1,15 @@ {-# LANGUAGE CPP #-} module Test.Chell.Output - ( Output - , outputStart - , outputResult + ( Output + , outputStart + , outputResult - , ColorMode(..) + , ColorMode(..) - , plainOutput - , colorOutput - ) where + , plainOutput + , colorOutput + ) where import Control.Monad (forM_, unless, when) diff --git a/chell/Test/Chell/Types.hs b/chell/Test/Chell/Types.hs index 991ce28..dd87f90 100644 --- a/chell/Test/Chell/Types.hs +++ b/chell/Test/Chell/Types.hs @@ -1,39 +1,39 @@ module Test.Chell.Types - ( Test - , test - , testName + ( Test + , test + , testName - , TestOptions - , defaultTestOptions - , testOptionSeed - , testOptionTimeout + , TestOptions + , defaultTestOptions + , testOptionSeed + , testOptionTimeout - , TestResult(TestPassed, TestSkipped, TestFailed, TestAborted) + , TestResult(TestPassed, TestSkipped, TestFailed, TestAborted) - , Failure - , failure - , failureLocation - , failureMessage + , Failure + , failure + , failureLocation + , failureMessage - , Location - , location - , locationFile - , locationModule - , locationLine + , Location + , location + , locationFile + , locationModule + , locationLine - , Suite - , suite - , suiteName - , suiteTests + , Suite + , suite + , suiteName + , suiteTests - , SuiteOrTest - , skipIf - , skipWhen + , SuiteOrTest + , skipIf + , skipWhen - , runTest + , runTest - , handleJankyIO - ) where + , handleJankyIO + ) where import qualified Control.Exception import Control.Exception (SomeException, Handler(..), catches, throwIO) From b7b8b808673ad4a4610a681f3d0a932795d9b9da Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 16 Feb 2019 16:45:23 -0700 Subject: [PATCH 10/36] reformat type definitions --- chell/Test/Chell.hs | 10 ++- chell/Test/Chell/Main.hs | 19 +++-- chell/Test/Chell/Output.hs | 17 ++-- chell/Test/Chell/Types.hs | 163 +++++++++++++++++++------------------ 4 files changed, 109 insertions(+), 100 deletions(-) diff --git a/chell/Test/Chell.hs b/chell/Test/Chell.hs index 6871376..e6878d1 100644 --- a/chell/Test/Chell.hs +++ b/chell/Test/Chell.hs @@ -143,9 +143,9 @@ import Test.Chell.Types -- | A single pass/fail assertion. Failed assertions include an explanatory -- message. data Assertion - = AssertionPassed - | AssertionFailed String - deriving (Eq, Show) + = AssertionPassed + | AssertionFailed String + deriving (Eq, Show) -- | See 'Assertion'. assertionPassed :: Assertion @@ -173,7 +173,9 @@ instance IsAssertion a => IsAssertion (IO a) where type TestState = (IORef [(String, String)], IORef [IO ()], [Failure]) -- | See 'assertions'. -newtype Assertions a = Assertions { unAssertions :: TestState -> IO (Maybe a, TestState) } +newtype Assertions a = + Assertions + { unAssertions :: TestState -> IO (Maybe a, TestState) } instance Functor Assertions where fmap = liftM diff --git a/chell/Test/Chell/Main.hs b/chell/Test/Chell/Main.hs index f97d134..e221adb 100644 --- a/chell/Test/Chell/Main.hs +++ b/chell/Test/Chell/Main.hs @@ -19,15 +19,16 @@ import Options import Test.Chell.Output import Test.Chell.Types -data MainOptions = MainOptions - { optVerbose :: Bool - , optXmlReport :: String - , optJsonReport :: String - , optTextReport :: String - , optSeed :: Maybe Int - , optTimeout :: Maybe Int - , optColor :: ColorMode - } +data MainOptions = + MainOptions + { optVerbose :: Bool + , optXmlReport :: String + , optJsonReport :: String + , optTextReport :: String + , optSeed :: Maybe Int + , optTimeout :: Maybe Int + , optColor :: ColorMode + } optionType_ColorMode :: OptionType ColorMode optionType_ColorMode = optionType "ColorMode" ColorModeAuto parseMode showMode where diff --git a/chell/Test/Chell/Output.hs b/chell/Test/Chell/Output.hs index 562896b..693a351 100644 --- a/chell/Test/Chell/Output.hs +++ b/chell/Test/Chell/Output.hs @@ -19,10 +19,11 @@ import qualified System.Console.ANSI as AnsiTerminal import Test.Chell.Types -data Output = Output - { outputStart :: Test -> IO () - , outputResult :: Test -> TestResult -> IO () - } +data Output = + Output + { outputStart :: Test -> IO () + , outputResult :: Test -> TestResult -> IO () + } plainOutput :: Bool -> Output plainOutput v = Output @@ -59,10 +60,10 @@ plainOutputResult _ t (TestAborted notes msg) = do plainOutputResult _ _ _ = return () data ColorMode - = ColorModeAuto - | ColorModeAlways - | ColorModeNever - deriving (Enum) + = ColorModeAuto + | ColorModeAlways + | ColorModeNever + deriving (Enum) colorOutput :: Bool -> Output #ifndef MIN_VERSION_ansi_terminal diff --git a/chell/Test/Chell/Types.hs b/chell/Test/Chell/Types.hs index dd87f90..8a9ea4e 100644 --- a/chell/Test/Chell/Types.hs +++ b/chell/Test/Chell/Types.hs @@ -41,7 +41,8 @@ import System.Timeout (timeout) -- | A 'Test' is, essentially, an IO action that returns a 'TestResult'. Tests -- are aggregated into suites (see 'Suite'). -data Test = Test String (TestOptions -> IO TestResult) +data Test = + Test String (TestOptions -> IO TestResult) instance Show Test where showsPrec d (Test name _) = showParen (d > 10) (showString "Test " . shows name) @@ -56,31 +57,32 @@ testName (Test name _) = name -- | Test options are passed to each test, and control details about how the -- test should be run. -data TestOptions = TestOptions - { - - -- | Get the RNG seed for this test run. The seed is generated once, in - -- 'defaultMain', and used for all tests. It is also logged to reports - -- using a note. - -- - -- When using 'defaultMain', users may specify a seed using the - -- @--seed@ command-line option. - -- - -- 'testOptionSeed' is a field accessor, and can be used to update - -- a 'TestOptions' value. - testOptionSeed :: Int - - -- | An optional timeout, in millseconds. Tests which run longer than - -- this timeout will be aborted. - -- - -- When using 'defaultMain', users may specify a timeout using the - -- @--timeout@ command-line option. - -- - -- 'testOptionTimeout' is a field accessor, and can be used to update - -- a 'TestOptions' value. - , testOptionTimeout :: Maybe Int - } - deriving (Show, Eq) +data TestOptions = + TestOptions + { + + -- | Get the RNG seed for this test run. The seed is generated once, in + -- 'defaultMain', and used for all tests. It is also logged to reports + -- using a note. + -- + -- When using 'defaultMain', users may specify a seed using the + -- @--seed@ command-line option. + -- + -- 'testOptionSeed' is a field accessor, and can be used to update + -- a 'TestOptions' value. + testOptionSeed :: Int + + -- | An optional timeout, in millseconds. Tests which run longer than + -- this timeout will be aborted. + -- + -- When using 'defaultMain', users may specify a timeout using the + -- @--timeout@ command-line option. + -- + -- 'testOptionTimeout' is a field accessor, and can be used to update + -- a 'TestOptions' value. + , testOptionTimeout :: Maybe Int + } + deriving (Show, Eq) -- | Default test options. -- @@ -104,69 +106,71 @@ defaultTestOptions = TestOptions -- who pattern-match against the 'TestResult' constructors should include a -- default case. If no default case is provided, a warning will be issued. data TestResult - -- | The test passed, and generated the given notes. - = TestPassed [(String, String)] + -- | The test passed, and generated the given notes. + = TestPassed [(String, String)] - -- | The test did not run, because it was skipped with 'skipIf' - -- or 'skipWhen'. - | TestSkipped + -- | The test did not run, because it was skipped with 'skipIf' + -- or 'skipWhen'. + | TestSkipped - -- | The test failed, generating the given notes and failures. - | TestFailed [(String, String)] [Failure] + -- | The test failed, generating the given notes and failures. + | TestFailed [(String, String)] [Failure] - -- | The test aborted with an error message, and generated the given - -- notes. - | TestAborted [(String, String)] String + -- | The test aborted with an error message, and generated the given + -- notes. + | TestAborted [(String, String)] String - -- Not exported; used to generate GHC warnings for users who don't - -- provide a default case. - | TestResultCaseMustHaveDefault - deriving (Show, Eq) + -- Not exported; used to generate GHC warnings for users who don't + -- provide a default case. + | TestResultCaseMustHaveDefault + deriving (Show, Eq) -- | Contains details about a test failure. -data Failure = Failure - { - -- | If given, the location of the failing assertion, expectation, - -- etc. - -- - -- 'failureLocation' is a field accessor, and can be used to update - -- a 'Failure' value. - failureLocation :: Maybe Location - - -- | If given, a message which explains why the test failed. - -- - -- 'failureMessage' is a field accessor, and can be used to update - -- a 'Failure' value. - , failureMessage :: String - } - deriving (Show, Eq) +data Failure = + Failure + { + -- | If given, the location of the failing assertion, expectation, + -- etc. + -- + -- 'failureLocation' is a field accessor, and can be used to update + -- a 'Failure' value. + failureLocation :: Maybe Location + + -- | If given, a message which explains why the test failed. + -- + -- 'failureMessage' is a field accessor, and can be used to update + -- a 'Failure' value. + , failureMessage :: String + } + deriving (Show, Eq) -- | An empty 'Failure'; use the field accessors to populate this value. failure :: Failure failure = Failure Nothing "" -- | Contains details about a location in the test source file. -data Location = Location - { - -- | A path to a source file, or empty if not provided. - -- - -- 'locationFile' is a field accessor, and can be used to update - -- a 'Location' value. - locationFile :: String - - -- | A Haskell module name, or empty if not provided. - -- - -- 'locationModule' is a field accessor, and can be used to update - -- a 'Location' value. - , locationModule :: String - - -- | A line number, or Nothing if not provided. - -- - -- 'locationLine' is a field accessor, and can be used to update - -- a 'Location' value. - , locationLine :: Maybe Integer - } - deriving (Show, Eq) +data Location = + Location + { + -- | A path to a source file, or empty if not provided. + -- + -- 'locationFile' is a field accessor, and can be used to update + -- a 'Location' value. + locationFile :: String + + -- | A Haskell module name, or empty if not provided. + -- + -- 'locationModule' is a field accessor, and can be used to update + -- a 'Location' value. + , locationModule :: String + + -- | A line number, or Nothing if not provided. + -- + -- 'locationLine' is a field accessor, and can be used to update + -- a 'Location' value. + , locationLine :: Maybe Integer + } + deriving (Show, Eq) -- | An empty 'Location'; use the field accessors to populate this value. location :: Location @@ -177,8 +181,9 @@ location = Location "" "" Nothing -- Note: earlier versions of Chell permitted arbitrary nesting of test suites. -- This feature proved too unwieldy, and was removed. A similar result can be -- achieved with 'suiteTests'; see the documentation for 'suite'. -data Suite = Suite String [Test] - deriving (Show) +data Suite = + Suite String [Test] + deriving Show class SuiteOrTest a where skipIf_ :: Bool -> a -> a From 5ab3741a070bb808217dda0bc9d29c7584f47dd8 Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 16 Feb 2019 16:46:35 -0700 Subject: [PATCH 11/36] reformat class definitions --- chell/Test/Chell.hs | 12 +++++++----- chell/Test/Chell/Types.hs | 7 ++++--- 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/chell/Test/Chell.hs b/chell/Test/Chell.hs index e6878d1..90059c5 100644 --- a/chell/Test/Chell.hs +++ b/chell/Test/Chell.hs @@ -156,8 +156,9 @@ assertionFailed :: String -> Assertion assertionFailed = AssertionFailed -- | See 'assert' and 'expect'. -class IsAssertion a where - runAssertion :: a -> IO Assertion +class IsAssertion a + where + runAssertion :: a -> IO Assertion instance IsAssertion Assertion where runAssertion = return @@ -512,9 +513,10 @@ equalDiff' label norm x y = checkDiff (items x) (items y) where errorMsg diff = label ++ ": items differ\n" ++ diff -- | Class for types which can be treated as text; see 'equalLines'. -class IsText a where - toLines :: a -> [a] - unpack :: a -> String +class IsText a + where + toLines :: a -> [a] + unpack :: a -> String instance IsText String where toLines = lines diff --git a/chell/Test/Chell/Types.hs b/chell/Test/Chell/Types.hs index 8a9ea4e..7b9d16d 100644 --- a/chell/Test/Chell/Types.hs +++ b/chell/Test/Chell/Types.hs @@ -185,9 +185,10 @@ data Suite = Suite String [Test] deriving Show -class SuiteOrTest a where - skipIf_ :: Bool -> a -> a - skipWhen_ :: IO Bool -> a -> a +class SuiteOrTest a + where + skipIf_ :: Bool -> a -> a + skipWhen_ :: IO Bool -> a -> a instance SuiteOrTest Suite where skipIf_ skip s@(Suite name children) = if skip From 5c4b1988ada1d2317ce5e97764d894f319b25ab5 Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 16 Feb 2019 16:53:30 -0700 Subject: [PATCH 12/36] reformat instances --- chell/Test/Chell.hs | 108 +++++++++++++++++++++++--------------- chell/Test/Chell/Main.hs | 59 +++++++++++---------- chell/Test/Chell/Types.hs | 42 +++++++++------ 3 files changed, 126 insertions(+), 83 deletions(-) diff --git a/chell/Test/Chell.hs b/chell/Test/Chell.hs index 90059c5..e424a66 100644 --- a/chell/Test/Chell.hs +++ b/chell/Test/Chell.hs @@ -160,16 +160,23 @@ class IsAssertion a where runAssertion :: a -> IO Assertion -instance IsAssertion Assertion where - runAssertion = return - -instance IsAssertion Bool where - runAssertion x = return $ if x - then assertionPassed - else assertionFailed "boolean assertion failed" +instance IsAssertion Assertion + where + runAssertion = return -instance IsAssertion a => IsAssertion (IO a) where - runAssertion x = x >>= runAssertion +instance IsAssertion Bool + where + runAssertion x = + return + ( + if x + then assertionPassed + else assertionFailed "boolean assertion failed" + ) + +instance IsAssertion a => IsAssertion (IO a) + where + runAssertion x = x >>= runAssertion type TestState = (IORef [(String, String)], IORef [IO ()], [Failure]) @@ -178,25 +185,39 @@ newtype Assertions a = Assertions { unAssertions :: TestState -> IO (Maybe a, TestState) } -instance Functor Assertions where - fmap = liftM - -instance Control.Applicative.Applicative Assertions where - pure = return - (<*>) = ap +instance Functor Assertions + where + fmap = liftM -instance Monad Assertions where - return x = Assertions (\s -> return (Just x, s)) - m >>= f = Assertions (\s -> do - (maybe_a, s') <- unAssertions m s - case maybe_a of - Nothing -> return (Nothing, s') - Just a -> unAssertions (f a) s') +instance Control.Applicative.Applicative Assertions + where + pure = return + (<*>) = ap -instance MonadIO Assertions where - liftIO io = Assertions (\s -> do - x <- io - return (Just x, s)) +instance Monad Assertions + where + return x = + Assertions (\s -> return (Just x, s)) + + m >>= f = + Assertions + (\s -> + do + (maybe_a, s') <- unAssertions m s + case maybe_a of + Nothing -> return (Nothing, s') + Just a -> unAssertions (f a) s' + ) + +instance MonadIO Assertions + where + liftIO io = + Assertions + (\s -> + do + x <- io + return (Just x, s) + ) -- | Convert a sequence of pass/fail assertions into a runnable test. -- @@ -518,27 +539,32 @@ class IsText a toLines :: a -> [a] unpack :: a -> String -instance IsText String where - toLines = lines - unpack = id +instance IsText String + where + toLines = lines + unpack = id -instance IsText Text where - toLines = Data.Text.lines - unpack = Data.Text.unpack +instance IsText Text + where + toLines = Data.Text.lines + unpack = Data.Text.unpack -instance IsText Data.Text.Lazy.Text where - toLines = Data.Text.Lazy.lines - unpack = Data.Text.Lazy.unpack +instance IsText Data.Text.Lazy.Text + where + toLines = Data.Text.Lazy.lines + unpack = Data.Text.Lazy.unpack -- | Uses @Data.ByteString.Char8@ -instance IsText Data.ByteString.Char8.ByteString where - toLines = Data.ByteString.Char8.lines - unpack = Data.ByteString.Char8.unpack +instance IsText Data.ByteString.Char8.ByteString + where + toLines = Data.ByteString.Char8.lines + unpack = Data.ByteString.Char8.unpack -- | Uses @Data.ByteString.Lazy.Char8@ -instance IsText Data.ByteString.Lazy.Char8.ByteString where - toLines = Data.ByteString.Lazy.Char8.lines - unpack = Data.ByteString.Lazy.Char8.unpack +instance IsText Data.ByteString.Lazy.Char8.ByteString + where + toLines = Data.ByteString.Lazy.Char8.lines + unpack = Data.ByteString.Lazy.Char8.unpack -- | Assert that two pieces of text are equal. This uses a diff algorithm -- to check line-by-line, so the error message will be easier to read on diff --git a/chell/Test/Chell/Main.hs b/chell/Test/Chell/Main.hs index e221adb..b03fe06 100644 --- a/chell/Test/Chell/Main.hs +++ b/chell/Test/Chell/Main.hs @@ -42,33 +42,38 @@ optionType_ColorMode = optionType "ColorMode" ColorModeAuto parseMode showMode w ColorModeNever -> "never" ColorModeAuto -> "auto" -instance Options MainOptions where - defineOptions = pure MainOptions - <*> defineOption optionType_bool (\o -> o - { optionShortFlags = ['v'] - , optionLongFlags = ["verbose"] - , optionDefault = False - , optionDescription = "Print more output." - }) - - <*> simpleOption "xml-report" "" - "Write a parsable report to a given path, in XML." - <*> simpleOption "json-report" "" - "Write a parsable report to a given path, in JSON." - <*> simpleOption "text-report" "" - "Write a human-readable report to a given path." - - <*> simpleOption "seed" Nothing - "The seed used for random numbers in (for example) quickcheck." - - <*> simpleOption "timeout" Nothing - "The maximum duration of a test, in milliseconds." - - <*> defineOption optionType_ColorMode (\o -> o - { optionLongFlags = ["color"] - , optionDefault = ColorModeAuto - , optionDescription = "Whether to enable color ('always', 'auto', or 'never')." - }) +instance Options MainOptions + where + defineOptions = pure MainOptions + <*> defineOption optionType_bool + (\o -> o + { optionShortFlags = ['v'] + , optionLongFlags = ["verbose"] + , optionDefault = False + , optionDescription = "Print more output." + } + ) + + <*> simpleOption "xml-report" "" + "Write a parsable report to a given path, in XML." + <*> simpleOption "json-report" "" + "Write a parsable report to a given path, in JSON." + <*> simpleOption "text-report" "" + "Write a human-readable report to a given path." + + <*> simpleOption "seed" Nothing + "The seed used for random numbers in (for example) quickcheck." + + <*> simpleOption "timeout" Nothing + "The maximum duration of a test, in milliseconds." + + <*> defineOption optionType_ColorMode + (\o -> o + { optionLongFlags = ["color"] + , optionDefault = ColorModeAuto + , optionDescription = "Whether to enable color ('always', 'auto', or 'never')." + } + ) -- | A simple default main function, which runs a list of tests and logs -- statistics to stdout. diff --git a/chell/Test/Chell/Types.hs b/chell/Test/Chell/Types.hs index 7b9d16d..4359333 100644 --- a/chell/Test/Chell/Types.hs +++ b/chell/Test/Chell/Types.hs @@ -44,8 +44,9 @@ import System.Timeout (timeout) data Test = Test String (TestOptions -> IO TestResult) -instance Show Test where - showsPrec d (Test name _) = showParen (d > 10) (showString "Test " . shows name) +instance Show Test + where + showsPrec d (Test name _) = showParen (d > 10) (showString "Test " . shows name) -- | Define a test, with the given name and implementation. test :: String -> (TestOptions -> IO TestResult) -> Test @@ -190,19 +191,30 @@ class SuiteOrTest a skipIf_ :: Bool -> a -> a skipWhen_ :: IO Bool -> a -> a -instance SuiteOrTest Suite where - skipIf_ skip s@(Suite name children) = if skip - then Suite name (map (skipIf_ skip) children) - else s - skipWhen_ p (Suite name children) = Suite name (map (skipWhen_ p) children) - -instance SuiteOrTest Test where - skipIf_ skip t@(Test name _) = if skip - then Test name (\_ -> return TestSkipped) - else t - skipWhen_ p (Test name io) = Test name (\opts -> do - skip <- p - if skip then return TestSkipped else io opts) +instance SuiteOrTest Suite + where + skipIf_ skip s@(Suite name children) = + if skip + then Suite name (map (skipIf_ skip) children) + else s + + skipWhen_ p (Suite name children) = + Suite name (map (skipWhen_ p) children) + +instance SuiteOrTest Test + where + skipIf_ skip t@(Test name _) = + if skip + then Test name (\_ -> return TestSkipped) + else t + + skipWhen_ p (Test name io) = + Test name + (\opts -> + do + skip <- p + if skip then return TestSkipped else io opts + ) -- | Conditionally skip tests. Use this to avoid commenting out tests -- which are currently broken, or do not work on the current platform. From 6e659c08566414156f28f5a672ca5b17ce421c62 Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 16 Feb 2019 17:11:36 -0700 Subject: [PATCH 13/36] reformat Test.Chell.Main --- chell/Test/Chell/Main.hs | 696 ++++++++++++++++++++++----------------- 1 file changed, 385 insertions(+), 311 deletions(-) diff --git a/chell/Test/Chell/Main.hs b/chell/Test/Chell/Main.hs index b03fe06..7281ae9 100644 --- a/chell/Test/Chell/Main.hs +++ b/chell/Test/Chell/Main.hs @@ -31,16 +31,19 @@ data MainOptions = } optionType_ColorMode :: OptionType ColorMode -optionType_ColorMode = optionType "ColorMode" ColorModeAuto parseMode showMode where - parseMode s = case s of - "always" -> Right ColorModeAlways - "never" -> Right ColorModeNever - "auto" -> Right ColorModeAuto - _ -> Left (show s ++ " is not in {\"always\", \"never\", \"auto\"}.") - showMode mode = case mode of - ColorModeAlways -> "always" - ColorModeNever -> "never" - ColorModeAuto -> "auto" +optionType_ColorMode = optionType "ColorMode" ColorModeAuto parseMode showMode + where + parseMode s = + case s of + "always" -> Right ColorModeAlways + "never" -> Right ColorModeNever + "auto" -> Right ColorModeAuto + _ -> Left (show s ++ " is not in {\"always\", \"never\", \"auto\"}.") + showMode mode = + case mode of + ColorModeAlways -> "always" + ColorModeNever -> "never" + ColorModeAuto -> "auto" instance Options MainOptions where @@ -78,321 +81,392 @@ instance Options MainOptions -- | A simple default main function, which runs a list of tests and logs -- statistics to stdout. defaultMain :: [Suite] -> IO () -defaultMain suites = runCommand $ \opts args -> do - -- validate/sanitize test options - seed <- case optSeed opts of - Just s -> return s - Nothing -> randomIO - timeout <- case optTimeout opts of - Nothing -> return Nothing - Just t -> if toInteger t * 1000 > toInteger (maxBound :: Int) - then do - hPutStrLn stderr "Test.Chell.defaultMain: Ignoring --timeout because it is too large." - return Nothing - else return (Just t) - let testOptions = defaultTestOptions - { testOptionSeed = seed - , testOptionTimeout = timeout - } - - -- find which tests to run - let allTests = concatMap suiteTests suites - let tests = if null args - then allTests - else filter (matchesFilter args) allTests - - -- output mode - output <- case optColor opts of - ColorModeNever -> return (plainOutput (optVerbose opts)) - ColorModeAlways -> return (colorOutput (optVerbose opts)) - ColorModeAuto -> do - isTerm <- hIsTerminalDevice stdout - return $ if isTerm - then colorOutput (optVerbose opts) - else plainOutput (optVerbose opts) - - -- run tests - results <- forM tests $ \t -> do - outputStart output t - result <- runTest t testOptions - outputResult output t result - return (t, result) - - -- generate reports - let reports = getReports opts - forM_ reports $ \(path, fmt, toText) -> - withBinaryFile path WriteMode $ \h -> do - when (optVerbose opts) $ do - putStrLn ("Writing " ++ fmt ++ " report to " ++ show path) - hPutStr h (toText results) - - let stats = resultStatistics results - let (_, _, failed, aborted) = stats - putStrLn (formatResultStatistics stats) - - if failed == 0 && aborted == 0 - then exitSuccess - else exitFailure +defaultMain suites = runCommand $ \opts args -> + do + -- validate/sanitize test options + seed <- + case optSeed opts of + Just s -> return s + Nothing -> randomIO + timeout <- + case optTimeout opts of + Nothing -> return Nothing + Just t -> if toInteger t * 1000 > toInteger (maxBound :: Int) + then + do + hPutStrLn stderr "Test.Chell.defaultMain: Ignoring --timeout because it is too large." + return Nothing + else + return (Just t) + let + testOptions = defaultTestOptions + { testOptionSeed = seed + , testOptionTimeout = timeout + } + + -- find which tests to run + let + allTests = concatMap suiteTests suites + tests = + if null args + then allTests + else filter (matchesFilter args) allTests + + -- output mode + output <- + case optColor opts of + ColorModeNever -> return (plainOutput (optVerbose opts)) + ColorModeAlways -> return (colorOutput (optVerbose opts)) + ColorModeAuto -> + do + isTerm <- hIsTerminalDevice stdout + return $ + if isTerm + then colorOutput (optVerbose opts) + else plainOutput (optVerbose opts) + + -- run tests + results <- forM tests $ \t -> + do + outputStart output t + result <- runTest t testOptions + outputResult output t result + return (t, result) + + -- generate reports + let + reports = getReports opts + + forM_ reports $ \(path, fmt, toText) -> + withBinaryFile path WriteMode $ \h -> + do + when (optVerbose opts) $ + putStrLn ("Writing " ++ fmt ++ " report to " ++ show path) + hPutStr h (toText results) + + let + stats = resultStatistics results + (_, _, failed, aborted) = stats + putStrLn (formatResultStatistics stats) + + if failed == 0 && aborted == 0 + then exitSuccess + else exitFailure matchesFilter :: [String] -> Test -> Bool -matchesFilter filters = check where - check t = any (matchName (testName t)) filters - matchName name f = f == name || isPrefixOf (f ++ ".") name +matchesFilter filters = check + where + check t = any (matchName (testName t)) filters + matchName name f = f == name || isPrefixOf (f ++ ".") name type Report = [(Test, TestResult)] -> String getReports :: MainOptions -> [(String, String, Report)] -getReports opts = concat [xml, json, text] where - xml = case optXmlReport opts of - "" -> [] - path -> [(path, "XML", xmlReport)] - json = case optJsonReport opts of - "" -> [] - path -> [(path, "JSON", jsonReport)] - text = case optTextReport opts of - "" -> [] - path -> [(path, "text", textReport)] +getReports opts = concat [xml, json, text] + where + xml = case optXmlReport opts of + "" -> [] + path -> [(path, "XML", xmlReport)] + json = case optJsonReport opts of + "" -> [] + path -> [(path, "JSON", jsonReport)] + text = case optTextReport opts of + "" -> [] + path -> [(path, "text", textReport)] jsonReport :: [(Test, TestResult)] -> String -jsonReport results = Writer.execWriter writer where - tell = Writer.tell - - writer = do - tell "{\"test-runs\": [" - commas results tellResult - tell "]}" - - tellResult (t, result) = case result of - TestPassed notes -> do - tell "{\"test\": \"" - tell (escapeJSON (testName t)) - tell "\", \"result\": \"passed\"" - tellNotes notes - tell "}" - TestSkipped -> do - tell "{\"test\": \"" - tell (escapeJSON (testName t)) - tell "\", \"result\": \"skipped\"}" - TestFailed notes fs -> do - tell "{\"test\": \"" - tell (escapeJSON (testName t)) - tell "\", \"result\": \"failed\", \"failures\": [" - commas fs $ \f -> do - tell "{\"message\": \"" - tell (escapeJSON (failureMessage f)) - tell "\"" - case failureLocation f of - Just loc -> do - tell ", \"location\": {\"module\": \"" - tell (escapeJSON (locationModule loc)) - tell "\", \"file\": \"" - tell (escapeJSON (locationFile loc)) - case locationLine loc of - Just line -> do - tell "\", \"line\": " - tell (show line) - Nothing -> tell "\"" - tell "}" - Nothing -> return () - tell "}" - tell "]" - tellNotes notes - tell "}" - TestAborted notes msg -> do - tell "{\"test\": \"" - tell (escapeJSON (testName t)) - tell "\", \"result\": \"aborted\", \"abortion\": {\"message\": \"" - tell (escapeJSON msg) - tell "\"}" - tellNotes notes - tell "}" - _ -> return () - - escapeJSON = concatMap (\c -> case c of - '"' -> "\\\"" - '\\' -> "\\\\" - _ | ord c <= 0x1F -> printf "\\u%04X" (ord c) - _ -> [c]) - - tellNotes notes = do - tell ", \"notes\": [" - commas notes $ \(key, value) -> do - tell "{\"key\": \"" - tell (escapeJSON key) - tell "\", \"value\": \"" - tell (escapeJSON value) - tell "\"}" - tell "]" - - commas xs block = State.evalStateT (commaState xs block) False - commaState xs block = forM_ xs $ \x -> do - let tell' = lift . Writer.tell - needComma <- State.get - if needComma - then tell' "\n, " - else tell' "\n " - State.put True - lift (block x) +jsonReport results = Writer.execWriter writer + where + tell = Writer.tell + + writer = + do + tell "{\"test-runs\": [" + commas results tellResult + tell "]}" + + tellResult (t, result) = + case result of + TestPassed notes -> + do + tell "{\"test\": \"" + tell (escapeJSON (testName t)) + tell "\", \"result\": \"passed\"" + tellNotes notes + tell "}" + TestSkipped -> + do + tell "{\"test\": \"" + tell (escapeJSON (testName t)) + tell "\", \"result\": \"skipped\"}" + TestFailed notes fs -> + do + tell "{\"test\": \"" + tell (escapeJSON (testName t)) + tell "\", \"result\": \"failed\", \"failures\": [" + commas fs $ \f -> + do + tell "{\"message\": \"" + tell (escapeJSON (failureMessage f)) + tell "\"" + case failureLocation f of + Just loc -> + do + tell ", \"location\": {\"module\": \"" + tell (escapeJSON (locationModule loc)) + tell "\", \"file\": \"" + tell (escapeJSON (locationFile loc)) + case locationLine loc of + Just line -> + do + tell "\", \"line\": " + tell (show line) + Nothing -> tell "\"" + tell "}" + Nothing -> return () + tell "}" + tell "]" + tellNotes notes + tell "}" + TestAborted notes msg -> + do + tell "{\"test\": \"" + tell (escapeJSON (testName t)) + tell "\", \"result\": \"aborted\", \"abortion\": {\"message\": \"" + tell (escapeJSON msg) + tell "\"}" + tellNotes notes + tell "}" + _ -> return () + + escapeJSON = + concatMap + (\c -> + case c of + '"' -> "\\\"" + '\\' -> "\\\\" + _ | ord c <= 0x1F -> printf "\\u%04X" (ord c) + _ -> [c] + ) + + tellNotes notes = + do + tell ", \"notes\": [" + commas notes $ \(key, value) -> + do + tell "{\"key\": \"" + tell (escapeJSON key) + tell "\", \"value\": \"" + tell (escapeJSON value) + tell "\"}" + tell "]" + + commas xs block = State.evalStateT (commaState xs block) False + commaState xs block = forM_ xs $ \x -> + do + let + tell' = lift . Writer.tell + needComma <- State.get + if needComma + then tell' "\n, " + else tell' "\n " + State.put True + lift (block x) xmlReport :: [(Test, TestResult)] -> String -xmlReport results = Writer.execWriter writer where - tell = Writer.tell - - writer = do - tell "\n" - tell "\n" - mapM_ tellResult results - tell "" - - tellResult (t, result) = case result of - TestPassed notes -> do - tell "\t\n" - tellNotes notes - tell "\t\n" - TestSkipped -> do - tell "\t\n" - TestFailed notes fs -> do - tell "\t\n" - forM_ fs $ \f -> do - tell "\t\t\n" - tell "\t\t\t\n" - tell "\t\t\n" - Nothing -> tell "'/>\n" - tellNotes notes - tell "\t\n" - TestAborted notes msg -> do - tell "\t\n" - tell "\t\t\n" - tellNotes notes - tell "\t\n" - _ -> return () - - escapeXML = concatMap (\c -> case c of - '&' -> "&" - '<' -> "<" - '>' -> ">" - '"' -> """ - '\'' -> "'" - _ -> [c]) - - tellNotes notes = forM_ notes $ \(key, value) -> do - tell "\t\t\n" +xmlReport results = Writer.execWriter writer + where + tell = Writer.tell + + writer = + do + tell "\n" + tell "\n" + mapM_ tellResult results + tell "" + + tellResult (t, result) = + case result of + TestPassed notes -> + do + tell "\t\n" + tellNotes notes + tell "\t\n" + TestSkipped -> + do + tell "\t\n" + TestFailed notes fs -> + do + tell "\t\n" + forM_ fs $ \f -> + do + tell "\t\t\n" + tell "\t\t\t\n" + tell "\t\t\n" + Nothing -> tell "'/>\n" + tellNotes notes + tell "\t\n" + TestAborted notes msg -> + do + tell "\t\n" + tell "\t\t\n" + tellNotes notes + tell "\t\n" + _ -> return () + + escapeXML = + concatMap + (\c -> + case c of + '&' -> "&" + '<' -> "<" + '>' -> ">" + '"' -> """ + '\'' -> "'" + _ -> [c] + ) + + tellNotes notes = forM_ notes $ \(key, value) -> + do + tell "\t\t\n" textReport :: [(Test, TestResult)] -> String -textReport results = Writer.execWriter writer where - tell = Writer.tell - - writer = do - forM_ results tellResult - let stats = resultStatistics results - tell (formatResultStatistics stats) - - tellResult (t, result) = case result of - TestPassed notes -> do - tell (replicate 70 '=') - tell "\n" - tell "PASSED: " - tell (testName t) - tell "\n" - tellNotes notes - tell "\n\n" - TestSkipped -> do - tell (replicate 70 '=') - tell "\n" - tell "SKIPPED: " - tell (testName t) - tell "\n\n" - TestFailed notes fs -> do - tell (replicate 70 '=') - tell "\n" - tell "FAILED: " - tell (testName t) - tell "\n" - tellNotes notes - tell (replicate 70 '-') - tell "\n" - forM_ fs $ \f -> do - case failureLocation f of - Just loc -> do - tell (locationFile loc) - case locationLine loc of - Just line -> do - tell ":" - tell (show line) - Nothing -> return () - tell "\n" - Nothing -> return () - tell (failureMessage f) - tell "\n\n" - TestAborted notes msg -> do - tell (replicate 70 '=') - tell "\n" - tell "ABORTED: " - tell (testName t) - tell "\n" - tellNotes notes - tell (replicate 70 '-') - tell "\n" - tell msg - tell "\n\n" - _ -> return () - - tellNotes notes = forM_ notes $ \(key, value) -> do - tell key - tell "=" - tell value - tell "\n" +textReport results = Writer.execWriter writer + where + tell = Writer.tell + + writer = + do + forM_ results tellResult + let stats = resultStatistics results + tell (formatResultStatistics stats) + + tellResult (t, result) = + case result of + TestPassed notes -> + do + tell (replicate 70 '=') + tell "\n" + tell "PASSED: " + tell (testName t) + tell "\n" + tellNotes notes + tell "\n\n" + TestSkipped -> + do + tell (replicate 70 '=') + tell "\n" + tell "SKIPPED: " + tell (testName t) + tell "\n\n" + TestFailed notes fs -> + do + tell (replicate 70 '=') + tell "\n" + tell "FAILED: " + tell (testName t) + tell "\n" + tellNotes notes + tell (replicate 70 '-') + tell "\n" + forM_ fs $ \f -> + do + case failureLocation f of + Just loc -> + do + tell (locationFile loc) + case locationLine loc of + Just line -> + do + tell ":" + tell (show line) + Nothing -> return () + tell "\n" + Nothing -> return () + tell (failureMessage f) + tell "\n\n" + TestAborted notes msg -> + do + tell (replicate 70 '=') + tell "\n" + tell "ABORTED: " + tell (testName t) + tell "\n" + tellNotes notes + tell (replicate 70 '-') + tell "\n" + tell msg + tell "\n\n" + _ -> return () + + tellNotes notes = forM_ notes $ \(key, value) -> + do + tell key + tell "=" + tell value + tell "\n" formatResultStatistics :: (Integer, Integer, Integer, Integer) -> String formatResultStatistics stats = Writer.execWriter writer where - writer = do - let (passed, skipped, failed, aborted) = stats - if failed == 0 && aborted == 0 - then Writer.tell "PASS: " - else Writer.tell "FAIL: " - let putNum comma n what = Writer.tell $ if n == 1 - then comma ++ "1 test " ++ what - else comma ++ show n ++ " tests " ++ what - - let total = sum [passed, skipped, failed, aborted] - putNum "" total "run" - (putNum ", " passed "passed") - when (skipped > 0) (putNum ", " skipped "skipped") - when (failed > 0) (putNum ", " failed "failed") - when (aborted > 0) (putNum ", " aborted "aborted") + writer = + do + let + (passed, skipped, failed, aborted) = stats + + if failed == 0 && aborted == 0 + then Writer.tell "PASS: " + else Writer.tell "FAIL: " + + let + putNum comma n what = Writer.tell $ + if n == 1 + then comma ++ "1 test " ++ what + else comma ++ show n ++ " tests " ++ what + + let + total = sum [passed, skipped, failed, aborted] + + putNum "" total "run" + (putNum ", " passed "passed") + when (skipped > 0) (putNum ", " skipped "skipped") + when (failed > 0) (putNum ", " failed "failed") + when (aborted > 0) (putNum ", " aborted "aborted") resultStatistics :: [(Test, TestResult)] -> (Integer, Integer, Integer, Integer) -resultStatistics results = State.execState state (0, 0, 0, 0) where - state = forM_ results $ \(_, result) -> case result of - TestPassed{} -> State.modify (\(p, s, f, a) -> (p+1, s, f, a)) - TestSkipped{} -> State.modify (\(p, s, f, a) -> (p, s+1, f, a)) - TestFailed{} -> State.modify (\(p, s, f, a) -> (p, s, f+1, a)) - TestAborted{} -> State.modify (\(p, s, f, a) -> (p, s, f, a+1)) - _ -> return () +resultStatistics results = State.execState state (0, 0, 0, 0) + where + state = forM_ results $ \(_, result) -> case result of + TestPassed{} -> State.modify (\(p, s, f, a) -> (p+1, s, f, a)) + TestSkipped{} -> State.modify (\(p, s, f, a) -> (p, s+1, f, a)) + TestFailed{} -> State.modify (\(p, s, f, a) -> (p, s, f+1, a)) + TestAborted{} -> State.modify (\(p, s, f, a) -> (p, s, f, a+1)) + _ -> return () From 44c25e8c22c1272a3d3c90ecffc38ce0afeb432d Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 16 Feb 2019 17:15:10 -0700 Subject: [PATCH 14/36] reformat Test.Chell.Output --- chell/Test/Chell/Output.hs | 235 ++++++++++++++++++++----------------- 1 file changed, 129 insertions(+), 106 deletions(-) diff --git a/chell/Test/Chell/Output.hs b/chell/Test/Chell/Output.hs index 693a351..e2ad45e 100644 --- a/chell/Test/Chell/Output.hs +++ b/chell/Test/Chell/Output.hs @@ -26,37 +26,46 @@ data Output = } plainOutput :: Bool -> Output -plainOutput v = Output - { outputStart = plainOutputStart v - , outputResult = plainOutputResult v - } +plainOutput v = + Output + { outputStart = plainOutputStart v + , outputResult = plainOutputResult v + } plainOutputStart :: Bool -> Test -> IO () -plainOutputStart v t = when v $ do - putStr "[ RUN ] " - putStrLn (testName t) +plainOutputStart v t = + when v $ + do + putStr "[ RUN ] " + putStrLn (testName t) plainOutputResult :: Bool -> Test -> TestResult -> IO () -plainOutputResult v t (TestPassed _) = when v $ do - putStr "[ PASS ] " - putStrLn (testName t) - putStrLn "" -plainOutputResult v t TestSkipped = when v $ do - putStr "[ SKIP ] " - putStrLn (testName t) - putStrLn "" -plainOutputResult _ t (TestFailed notes fs) = do - putStr "[ FAIL ] " - putStrLn (testName t) - printNotes notes - printFailures fs -plainOutputResult _ t (TestAborted notes msg) = do - putStr "[ ABORT ] " - putStrLn (testName t) - printNotes notes - putStr " " - putStr msg - putStrLn "\n" +plainOutputResult v t (TestPassed _) = + when v $ + do + putStr "[ PASS ] " + putStrLn (testName t) + putStrLn "" +plainOutputResult v t TestSkipped = + when v $ + do + putStr "[ SKIP ] " + putStrLn (testName t) + putStrLn "" +plainOutputResult _ t (TestFailed notes fs) = + do + putStr "[ FAIL ] " + putStrLn (testName t) + printNotes notes + printFailures fs +plainOutputResult _ t (TestAborted notes msg) = + do + putStr "[ ABORT ] " + putStrLn (testName t) + printNotes notes + putStr " " + putStr msg + putStrLn "\n" plainOutputResult _ _ _ = return () data ColorMode @@ -69,92 +78,106 @@ colorOutput :: Bool -> Output #ifndef MIN_VERSION_ansi_terminal colorOutput = plainOutput #else -colorOutput v = Output - { outputStart = colorOutputStart v - , outputResult = colorOutputResult v - } +colorOutput v = + Output + { outputStart = colorOutputStart v + , outputResult = colorOutputResult v + } colorOutputStart :: Bool -> Test -> IO () -colorOutputStart v t = when v $ do - putStr "[ RUN ] " - putStrLn (testName t) +colorOutputStart v t = when v $ + do + putStr "[ RUN ] " + putStrLn (testName t) colorOutputResult :: Bool -> Test -> TestResult -> IO () -colorOutputResult v t (TestPassed _) = when v $ do - putStr "[ " - AnsiTerminal.setSGR - [ AnsiTerminal.SetColor AnsiTerminal.Foreground AnsiTerminal.Vivid AnsiTerminal.Green - ] - putStr "PASS" - AnsiTerminal.setSGR - [ AnsiTerminal.Reset - ] - putStr " ] " - putStrLn (testName t) - putStrLn "" -colorOutputResult v t TestSkipped = when v $ do - putStr "[ " - AnsiTerminal.setSGR - [ AnsiTerminal.SetColor AnsiTerminal.Foreground AnsiTerminal.Vivid AnsiTerminal.Yellow - ] - putStr "SKIP" - AnsiTerminal.setSGR - [ AnsiTerminal.Reset - ] - putStr " ] " - putStrLn (testName t) - putStrLn "" -colorOutputResult _ t (TestFailed notes fs) = do - putStr "[ " - AnsiTerminal.setSGR - [ AnsiTerminal.SetColor AnsiTerminal.Foreground AnsiTerminal.Vivid AnsiTerminal.Red - ] - putStr "FAIL" - AnsiTerminal.setSGR - [ AnsiTerminal.Reset - ] - putStr " ] " - putStrLn (testName t) - printNotes notes - printFailures fs -colorOutputResult _ t (TestAborted notes msg) = do - putStr "[ " - AnsiTerminal.setSGR - [ AnsiTerminal.SetColor AnsiTerminal.Foreground AnsiTerminal.Vivid AnsiTerminal.Red - ] - putStr "ABORT" - AnsiTerminal.setSGR - [ AnsiTerminal.Reset - ] - putStr " ] " - putStrLn (testName t) - printNotes notes - putStr " " - putStr msg - putStrLn "\n" +colorOutputResult v t (TestPassed _) = + when v $ + do + putStr "[ " + AnsiTerminal.setSGR + [ AnsiTerminal.SetColor AnsiTerminal.Foreground AnsiTerminal.Vivid AnsiTerminal.Green + ] + putStr "PASS" + AnsiTerminal.setSGR + [ AnsiTerminal.Reset + ] + putStr " ] " + putStrLn (testName t) + putStrLn "" +colorOutputResult v t TestSkipped = + when v $ + do + putStr "[ " + AnsiTerminal.setSGR + [ AnsiTerminal.SetColor AnsiTerminal.Foreground AnsiTerminal.Vivid AnsiTerminal.Yellow + ] + putStr "SKIP" + AnsiTerminal.setSGR + [ AnsiTerminal.Reset + ] + putStr " ] " + putStrLn (testName t) + putStrLn "" +colorOutputResult _ t (TestFailed notes fs) = + do + putStr "[ " + AnsiTerminal.setSGR + [ AnsiTerminal.SetColor AnsiTerminal.Foreground AnsiTerminal.Vivid AnsiTerminal.Red + ] + putStr "FAIL" + AnsiTerminal.setSGR + [ AnsiTerminal.Reset + ] + putStr " ] " + putStrLn (testName t) + printNotes notes + printFailures fs +colorOutputResult _ t (TestAborted notes msg) = + do + putStr "[ " + AnsiTerminal.setSGR + [ AnsiTerminal.SetColor AnsiTerminal.Foreground AnsiTerminal.Vivid AnsiTerminal.Red + ] + putStr "ABORT" + AnsiTerminal.setSGR + [ AnsiTerminal.Reset + ] + putStr " ] " + putStrLn (testName t) + printNotes notes + putStr " " + putStr msg + putStrLn "\n" colorOutputResult _ _ _ = return () #endif printNotes :: [(String, String)] -> IO () -printNotes notes = unless (null notes) $ do - forM_ notes $ \(key, value) -> do - putStr " note: " - putStr key - putStr "=" - putStrLn value - putStrLn "" +printNotes notes = + unless (null notes) $ + do + forM_ notes $ \(key, value) -> + do + putStr " note: " + putStr key + putStr "=" + putStrLn value + putStrLn "" printFailures :: [Failure] -> IO () -printFailures fs = forM_ fs $ \f -> do - putStr " " - case failureLocation f of - Just loc -> do - putStr (locationFile loc) - putStr ":" - case locationLine loc of - Just line -> putStrLn (show line) - Nothing -> putStrLn "" - Nothing -> return () - putStr " " - putStr (failureMessage f) - putStrLn "\n" +printFailures fs = + forM_ fs $ \f -> + do + putStr " " + case failureLocation f of + Just loc -> + do + putStr (locationFile loc) + putStr ":" + case locationLine loc of + Just line -> putStrLn (show line) + Nothing -> putStrLn "" + Nothing -> return () + putStr " " + putStr (failureMessage f) + putStrLn "\n" From 5737d5af22a1da8126ee5f9efb3b190edd34df25 Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 16 Feb 2019 17:17:57 -0700 Subject: [PATCH 15/36] reformat Test.Chell.Types --- chell/Test/Chell/Types.hs | 78 ++++++++++++++++++++++----------------- 1 file changed, 45 insertions(+), 33 deletions(-) diff --git a/chell/Test/Chell/Types.hs b/chell/Test/Chell/Types.hs index 4359333..dc5907c 100644 --- a/chell/Test/Chell/Types.hs +++ b/chell/Test/Chell/Types.hs @@ -96,10 +96,11 @@ data TestOptions = -- >Test.Chell> testOptionTimeout defaultTestOptions -- >Nothing defaultTestOptions :: TestOptions -defaultTestOptions = TestOptions - { testOptionSeed = 0 - , testOptionTimeout = Nothing - } +defaultTestOptions = + TestOptions + { testOptionSeed = 0 + , testOptionTimeout = Nothing + } -- | The result of running a test. -- @@ -294,14 +295,17 @@ suiteName (Suite name _) = name -- >*Main> suiteTests tests_Math -- >[Test "math.addition",Test "math.subtraction"] suiteTests :: Suite -> [Test] -suiteTests = go "" where - prefixed prefix str = if null prefix - then str - else prefix ++ "." ++ str +suiteTests = go "" + where + prefixed prefix str = + if null prefix + then str + else prefix ++ "." ++ str - go prefix (Suite name children) = concatMap (step (prefixed prefix name)) children + go prefix (Suite name children) = + concatMap (step (prefixed prefix name)) children - step prefix (Test name io) = [Test (prefixed prefix name) io] + step prefix (Test name io) = [Test (prefixed prefix name) io] -- | Run a test, wrapped in error handlers. This will return 'TestAborted' if -- the test throws an exception or times out. @@ -309,29 +313,37 @@ runTest :: Test -> TestOptions -> IO TestResult runTest (Test _ io) options = handleJankyIO options (io options) (return []) handleJankyIO :: TestOptions -> IO TestResult -> IO [(String, String)] -> IO TestResult -handleJankyIO opts getResult getNotes = do - let withTimeout = case testOptionTimeout opts of - Just time -> timeout (time * 1000) - Nothing -> fmap Just - - let hitTimeout = str where - str = "Test timed out after " ++ show time ++ " milliseconds" - Just time = testOptionTimeout opts - - tried <- withTimeout (try getResult) - case tried of - Just (Right ret) -> return ret - Nothing -> do - notes <- getNotes - return (TestAborted notes hitTimeout) - Just (Left err) -> do - notes <- getNotes - return (TestAborted notes err) +handleJankyIO opts getResult getNotes = + do + let + withTimeout = + case testOptionTimeout opts of + Just time -> timeout (time * 1000) + Nothing -> fmap Just + + let + hitTimeout = str + where + str = "Test timed out after " ++ show time ++ " milliseconds" + Just time = testOptionTimeout opts + + tried <- withTimeout (try getResult) + case tried of + Just (Right ret) -> return ret + Nothing -> + do + notes <- getNotes + return (TestAborted notes hitTimeout) + Just (Left err) -> + do + notes <- getNotes + return (TestAborted notes err) try :: IO a -> IO (Either String a) -try io = catches (fmap Right io) [Handler handleAsync, Handler handleExc] where - handleAsync :: Control.Exception.AsyncException -> IO a - handleAsync = throwIO +try io = catches (fmap Right io) [Handler handleAsync, Handler handleExc] + where + handleAsync :: Control.Exception.AsyncException -> IO a + handleAsync = throwIO - handleExc :: SomeException -> IO (Either String a) - handleExc exc = return (Left ("Test aborted due to exception: " ++ show exc)) + handleExc :: SomeException -> IO (Either String a) + handleExc exc = return (Left ("Test aborted due to exception: " ++ show exc)) From c7698c0c5b75df05407a460f23c1c39bf4537e8d Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 16 Feb 2019 17:30:32 -0700 Subject: [PATCH 16/36] reformat Test.Chell --- chell/Test/Chell.hs | 379 +++++++++++++++++++++++++++----------------- 1 file changed, 232 insertions(+), 147 deletions(-) diff --git a/chell/Test/Chell.hs b/chell/Test/Chell.hs index e424a66..ea492ef 100644 --- a/chell/Test/Chell.hs +++ b/chell/Test/Chell.hs @@ -228,45 +228,58 @@ instance MonadIO Assertions -- $assert (equal 1 1) -- @ assertions :: String -> Assertions a -> Test -assertions name testm = test name $ \opts -> do - noteRef <- newIORef [] - afterTestRef <- newIORef [] - - let getNotes = fmap reverse (readIORef noteRef) - - let getResult = do - res <- unAssertions testm (noteRef, afterTestRef, []) - case res of - (_, (_, _, [])) -> do - notes <- getNotes - return (TestPassed notes) - (_, (_, _, fs)) -> do - notes <- getNotes - return (TestFailed notes (reverse fs)) - - Control.Exception.finally - (handleJankyIO opts getResult getNotes) - (runAfterTest afterTestRef) +assertions name testm = + test name $ \opts -> + do + noteRef <- newIORef [] + afterTestRef <- newIORef [] + + let + getNotes = fmap reverse (readIORef noteRef) + + let + getResult = + do + res <- unAssertions testm (noteRef, afterTestRef, []) + case res of + (_, (_, _, [])) -> + do + notes <- getNotes + return (TestPassed notes) + (_, (_, _, fs)) -> + do + notes <- getNotes + return (TestFailed notes (reverse fs)) + + Control.Exception.finally + (handleJankyIO opts getResult getNotes) + (runAfterTest afterTestRef) runAfterTest :: IORef [IO ()] -> IO () -runAfterTest ref = readIORef ref >>= loop where - loop [] = return () - loop (io:ios) = Control.Exception.finally (loop ios) io +runAfterTest ref = readIORef ref >>= loop + where + loop [] = return () + loop (io:ios) = Control.Exception.finally (loop ios) io addFailure :: Maybe TH.Loc -> String -> Assertions () -addFailure maybe_loc msg = Assertions $ \(notes, afterTestRef, fs) -> do - let loc = do - th_loc <- maybe_loc - return $ location - { locationFile = TH.loc_filename th_loc - , locationModule = TH.loc_module th_loc - , locationLine = Just (toInteger (fst (TH.loc_start th_loc))) - } - let f = failure - { failureLocation = loc - , failureMessage = msg - } - return (Just (), (notes, afterTestRef, f : fs)) +addFailure maybe_loc msg = + Assertions $ \(notes, afterTestRef, fs) -> + do + let + loc = + do + th_loc <- maybe_loc + return $ location + { locationFile = TH.loc_filename th_loc + , locationModule = TH.loc_module th_loc + , locationLine = Just (toInteger (fst (TH.loc_start th_loc))) + } + let + f = failure + { failureLocation = loc + , failureMessage = msg + } + return (Just (), (notes, afterTestRef, f : fs)) -- | Cause a test to immediately fail, with a message. -- @@ -277,15 +290,18 @@ addFailure maybe_loc msg = Assertions $ \(notes, afterTestRef, fs) -> do -- $die :: 'String' -> 'Assertions' a -- @ die :: TH.Q TH.Exp -die = do - loc <- TH.location - let qloc = liftLoc loc - [| \msg -> dieAt $qloc ("die: " ++ msg) |] +die = + do + loc <- TH.location + let + qloc = liftLoc loc + [| \msg -> dieAt $qloc ("die: " ++ msg) |] dieAt :: TH.Loc -> String -> Assertions a -dieAt loc msg = do - addFailure (Just loc) msg - Assertions (\s -> return (Nothing, s)) +dieAt loc msg = + do + addFailure (Just loc) msg + Assertions (\s -> return (Nothing, s)) -- | Print a message from within a test. This is just a helper for debugging, -- so you don't have to import @Debug.Trace@. Messages will be prefixed with @@ -298,32 +314,41 @@ dieAt loc msg = do -- $trace :: 'String' -> 'Assertions' () -- @ trace :: TH.Q TH.Exp -trace = do - loc <- TH.location - let qloc = liftLoc loc - [| traceAt $qloc |] +trace = + do + loc <- TH.location + let + qloc = liftLoc loc + [| traceAt $qloc |] traceAt :: TH.Loc -> String -> Assertions () -traceAt loc msg = liftIO $ do - let file = TH.loc_filename loc - let line = fst (TH.loc_start loc) - putStr ("[" ++ file ++ ":" ++ show line ++ "] ") - putStrLn msg +traceAt loc msg = + liftIO $ + do + let + file = TH.loc_filename loc + line = fst (TH.loc_start loc) + putStr ("[" ++ file ++ ":" ++ show line ++ "] ") + putStrLn msg -- | Attach a note to a test run. Notes will be printed to stdout and -- included in reports, even if the test fails or aborts. Notes are useful for -- debugging failing tests. note :: String -> String -> Assertions () -note key value = Assertions (\(notes, afterTestRef, fs) -> do - modifyIORef notes ((key, value) :) - return (Just (), (notes, afterTestRef, fs))) +note key value = + Assertions (\(notes, afterTestRef, fs) -> + do + modifyIORef notes ((key, value) :) + return (Just (), (notes, afterTestRef, fs))) -- | Register an IO action to be run after the test completes. This action -- will run even if the test failed or aborted. afterTest :: IO () -> Assertions () -afterTest io = Assertions (\(notes, ref, fs) -> do - modifyIORef ref (io :) - return (Just (), (notes, ref, fs))) +afterTest io = + Assertions (\(notes, ref, fs) -> + do + modifyIORef ref (io :) + return (Just (), (notes, ref, fs))) -- | Require an 'Either' value to be 'Left', and return its contents. If -- the value is 'Right', fail the test. @@ -335,17 +360,22 @@ afterTest io = Assertions (\(notes, ref, fs) -> do -- $requireLeft :: 'Show' b => 'Either' a b -> 'Assertions' a -- @ requireLeft :: TH.Q TH.Exp -requireLeft = do - loc <- TH.location - let qloc = liftLoc loc - [| requireLeftAt $qloc |] +requireLeft = + do + loc <- TH.location + let + qloc = liftLoc loc + [| requireLeftAt $qloc |] requireLeftAt :: Show b => TH.Loc -> Either a b -> Assertions a -requireLeftAt loc val = case val of - Left a -> return a - Right b -> do - let dummy = Right b `asTypeOf` Left () - dieAt loc ("requireLeft: received " ++ showsPrec 11 dummy "") +requireLeftAt loc val = + case val of + Left a -> return a + Right b -> + do + let + dummy = Right b `asTypeOf` Left () + dieAt loc ("requireLeft: received " ++ showsPrec 11 dummy "") -- | Require an 'Either' value to be 'Right', and return its contents. If -- the value is 'Left', fail the test. @@ -357,34 +387,43 @@ requireLeftAt loc val = case val of -- $requireRight :: 'Show' a => 'Either' a b -> 'Assertions' b -- @ requireRight :: TH.Q TH.Exp -requireRight = do - loc <- TH.location - let qloc = liftLoc loc - [| requireRightAt $qloc |] +requireRight = + do + loc <- TH.location + let + qloc = liftLoc loc + [| requireRightAt $qloc |] requireRightAt :: Show a => TH.Loc -> Either a b -> Assertions b -requireRightAt loc val = case val of - Left a -> do - let dummy = Left a `asTypeOf` Right () - dieAt loc ("requireRight: received " ++ showsPrec 11 dummy "") - Right b -> return b +requireRightAt loc val = + case val of + Left a -> + do + let + dummy = Left a `asTypeOf` Right () + dieAt loc ("requireRight: received " ++ showsPrec 11 dummy "") + Right b -> return b liftLoc :: TH.Loc -> TH.Q TH.Exp -liftLoc loc = [| TH.Loc filename package module_ start end |] where - filename = TH.loc_filename loc - package = TH.loc_package loc - module_ = TH.loc_module loc - start = TH.loc_start loc - end = TH.loc_end loc +liftLoc loc = + [| TH.Loc filename package module_ start end |] + where + filename = TH.loc_filename loc + package = TH.loc_package loc + module_ = TH.loc_module loc + start = TH.loc_start loc + end = TH.loc_end loc assertAt :: IsAssertion assertion => TH.Loc -> Bool -> assertion -> Assertions () -assertAt loc fatal assertion = do - result <- liftIO (runAssertion assertion) - case result of - AssertionPassed -> return () - AssertionFailed err -> if fatal - then dieAt loc err - else addFailure (Just loc) err +assertAt loc fatal assertion = + do + result <- liftIO (runAssertion assertion) + case result of + AssertionPassed -> return () + AssertionFailed err -> + if fatal + then dieAt loc err + else addFailure (Just loc) err -- | Check an assertion. If the assertion fails, the test will immediately -- fail. @@ -399,10 +438,12 @@ assertAt loc fatal assertion = do -- $assert :: 'IsAssertion' assertion => assertion -> 'Assertions' () -- @ assert :: TH.Q TH.Exp -assert = do - loc <- TH.location - let qloc = liftLoc loc - [| assertAt $qloc True |] +assert = + do + loc <- TH.location + let + qloc = liftLoc loc + [| assertAt $qloc True |] -- | Check an assertion. If the assertion fails, the test will continue to -- run until it finishes, a call to 'assert' fails, or the test runs 'die'. @@ -417,10 +458,12 @@ assert = do -- $expect :: 'IsAssertion' assertion => assertion -> 'Assertions' () -- @ expect :: TH.Q TH.Exp -expect = do - loc <- TH.location - let qloc = liftLoc loc - [| assertAt $qloc False |] +expect = + do + loc <- TH.location + let + qloc = liftLoc loc + [| assertAt $qloc False |] assertBool :: Bool -> String -> Assertion assertBool True _ = assertionPassed @@ -428,19 +471,26 @@ assertBool False err = AssertionFailed err -- | Assert that two values are equal. equal :: (Show a, Eq a) => a -> a -> Assertion -equal x y = assertBool (x == y) ("equal: " ++ show x ++ " is not equal to " ++ show y) +equal x y = + assertBool + (x == y) + ("equal: " ++ show x ++ " is not equal to " ++ show y) -- | Assert that two values are not equal. notEqual :: (Eq a, Show a) => a -> a -> Assertion -notEqual x y = assertBool (x /= y) ("notEqual: " ++ show x ++ " is equal to " ++ show y) +notEqual x y = + assertBool + (x /= y) + ("notEqual: " ++ show x ++ " is equal to " ++ show y) -- | Assert that two values are within some delta of each other. equalWithin :: (Real a, Show a) => a -> a -> a -- ^ delta -> Assertion -equalWithin x y delta = assertBool - ((x - delta <= y) && (x + delta >= y)) - ("equalWithin: " ++ show x ++ " is not within " ++ show delta ++ " of " ++ show y) +equalWithin x y delta = + assertBool + ((x - delta <= y) && (x + delta >= y)) + ("equalWithin: " ++ show x ++ " is not within " ++ show delta ++ " of " ++ show y) -- | Assert that some value is @Just@. just :: Maybe a -> Assertion @@ -448,67 +498,94 @@ just x = assertBool (isJust x) ("just: received Nothing") -- | Assert that some value is @Nothing@. nothing :: Show a => Maybe a -> Assertion -nothing x = assertBool (isNothing x) ("nothing: received " ++ showsPrec 11 x "") +nothing x = + assertBool + (isNothing x) + ("nothing: received " ++ showsPrec 11 x "") -- | Assert that some value is @Left@. left :: Show b => Either a b -> Assertion left (Left _) = assertionPassed -left (Right b) = assertionFailed ("left: received " ++ showsPrec 11 dummy "") where - dummy = Right b `asTypeOf` Left () +left (Right b) = assertionFailed ("left: received " ++ showsPrec 11 dummy "") + where + dummy = Right b `asTypeOf` Left () -- | Assert that some value is @Right@. right :: Show a => Either a b -> Assertion right (Right _) = assertionPassed -right (Left a) = assertionFailed ("right: received " ++ showsPrec 11 dummy "") where - dummy = Left a `asTypeOf` Right () +right (Left a) = assertionFailed ("right: received " ++ showsPrec 11 dummy "") + where + dummy = Left a `asTypeOf` Right () -- | Assert that some computation throws an exception matching the provided -- predicate. This is mostly useful for exception types which do not have an -- instance for @Eq@, such as @'Control.Exception.ErrorCall'@. throws :: Exception err => (err -> Bool) -> IO a -> IO Assertion -throws p io = do - either_exc <- Control.Exception.try io - return $ case either_exc of - Left exc -> if p exc - then assertionPassed - else assertionFailed ("throws: exception " ++ show exc ++ " did not match predicate") - Right _ -> assertionFailed "throws: no exception thrown" +throws p io = + do + either_exc <- Control.Exception.try io + return $ + case either_exc of + Left exc -> + if p exc + then assertionPassed + else assertionFailed ("throws: exception " ++ show exc ++ + " did not match predicate") + Right _ -> assertionFailed "throws: no exception thrown" -- | Assert that some computation throws an exception equal to the given -- exception. This is better than just checking that the correct type was -- thrown, because the test can also verify the exception contains the correct -- information. throwsEq :: (Eq err, Exception err, Show err) => err -> IO a -> IO Assertion -throwsEq expected io = do - either_exc <- Control.Exception.try io - return $ case either_exc of - Left exc -> if exc == expected - then assertionPassed - else assertionFailed ("throwsEq: exception " ++ show exc ++ " is not equal to " ++ show expected) - Right _ -> assertionFailed "throwsEq: no exception thrown" +throwsEq expected io = + do + either_exc <- Control.Exception.try io + return $ + case either_exc of + Left exc -> + if exc == expected + then assertionPassed + else assertionFailed ("throwsEq: exception " ++ show exc ++ + " is not equal to " ++ show expected) + Right _ -> assertionFailed "throwsEq: no exception thrown" -- | Assert a value is greater than another. greater :: (Ord a, Show a) => a -> a -> Assertion -greater x y = assertBool (x > y) ("greater: " ++ show x ++ " is not greater than " ++ show y) +greater x y = + assertBool + (x > y) + ("greater: " ++ show x ++ " is not greater than " ++ show y) -- | Assert a value is greater than or equal to another. greaterEqual :: (Ord a, Show a) => a -> a -> Assertion -greaterEqual x y = assertBool (x >= y) ("greaterEqual: " ++ show x ++ " is not greater than or equal to " ++ show y) +greaterEqual x y = + assertBool + (x >= y) + ("greaterEqual: " ++ show x ++ " is not greater than or equal to " ++ show y) -- | Assert a value is less than another. lesser :: (Ord a, Show a) => a -> a -> Assertion -lesser x y = assertBool (x < y) ("lesser: " ++ show x ++ " is not less than " ++ show y) +lesser x y = + assertBool + (x < y) + ("lesser: " ++ show x ++ " is not less than " ++ show y) -- | Assert a value is less than or equal to another. lesserEqual :: (Ord a, Show a) => a -> a -> Assertion -lesserEqual x y = assertBool (x <= y) ("lesserEqual: " ++ show x ++ " is not less than or equal to " ++ show y) +lesserEqual x y = + assertBool + (x <= y) + ("lesserEqual: " ++ show x ++ " is not less than or equal to " ++ show y) -- | Assert that two containers have the same items, in any order. -sameItems :: (Foldable container, Show item, Ord item) => container item -> container item -> Assertion +sameItems :: (Foldable container, Show item, Ord item) => + container item -> container item -> Assertion sameItems x y = equalDiff' "sameItems" sort x y -- | Assert that two containers have the same items, in the same order. -equalItems :: (Foldable container, Show item, Ord item) => container item -> container item -> Assertion +equalItems :: (Foldable container, Show item, Ord item) => + container item -> container item -> Assertion equalItems x y = equalDiff' "equalItems" id x y equalDiff' :: (Foldable container, Show item, Ord item) @@ -518,20 +595,24 @@ equalDiff' :: (Foldable container, Show item, Ord item) -> container item -> container item -> Assertion -equalDiff' label norm x y = checkDiff (items x) (items y) where - items = norm . foldMap (:[]) - checkDiff xs ys = case checkItems (Patience.diff xs ys) of - (same, diff) -> assertBool same diff +equalDiff' label norm x y = checkDiff (items x) (items y) + where + items = norm . foldMap (:[]) + checkDiff xs ys = + case checkItems (Patience.diff xs ys) of + (same, diff) -> assertBool same diff - checkItems diffItems = case foldl' checkItem (True, []) diffItems of - (same, diff) -> (same, errorMsg (intercalate "\n" (reverse diff))) + checkItems diffItems = + case foldl' checkItem (True, []) diffItems of + (same, diff) -> (same, errorMsg (intercalate "\n" (reverse diff))) - checkItem (same, acc) item = case item of - Patience.Old t -> (False, ("\t- " ++ show t) : acc) - Patience.New t -> (False, ("\t+ " ++ show t) : acc) - Patience.Both t _-> (same, ("\t " ++ show t) : acc) + checkItem (same, acc) item = + case item of + Patience.Old t -> (False, ("\t- " ++ show t) : acc) + Patience.New t -> (False, ("\t+ " ++ show t) : acc) + Patience.Both t _-> (same, ("\t " ++ show t) : acc) - errorMsg diff = label ++ ": items differ\n" ++ diff + errorMsg diff = label ++ ": items differ\n" ++ diff -- | Class for types which can be treated as text; see 'equalLines'. class IsText a @@ -578,16 +659,20 @@ equalLinesWith :: Ord a => (a -> [String]) -> a -> a -> Assertion equalLinesWith toStringLines x y = checkLinesDiff "equalLinesWith" (toStringLines x) (toStringLines y) checkLinesDiff :: (Ord a, IsText a) => String -> [a] -> [a] -> Assertion -checkLinesDiff label = go where - go xs ys = case checkItems (Patience.diff xs ys) of - (same, diff) -> assertBool same diff +checkLinesDiff label = go + where + go xs ys = + case checkItems (Patience.diff xs ys) of + (same, diff) -> assertBool same diff - checkItems diffItems = case foldl' checkItem (True, []) diffItems of - (same, diff) -> (same, errorMsg (intercalate "\n" (reverse diff))) + checkItems diffItems = + case foldl' checkItem (True, []) diffItems of + (same, diff) -> (same, errorMsg (intercalate "\n" (reverse diff))) - checkItem (same, acc) item = case item of - Patience.Old t -> (False, ("\t- " ++ unpack t) : acc) - Patience.New t -> (False, ("\t+ " ++ unpack t) : acc) - Patience.Both t _-> (same, ("\t " ++ unpack t) : acc) + checkItem (same, acc) item = + case item of + Patience.Old t -> (False, ("\t- " ++ unpack t) : acc) + Patience.New t -> (False, ("\t+ " ++ unpack t) : acc) + Patience.Both t _-> (same, ("\t " ++ unpack t) : acc) - errorMsg diff = label ++ ": lines differ\n" ++ diff + errorMsg diff = label ++ ": lines differ\n" ++ diff From df46b2ce2e3655cb087e5429f54e605e0b21880f Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 16 Feb 2019 17:31:18 -0700 Subject: [PATCH 17/36] reformat Test.Chell.HUnit --- chell-hunit/Test/Chell/HUnit.hs | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/chell-hunit/Test/Chell/HUnit.hs b/chell-hunit/Test/Chell/HUnit.hs index ab95865..d6d9c94 100644 --- a/chell-hunit/Test/Chell/HUnit.hs +++ b/chell-hunit/Test/Chell/HUnit.hs @@ -19,11 +19,14 @@ import Test.HUnit.Lang (Assertion, Result (..), performTestCase) -- 2 + 3 \@?= 5 -- @ hunit :: String -> Assertion -> Chell.Test -hunit name io = Chell.test name chell_io where - chell_io _ = do - result <- performTestCase io - return $ case result of - Success -> Chell.TestPassed [] - Failure _ msg -> Chell.TestFailed [] - [Chell.failure { Chell.failureMessage = msg }] - Error _ msg -> Chell.TestAborted [] msg +hunit name io = Chell.test name chell_io + where + chell_io _ = + do + result <- performTestCase io + return $ + case result of + Success -> Chell.TestPassed [] + Failure _ msg -> Chell.TestFailed [] + [Chell.failure { Chell.failureMessage = msg }] + Error _ msg -> Chell.TestAborted [] msg From 040b271b0dd9cae3f16f76cc39979785b4ac325c Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 16 Feb 2019 17:37:56 -0700 Subject: [PATCH 18/36] reformat Test.Chell.QuickCheck --- chell-quickcheck/Test/Chell/QuickCheck.hs | 114 ++++++++++++---------- 1 file changed, 62 insertions(+), 52 deletions(-) diff --git a/chell-quickcheck/Test/Chell/QuickCheck.hs b/chell-quickcheck/Test/Chell/QuickCheck.hs index e1aed28..ccf2bfd 100644 --- a/chell-quickcheck/Test/Chell/QuickCheck.hs +++ b/chell-quickcheck/Test/Chell/QuickCheck.hs @@ -31,89 +31,98 @@ import qualified Test.QuickCheck.Text as Text -- @ property :: QuickCheck.Testable prop => String -> prop -> Chell.Test #if MIN_VERSION_QuickCheck(2,6,0) -property name prop = Chell.test name $ \opts -> - Text.withNullTerminal $ \term -> do +property name prop = Chell.test name $ \opts -> Text.withNullTerminal $ \term -> + do #else -property name prop = Chell.test name $ \opts -> do - term <- Text.newNullTerminal +property name prop = Chell.test name $ \opts -> + do + term <- Text.newNullTerminal #endif - let seed = Chell.testOptionSeed opts + let + seed = Chell.testOptionSeed opts - let args = QuickCheck.stdArgs - let state = State.MkState - { State.terminal = term - , State.maxSuccessTests = QuickCheck.maxSuccess args + args = QuickCheck.stdArgs + + state = State.MkState + { State.terminal = term + , State.maxSuccessTests = QuickCheck.maxSuccess args #if MIN_VERSION_QuickCheck(2,10,1) - , State.maxDiscardedRatio = QuickCheck.maxDiscardRatio args + , State.maxDiscardedRatio = QuickCheck.maxDiscardRatio args #else - , State.maxDiscardedTests = maxDiscardedTests args prop + , State.maxDiscardedTests = maxDiscardedTests args prop #endif - , State.computeSize = computeSize (QuickCheck.maxSize args) (QuickCheck.maxSuccess args) - , State.numSuccessTests = 0 - , State.numDiscardedTests = 0 + , State.computeSize = computeSize (QuickCheck.maxSize args) (QuickCheck.maxSuccess args) + , State.numSuccessTests = 0 + , State.numDiscardedTests = 0 #if MIN_VERSION_QuickCheck(2,12,0) - , State.classes = mempty - , State.tables = mempty - , State.requiredCoverage = mempty - , State.expected = True - , State.coverageConfidence = Nothing + , State.classes = mempty + , State.tables = mempty + , State.requiredCoverage = mempty + , State.expected = True + , State.coverageConfidence = Nothing #else - , State.collected = [] - , State.expectedFailure = False + , State.collected = [] + , State.expectedFailure = False #endif #if MIN_VERSION_QuickCheck(2,7,0) - , State.randomSeed = QCRandom.mkQCGen seed + , State.randomSeed = QCRandom.mkQCGen seed #else - , State.randomSeed = mkStdGen seed + , State.randomSeed = mkStdGen seed #endif - , State.numSuccessShrinks = 0 - , State.numTryShrinks = 0 + , State.numSuccessShrinks = 0 + , State.numTryShrinks = 0 #if MIN_VERSION_QuickCheck(2,5,0) - , State.numTotTryShrinks = 0 + , State.numTotTryShrinks = 0 #endif #if MIN_VERSION_QuickCheck(2,5,1) - , State.numRecentlyDiscardedTests = 0 + , State.numRecentlyDiscardedTests = 0 #endif #if MIN_VERSION_QuickCheck(2,8,0) - , State.labels = mempty + , State.labels = mempty #endif #if MIN_VERSION_QuickCheck(2,10,0) - , State.numTotMaxShrinks = QuickCheck.maxShrinks args + , State.numTotMaxShrinks = QuickCheck.maxShrinks args #endif - } + } #if MIN_VERSION_QuickCheck(2,12,0) - result <- Test.test state (QuickCheck.property prop) + result <- Test.test state (QuickCheck.property prop) #else #if MIN_VERSION_QuickCheck(2,7,0) - let genProp = unProperty (QuickCheck.property prop) + let + genProp = unProperty (QuickCheck.property prop) #else - let genProp = QuickCheck.property prop + let + genProp = QuickCheck.property prop #endif - result <- Test.test state (Gen.unGen genProp) + result <- Test.test state (Gen.unGen genProp) #endif - let output = Test.output result - let notes = [("seed", show seed)] - let failure = Chell.failure { Chell.failureMessage = output } - return $ case result of - Test.Success{} -> Chell.TestPassed notes - Test.Failure{} -> Chell.TestFailed notes [failure] - Test.GaveUp{} -> Chell.TestAborted notes output - Test.NoExpectedFailure{} -> Chell.TestFailed notes [failure] + let + output = Test.output result + notes = [("seed", show seed)] + failure = Chell.failure { Chell.failureMessage = output } + + return $ + case result of + Test.Success{} -> Chell.TestPassed notes + Test.Failure{} -> Chell.TestFailed notes [failure] + Test.GaveUp{} -> Chell.TestAborted notes output + Test.NoExpectedFailure{} -> Chell.TestFailed notes [failure] -- copied from quickcheck-2.4.1.1/src/Test/QuickCheck/Test.hs computeSize :: Int -> Int -> Int -> Int -> Int computeSize maxSize maxSuccess n d - -- e.g. with maxSuccess = 250, maxSize = 100, goes like this: - -- 0, 1, 2, ..., 99, 0, 1, 2, ..., 99, 0, 2, 4, ..., 98. - | n `roundTo` maxSize + maxSize <= maxSuccess || - n >= maxSuccess || - maxSuccess `mod` maxSize == 0 = n `mod` maxSize + d `div` 10 - | otherwise = - (n `mod` maxSize) * maxSize `div` (maxSuccess `mod` maxSize) + d `div` 10 + -- e.g. with maxSuccess = 250, maxSize = 100, goes like this: + -- 0, 1, 2, ..., 99, 0, 1, 2, ..., 99, 0, 2, 4, ..., 98. + | n `roundTo` maxSize + maxSize <= maxSuccess || + n >= maxSuccess || + maxSuccess `mod` maxSize == 0 = + n `mod` maxSize + d `div` 10 + | otherwise = + (n `mod` maxSize) * maxSize `div` (maxSuccess `mod` maxSize) + d `div` 10 roundTo :: Int -> Int -> Int roundTo n m = (n `div` m) * m @@ -122,9 +131,10 @@ maxDiscardedTests :: QuickCheck.Testable prop => QuickCheck.Args -> prop -> Int #if MIN_VERSION_QuickCheck(2,9,0) maxDiscardedTests args _ = QuickCheck.maxDiscardRatio args #elif MIN_VERSION_QuickCheck(2,5,0) -maxDiscardedTests args p = if QuickCheck.exhaustive p - then QuickCheck.maxDiscardRatio args - else QuickCheck.maxDiscardRatio args * QuickCheck.maxSuccess args +maxDiscardedTests args p = + if QuickCheck.exhaustive p + then QuickCheck.maxDiscardRatio args + else QuickCheck.maxDiscardRatio args * QuickCheck.maxSuccess args #else maxDiscardedTests args _ = QuickCheck.maxDiscard args #endif From 9eecb50d1c700ee2ae45558afe5f10b4f9c553d3 Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 16 Feb 2019 17:45:51 -0700 Subject: [PATCH 19/36] add cabal descriptions --- chell-hunit/chell-hunit.cabal | 3 +++ chell-quickcheck/chell-quickcheck.cabal | 3 +++ 2 files changed, 6 insertions(+) diff --git a/chell-hunit/chell-hunit.cabal b/chell-hunit/chell-hunit.cabal index 99edf85..7f69308 100644 --- a/chell-hunit/chell-hunit.cabal +++ b/chell-hunit/chell-hunit.cabal @@ -12,6 +12,9 @@ homepage: https://john-millikin.com/software/chell/ synopsis: HUnit support for the Chell testing library +description: + HUnit support for the testing library. + source-repository head type: git location: https://john-millikin.com/code/chell/ diff --git a/chell-quickcheck/chell-quickcheck.cabal b/chell-quickcheck/chell-quickcheck.cabal index 673363e..42b8040 100644 --- a/chell-quickcheck/chell-quickcheck.cabal +++ b/chell-quickcheck/chell-quickcheck.cabal @@ -12,6 +12,9 @@ homepage: https://john-millikin.com/software/chell/ synopsis: QuickCheck support for the Chell testing library +description: + QuickCheck support for the testing library. + source-repository head type: git location: https://john-millikin.com/code/chell/ From 4bdf0176b5202adf204684480c1c62af90ed50cb Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 16 Feb 2019 16:06:04 -0700 Subject: [PATCH 20/36] generate Travis CI config --- .travis.yml | 120 ++++++++++++++++++++++++ chell-hunit/chell-hunit.cabal | 2 + chell-quickcheck/chell-quickcheck.cabal | 2 + chell/chell.cabal | 3 + 4 files changed, 127 insertions(+) create mode 100644 .travis.yml diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..d3ea59f --- /dev/null +++ b/.travis.yml @@ -0,0 +1,120 @@ +# This Travis job script has been generated by a script via +# +# haskell-ci 'cabal.project' +# +# For more information, see https://github.com/haskell-CI/haskell-ci +# +language: c +dist: xenial + +git: + submodules: false # whether to recursively clone submodules + +cache: + directories: + - $HOME/.cabal/packages + - $HOME/.cabal/store + +before_cache: + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log + # remove files that are regenerated by 'cabal update' + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.* + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx + + - rm -rfv $HOME/.cabal/packages/head.hackage + +matrix: + include: + - compiler: "ghc-8.6.3" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.6.3], sources: [hvr-ghc]}} + - compiler: "ghc-8.4.4" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.4.4], sources: [hvr-ghc]}} + - compiler: "ghc-8.2.2" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.2.2], sources: [hvr-ghc]}} + +before_install: + - HC=${CC} + - HCPKG=${HC/ghc/ghc-pkg} + - unset CC + - ROOTDIR=$(pwd) + - mkdir -p $HOME/.local/bin + - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH" + - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') )) + - echo $HCNUMVER + +install: + - cabal --version + - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" + - BENCH=${BENCH---enable-benchmarks} + - TEST=${TEST---enable-tests} + - UNCONSTRAINED=${UNCONSTRAINED-true} + - GHCHEAD=${GHCHEAD-false} + - travis_retry cabal update -v + - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config" + - rm -fv cabal.project cabal.project.local + - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$' + - rm -f cabal.project + - touch cabal.project + - "printf 'packages: \"chell\"\\n' >> cabal.project" + - "printf 'packages: \"chell-hunit\"\\n' >> cabal.project" + - "printf 'packages: \"chell-quickcheck\"\\n' >> cabal.project" + - "printf 'write-ghc-environment-files: always\\n' >> cabal.project" + - touch cabal.project.local + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(chell|chell-hunit|chell-quickcheck)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" + - cat cabal.project || true + - cat cabal.project.local || true + - if [ -f "chell/configure.ac" ]; then (cd "chell" && autoreconf -i); fi + - if [ -f "chell-hunit/configure.ac" ]; then (cd "chell-hunit" && autoreconf -i); fi + - if [ -f "chell-quickcheck/configure.ac" ]; then (cd "chell-quickcheck" && autoreconf -i); fi + - rm -f cabal.project.freeze + - cabal new-freeze -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dry + - "cat \"cabal.project.freeze\" | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'" + - rm "cabal.project.freeze" + - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all + - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all + - rm -rf .ghc.environment.* "chell"/dist "chell-hunit"/dist "chell-quickcheck"/dist + - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) + +# Here starts the actual work to be performed for the package under test; +# any command which exits with a non-zero exit code causes the build to fail. +script: + # test that source-distributions can be generated + - cabal new-sdist all + - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/ + - cd ${DISTDIR} || false + - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \; + - rm -f cabal.project + - touch cabal.project + - "printf 'packages: \"chell-*/*.cabal\"\\n' >> cabal.project" + - "printf 'packages: \"chell-hunit-*/*.cabal\"\\n' >> cabal.project" + - "printf 'packages: \"chell-quickcheck-*/*.cabal\"\\n' >> cabal.project" + - "printf 'write-ghc-environment-files: always\\n' >> cabal.project" + - touch cabal.project.local + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(chell|chell-hunit|chell-quickcheck)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" + - cat cabal.project || true + - cat cabal.project.local || true + # this builds all libraries and executables (without tests/benchmarks) + - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all + + # build & run tests, build benchmarks + - cabal new-build -w ${HC} ${TEST} ${BENCH} all + + # cabal check + - (cd chell-* && cabal check) + - (cd chell-hunit-* && cabal check) + - (cd chell-quickcheck-* && cabal check) + + # haddock + - cabal new-haddock -w ${HC} ${TEST} ${BENCH} all + + # Build without installed constraints for packages in global-db + - if $UNCONSTRAINED; then rm -f cabal.project.local; cabal new-build -w ${HC} --disable-tests --disable-benchmarks all; else echo "Not building without installed constraints"; fi + +# REGENDATA ["cabal.project"] +# EOF diff --git a/chell-hunit/chell-hunit.cabal b/chell-hunit/chell-hunit.cabal index 7f69308..c293384 100644 --- a/chell-hunit/chell-hunit.cabal +++ b/chell-hunit/chell-hunit.cabal @@ -15,6 +15,8 @@ synopsis: HUnit support for the Chell testing library description: HUnit support for the testing library. +tested-with: GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3 + source-repository head type: git location: https://john-millikin.com/code/chell/ diff --git a/chell-quickcheck/chell-quickcheck.cabal b/chell-quickcheck/chell-quickcheck.cabal index 42b8040..6e94b5b 100644 --- a/chell-quickcheck/chell-quickcheck.cabal +++ b/chell-quickcheck/chell-quickcheck.cabal @@ -15,6 +15,8 @@ synopsis: QuickCheck support for the Chell testing library description: QuickCheck support for the testing library. +tested-with: GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3 + source-repository head type: git location: https://john-millikin.com/code/chell/ diff --git a/chell/chell.cabal b/chell/chell.cabal index ea5fc22..123caf5 100644 --- a/chell/chell.cabal +++ b/chell/chell.cabal @@ -11,6 +11,9 @@ bug-reports: mailto:jmillikin@gmail.com homepage: https://john-millikin.com/software/chell/ synopsis: A simple and intuitive library for automated testing. + +tested-with: GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3 + description: Chell is a simple and intuitive library for automated testing. It natively supports assertion-based testing, and can use companion libraries From dffe389492139212a175f2d713f7844ea5638faa Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 16 Feb 2019 18:00:47 -0700 Subject: [PATCH 21/36] create readme with text from https://john-millikin.com/software/chell --- readme.md | 72 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 72 insertions(+) create mode 100644 readme.md diff --git a/readme.md b/readme.md new file mode 100644 index 0000000..8dbbac0 --- /dev/null +++ b/readme.md @@ -0,0 +1,72 @@ +# chell + +A quiet test runner for Haskell + +## History + +Back in 2011 or so, the most popular Haskell test frameworks generated a lot of status output but relatively little info about why tests failed. I wrote Chell so my tests would be quiet if they passed, and give to-the-line error info on failure. + +It hasn't seen much development effort the past few years, and its integrations with other test tools such as QuickCheck probably don't build any more. + +## Assertions + +Chell has a small selection of built-in assertions, which cover most simple testing requirements. Use the `$assert` or `$expect` functions to run assertions. See the [Chell API documentation](https://hackage.haskell.org/package/chell/docs/Test-Chell.html) for full type signatures. + +```haskell +{-# LANGUAGE TemplateHaskell #-} + +import Test.Chell + +tests :: Suite +tests = + suite "tests" $ + do + test_Numbers + test_Text + +test_Numbers :: Test +test_Numbers = + assertions "numbers" $ + do + $assert (equal 1 1) + $assert (greater 2 1) + $assert (equalWithin 1.0001 1.0 0.01) + +test_Text :: Test +test_Text = + assertions "text" $ + do + let + str1 = "foo\nbar\nbaz" + str2 = "foo\nbar\nqux" + + $assert (equalLines str1 str2) + +main :: IO () +main = defaultMain [tests] +``` + +## QuickCheck + +Chell also supports running QuickCheck properties, via the [chell-quickcheck](https://hackage.haskell.org/package/chell-quickcheck/docs/Test-Chell-QuickCheck.html) package. + +```haskell +import Test.Chell +import Test.Chell.QuickCheck + +tests :: Suite +tests = + suite "tests" $ + do + test_Equality + test_Increment + +test_Equality :: Test +test_Equality = property "equality" (\x -> x == x) + +test_Increment :: Test +test_Increment = property "equality" (\x -> x + 1 > x) + +main :: IO () +main = defaultMain [tests] +``` From 7c91e5edadb4e66b7a65d4394fe2cd2ea1defb74 Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 16 Feb 2019 18:01:46 -0700 Subject: [PATCH 22/36] update maintainer, homepage, and bug-reports --- chell-hunit/chell-hunit.cabal | 7 ++++--- chell-quickcheck/chell-quickcheck.cabal | 7 ++++--- chell/chell.cabal | 8 ++++---- 3 files changed, 12 insertions(+), 10 deletions(-) diff --git a/chell-hunit/chell-hunit.cabal b/chell-hunit/chell-hunit.cabal index c293384..bc182ae 100644 --- a/chell-hunit/chell-hunit.cabal +++ b/chell-hunit/chell-hunit.cabal @@ -3,12 +3,13 @@ version: 0.2.1 license: MIT license-file: license.txt author: John Millikin -maintainer: John Millikin +maintainer: Chris Martin, Julie Moronuki build-type: Simple cabal-version: >= 1.6 category: Testing -bug-reports: mailto:jmillikin@gmail.com -homepage: https://john-millikin.com/software/chell/ + +homepage: https://github.com/typeclasses/chell +bug-reports: https://github.com/typeclasses/chell/issues synopsis: HUnit support for the Chell testing library diff --git a/chell-quickcheck/chell-quickcheck.cabal b/chell-quickcheck/chell-quickcheck.cabal index 6e94b5b..b4ed605 100644 --- a/chell-quickcheck/chell-quickcheck.cabal +++ b/chell-quickcheck/chell-quickcheck.cabal @@ -3,12 +3,13 @@ version: 0.2.5.1 license: MIT license-file: license.txt author: John Millikin -maintainer: John Millikin +maintainer: Chris Martin, Julie Moronuki build-type: Simple cabal-version: >= 1.6 category: Testing -bug-reports: mailto:jmillikin@gmail.com -homepage: https://john-millikin.com/software/chell/ + +homepage: https://github.com/typeclasses/chell +bug-reports: https://github.com/typeclasses/chell/issues synopsis: QuickCheck support for the Chell testing library diff --git a/chell/chell.cabal b/chell/chell.cabal index 123caf5..e19b662 100644 --- a/chell/chell.cabal +++ b/chell/chell.cabal @@ -3,12 +3,12 @@ version: 0.4.0.2 license: MIT license-file: license.txt author: John Millikin -maintainer: John Millikin +maintainer: Chris Martin, Julie Moronuki build-type: Simple cabal-version: >= 1.6 -category: Testing -bug-reports: mailto:jmillikin@gmail.com -homepage: https://john-millikin.com/software/chell/ + +homepage: https://github.com/typeclasses/chell +bug-reports: https://github.com/typeclasses/chell/issues synopsis: A simple and intuitive library for automated testing. From 335849cea5956fe255f65d993d70e2325a047914 Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 16 Feb 2019 18:03:11 -0700 Subject: [PATCH 23/36] readme: fix example code --- readme.md | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/readme.md b/readme.md index 8dbbac0..816ddec 100644 --- a/readme.md +++ b/readme.md @@ -19,10 +19,10 @@ import Test.Chell tests :: Suite tests = - suite "tests" $ - do - test_Numbers - test_Text + suite "tests" + [ test_Numbers + , test_Text + ] test_Numbers :: Test test_Numbers = @@ -56,10 +56,10 @@ import Test.Chell.QuickCheck tests :: Suite tests = - suite "tests" $ - do - test_Equality - test_Increment + suite "tests" + [ test_Equality + , test_Increment + ] test_Equality :: Test test_Equality = property "equality" (\x -> x == x) From 1b35d03ad46e76a60a203134f3d1e5cd62863289 Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 16 Feb 2019 18:05:59 -0700 Subject: [PATCH 24/36] readme: update history --- readme.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/readme.md b/readme.md index 816ddec..32033d3 100644 --- a/readme.md +++ b/readme.md @@ -4,9 +4,9 @@ A quiet test runner for Haskell ## History -Back in 2011 or so, the most popular Haskell test frameworks generated a lot of status output but relatively little info about why tests failed. I wrote Chell so my tests would be quiet if they passed, and give to-the-line error info on failure. +Back in 2011 or so, the most popular Haskell test frameworks generated a lot of status output but relatively little info about why tests failed. John Millikin wrote Chell so that tests would be quiet if they passed, and give to-the-line error info on failure. -It hasn't seen much development effort the past few years, and its integrations with other test tools such as QuickCheck probably don't build any more. +It hasn't seen much development effort the past few years. As of February 2019, Chris and Julie are keeping it compiling. ## Assertions From 72292c35da4712af59ec30c0be52ebb6fa4e82f0 Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 16 Feb 2019 18:28:54 -0700 Subject: [PATCH 25/36] add "category: Testing" --- chell-hunit/chell-hunit.cabal | 7 ++++--- chell-quickcheck/chell-quickcheck.cabal | 7 ++++--- chell/chell.cabal | 6 ++++-- 3 files changed, 12 insertions(+), 8 deletions(-) diff --git a/chell-hunit/chell-hunit.cabal b/chell-hunit/chell-hunit.cabal index bc182ae..326fae6 100644 --- a/chell-hunit/chell-hunit.cabal +++ b/chell-hunit/chell-hunit.cabal @@ -1,18 +1,19 @@ name: chell-hunit version: 0.2.1 + +synopsis: HUnit support for the Chell testing library +category: Testing + license: MIT license-file: license.txt author: John Millikin maintainer: Chris Martin, Julie Moronuki build-type: Simple cabal-version: >= 1.6 -category: Testing homepage: https://github.com/typeclasses/chell bug-reports: https://github.com/typeclasses/chell/issues -synopsis: HUnit support for the Chell testing library - description: HUnit support for the testing library. diff --git a/chell-quickcheck/chell-quickcheck.cabal b/chell-quickcheck/chell-quickcheck.cabal index b4ed605..2bacea4 100644 --- a/chell-quickcheck/chell-quickcheck.cabal +++ b/chell-quickcheck/chell-quickcheck.cabal @@ -1,18 +1,19 @@ name: chell-quickcheck version: 0.2.5.1 + +synopsis: QuickCheck support for the Chell testing library +category: Testing + license: MIT license-file: license.txt author: John Millikin maintainer: Chris Martin, Julie Moronuki build-type: Simple cabal-version: >= 1.6 -category: Testing homepage: https://github.com/typeclasses/chell bug-reports: https://github.com/typeclasses/chell/issues -synopsis: QuickCheck support for the Chell testing library - description: QuickCheck support for the testing library. diff --git a/chell/chell.cabal b/chell/chell.cabal index e19b662..d82dc05 100644 --- a/chell/chell.cabal +++ b/chell/chell.cabal @@ -1,5 +1,9 @@ name: chell version: 0.4.0.2 + +synopsis: A simple and intuitive library for automated testing. +category: Testing + license: MIT license-file: license.txt author: John Millikin @@ -10,8 +14,6 @@ cabal-version: >= 1.6 homepage: https://github.com/typeclasses/chell bug-reports: https://github.com/typeclasses/chell/issues -synopsis: A simple and intuitive library for automated testing. - tested-with: GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3 description: From 06b7f5645708bbef700a4957e4ce21c4104fcdf5 Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 16 Feb 2019 18:35:21 -0700 Subject: [PATCH 26/36] update source-repository --- chell-hunit/chell-hunit.cabal | 7 +------ chell-quickcheck/chell-quickcheck.cabal | 7 +------ chell/chell.cabal | 7 +------ 3 files changed, 3 insertions(+), 18 deletions(-) diff --git a/chell-hunit/chell-hunit.cabal b/chell-hunit/chell-hunit.cabal index 326fae6..72f0e0c 100644 --- a/chell-hunit/chell-hunit.cabal +++ b/chell-hunit/chell-hunit.cabal @@ -21,12 +21,7 @@ tested-with: GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3 source-repository head type: git - location: https://john-millikin.com/code/chell/ - -source-repository this - type: git - location: https://john-millikin.com/code/chell/ - tag: chell-hunit_0.2.1 + location: https://github.com/typeclasses/chell.git library ghc-options: -Wall diff --git a/chell-quickcheck/chell-quickcheck.cabal b/chell-quickcheck/chell-quickcheck.cabal index 2bacea4..d5bed58 100644 --- a/chell-quickcheck/chell-quickcheck.cabal +++ b/chell-quickcheck/chell-quickcheck.cabal @@ -21,12 +21,7 @@ tested-with: GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3 source-repository head type: git - location: https://john-millikin.com/code/chell/ - -source-repository this - type: git - location: https://john-millikin.com/code/chell/ - tag: chell-quickcheck_0.2.5.1 + location: https://github.com/typeclasses/chell.git library ghc-options: -Wall diff --git a/chell/chell.cabal b/chell/chell.cabal index d82dc05..0b6fdd4 100644 --- a/chell/chell.cabal +++ b/chell/chell.cabal @@ -56,12 +56,7 @@ description: source-repository head type: git - location: https://john-millikin.com/code/chell/ - -source-repository this - type: git - location: https://john-millikin.com/code/chell/ - tag: chell_0.4.0.2 + location: https://github.com/typeclasses/chell.git flag color-output description: Enable colored output in test results From 655375313bdcb82c1e9319fdc1a45f760d830295 Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 16 Feb 2019 18:49:34 -0700 Subject: [PATCH 27/36] add changelogs and bump versions --- chell-hunit/changelog.md | 8 ++++++++ chell-hunit/chell-hunit.cabal | 7 +++++-- chell-quickcheck/changelog.md | 7 +++++++ chell-quickcheck/chell-quickcheck.cabal | 7 +++++-- chell/changelog.md | 9 +++++++++ chell/chell.cabal | 5 ++++- 6 files changed, 38 insertions(+), 5 deletions(-) create mode 100644 chell-hunit/changelog.md create mode 100644 chell-quickcheck/changelog.md create mode 100644 chell/changelog.md diff --git a/chell-hunit/changelog.md b/chell-hunit/changelog.md new file mode 100644 index 0000000..72b6b5a --- /dev/null +++ b/chell-hunit/changelog.md @@ -0,0 +1,8 @@ +# Release history for `chell-hunit` + +0.3 - 2019 Feb 16 + + * Add support for `HUnit` 1.3 through 1.6 + * Drop support for `HUnit` 1.1 through 1.2 + +0.2.1 - 2014 May 18 diff --git a/chell-hunit/chell-hunit.cabal b/chell-hunit/chell-hunit.cabal index 72f0e0c..bed29b0 100644 --- a/chell-hunit/chell-hunit.cabal +++ b/chell-hunit/chell-hunit.cabal @@ -1,5 +1,5 @@ name: chell-hunit -version: 0.2.1 +version: 0.3 synopsis: HUnit support for the Chell testing library category: Testing @@ -19,6 +19,9 @@ description: tested-with: GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3 +extra-source-files: + changelog.md + source-repository head type: git location: https://github.com/typeclasses/chell.git @@ -28,7 +31,7 @@ library build-depends: base >= 4.0 && < 5.0 - , chell >= 0.3 && < 0.5 + , chell >= 0.3 && < 0.6 , HUnit >= 1.3 && < 1.7 exposed-modules: diff --git a/chell-quickcheck/changelog.md b/chell-quickcheck/changelog.md new file mode 100644 index 0000000..c4b066d --- /dev/null +++ b/chell-quickcheck/changelog.md @@ -0,0 +1,7 @@ +# Release history for `chell-quickcheck` + +0.2.5.2 - 2019 Feb 16 + + * Add support for `QuickCheck` 2.12 + +0.2.5.1 - 2017 Dec 12 diff --git a/chell-quickcheck/chell-quickcheck.cabal b/chell-quickcheck/chell-quickcheck.cabal index d5bed58..a877362 100644 --- a/chell-quickcheck/chell-quickcheck.cabal +++ b/chell-quickcheck/chell-quickcheck.cabal @@ -1,5 +1,5 @@ name: chell-quickcheck -version: 0.2.5.1 +version: 0.2.5.2 synopsis: QuickCheck support for the Chell testing library category: Testing @@ -19,6 +19,9 @@ description: tested-with: GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3 +extra-source-files: + changelog.md + source-repository head type: git location: https://github.com/typeclasses/chell.git @@ -28,7 +31,7 @@ library build-depends: base >= 4.0 && < 5.0 - , chell >= 0.3 && < 0.5 + , chell >= 0.3 && < 0.6 , QuickCheck >= 2.3 && < 2.13 , random diff --git a/chell/changelog.md b/chell/changelog.md new file mode 100644 index 0000000..d15883e --- /dev/null +++ b/chell/changelog.md @@ -0,0 +1,9 @@ +# Release history for `chell` + +0.5 - 2019 Feb 16 + + * Add support for `patience` 0.2 + * Drop support for `patience` 0.1 + * Add support for `ansi-terminal` 0.8 + +0.4.0.2 - 2017 Dec 12 diff --git a/chell/chell.cabal b/chell/chell.cabal index 0b6fdd4..9ea99d4 100644 --- a/chell/chell.cabal +++ b/chell/chell.cabal @@ -1,5 +1,5 @@ name: chell -version: 0.4.0.2 +version: 0.5 synopsis: A simple and intuitive library for automated testing. category: Testing @@ -54,6 +54,9 @@ description: PASS: 2 tests run, 2 tests passed @ +extra-source-files: + changelog.md + source-repository head type: git location: https://github.com/typeclasses/chell.git From d2d154596c9f2aeb166f3a4905ee1198166c7ed1 Mon Sep 17 00:00:00 2001 From: Vaibhav Sagar Date: Thu, 29 Aug 2019 14:21:35 -0400 Subject: [PATCH 28/36] chell.cabal: allow newer patience --- chell/chell.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/chell/chell.cabal b/chell/chell.cabal index 9ea99d4..d2e4cd3 100644 --- a/chell/chell.cabal +++ b/chell/chell.cabal @@ -72,7 +72,7 @@ library base >= 4.1 && < 5.0 , bytestring >= 0.9 , options >= 1.0 && < 2.0 - , patience >= 0.2 && < 0.3 + , patience >= 0.2 && < 0.4 , random >= 1.0 , template-haskell >= 2.3 , text From 6cacf60eacfa5ff67d62a14b80682df791ddaa96 Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Fri, 14 Jan 2022 02:11:06 -0700 Subject: [PATCH 29/36] Fix version bounds and enable github actions CI --- .github/workflows/test.yml | 37 ++++++++ .travis.yml | 120 ------------------------ cabal.project | 4 +- chell-hunit/chell-hunit.cabal | 7 +- chell-quickcheck/chell-quickcheck.cabal | 11 +-- chell/chell.cabal | 39 ++++---- configurations/ghc-8.10.project | 13 +++ configurations/ghc-8.2.project | 15 +++ configurations/ghc-8.4.project | 10 ++ configurations/ghc-8.6.project | 11 +++ configurations/ghc-8.8.project | 10 ++ configurations/ghc-9.0.project | 12 +++ configurations/ghc-9.2.project | 15 +++ stack.yaml | 3 - 14 files changed, 153 insertions(+), 154 deletions(-) create mode 100644 .github/workflows/test.yml delete mode 100644 .travis.yml create mode 100644 configurations/ghc-8.10.project create mode 100644 configurations/ghc-8.2.project create mode 100644 configurations/ghc-8.4.project create mode 100644 configurations/ghc-8.6.project create mode 100644 configurations/ghc-8.8.project create mode 100644 configurations/ghc-9.0.project create mode 100644 configurations/ghc-9.2.project delete mode 100644 stack.yaml diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml new file mode 100644 index 0000000..c867e64 --- /dev/null +++ b/.github/workflows/test.yml @@ -0,0 +1,37 @@ +on: [push] + +name: Test + +jobs: + build: + name: Build and test all the packages + runs-on: ${{ matrix.os }} + + strategy: + matrix: + ghc: ['8.2', '8.4', '8.6', '8.8', '8.10', '9.0', '9.2'] + os: ['ubuntu-latest', 'macos-latest'] + + steps: + - uses: actions/checkout@v2 + + - name: Cache Haskell dependencies + uses: actions/cache@v2 + with: + path: | + ~/.cabal/packages + ~/.cabal/store + key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('**/*.cabal', 'configurations/ghc-${{ matrix.ghc }}.project') }} + restore-keys: | + ${{ runner.os }}-${{ matrix.ghc }}- + ${{ runner.os }}- + + - uses: haskell/actions/setup@v1 + with: + ghc-version: ${{ matrix.ghc }} + + - name: Build + run: cabal build all --project-file ./configurations/ghc-${{ matrix.ghc }}.project + + - name: Test + run: cabal test all --enable-tests --project-file ./configurations/ghc-${{ matrix.ghc }}.project diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index d3ea59f..0000000 --- a/.travis.yml +++ /dev/null @@ -1,120 +0,0 @@ -# This Travis job script has been generated by a script via -# -# haskell-ci 'cabal.project' -# -# For more information, see https://github.com/haskell-CI/haskell-ci -# -language: c -dist: xenial - -git: - submodules: false # whether to recursively clone submodules - -cache: - directories: - - $HOME/.cabal/packages - - $HOME/.cabal/store - -before_cache: - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log - # remove files that are regenerated by 'cabal update' - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.* - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx - - - rm -rfv $HOME/.cabal/packages/head.hackage - -matrix: - include: - - compiler: "ghc-8.6.3" - # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.6.3], sources: [hvr-ghc]}} - - compiler: "ghc-8.4.4" - # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.4.4], sources: [hvr-ghc]}} - - compiler: "ghc-8.2.2" - # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.2.2], sources: [hvr-ghc]}} - -before_install: - - HC=${CC} - - HCPKG=${HC/ghc/ghc-pkg} - - unset CC - - ROOTDIR=$(pwd) - - mkdir -p $HOME/.local/bin - - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH" - - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') )) - - echo $HCNUMVER - -install: - - cabal --version - - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - - BENCH=${BENCH---enable-benchmarks} - - TEST=${TEST---enable-tests} - - UNCONSTRAINED=${UNCONSTRAINED-true} - - GHCHEAD=${GHCHEAD-false} - - travis_retry cabal update -v - - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config" - - rm -fv cabal.project cabal.project.local - - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$' - - rm -f cabal.project - - touch cabal.project - - "printf 'packages: \"chell\"\\n' >> cabal.project" - - "printf 'packages: \"chell-hunit\"\\n' >> cabal.project" - - "printf 'packages: \"chell-quickcheck\"\\n' >> cabal.project" - - "printf 'write-ghc-environment-files: always\\n' >> cabal.project" - - touch cabal.project.local - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(chell|chell-hunit|chell-quickcheck)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - - cat cabal.project || true - - cat cabal.project.local || true - - if [ -f "chell/configure.ac" ]; then (cd "chell" && autoreconf -i); fi - - if [ -f "chell-hunit/configure.ac" ]; then (cd "chell-hunit" && autoreconf -i); fi - - if [ -f "chell-quickcheck/configure.ac" ]; then (cd "chell-quickcheck" && autoreconf -i); fi - - rm -f cabal.project.freeze - - cabal new-freeze -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dry - - "cat \"cabal.project.freeze\" | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'" - - rm "cabal.project.freeze" - - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all - - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all - - rm -rf .ghc.environment.* "chell"/dist "chell-hunit"/dist "chell-quickcheck"/dist - - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) - -# Here starts the actual work to be performed for the package under test; -# any command which exits with a non-zero exit code causes the build to fail. -script: - # test that source-distributions can be generated - - cabal new-sdist all - - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/ - - cd ${DISTDIR} || false - - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \; - - rm -f cabal.project - - touch cabal.project - - "printf 'packages: \"chell-*/*.cabal\"\\n' >> cabal.project" - - "printf 'packages: \"chell-hunit-*/*.cabal\"\\n' >> cabal.project" - - "printf 'packages: \"chell-quickcheck-*/*.cabal\"\\n' >> cabal.project" - - "printf 'write-ghc-environment-files: always\\n' >> cabal.project" - - touch cabal.project.local - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(chell|chell-hunit|chell-quickcheck)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - - cat cabal.project || true - - cat cabal.project.local || true - # this builds all libraries and executables (without tests/benchmarks) - - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all - - # build & run tests, build benchmarks - - cabal new-build -w ${HC} ${TEST} ${BENCH} all - - # cabal check - - (cd chell-* && cabal check) - - (cd chell-hunit-* && cabal check) - - (cd chell-quickcheck-* && cabal check) - - # haddock - - cabal new-haddock -w ${HC} ${TEST} ${BENCH} all - - # Build without installed constraints for packages in global-db - - if $UNCONSTRAINED; then rm -f cabal.project.local; cabal new-build -w ${HC} --disable-tests --disable-benchmarks all; else echo "Not building without installed constraints"; fi - -# REGENDATA ["cabal.project"] -# EOF diff --git a/cabal.project b/cabal.project index 03afc6f..7f080cd 100644 --- a/cabal.project +++ b/cabal.project @@ -1 +1,3 @@ -packages: chell/, chell-hunit/, chell-quickcheck/ +packages: chell, chell-hunit, chell-quickcheck + +flags: +color-output diff --git a/chell-hunit/chell-hunit.cabal b/chell-hunit/chell-hunit.cabal index bed29b0..fd4db94 100644 --- a/chell-hunit/chell-hunit.cabal +++ b/chell-hunit/chell-hunit.cabal @@ -1,3 +1,5 @@ +cabal-version: 3.0 + name: chell-hunit version: 0.3 @@ -9,7 +11,6 @@ license-file: license.txt author: John Millikin maintainer: Chris Martin, Julie Moronuki build-type: Simple -cabal-version: >= 1.6 homepage: https://github.com/typeclasses/chell bug-reports: https://github.com/typeclasses/chell/issues @@ -17,8 +18,6 @@ bug-reports: https://github.com/typeclasses/chell/issues description: HUnit support for the testing library. -tested-with: GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3 - extra-source-files: changelog.md @@ -30,7 +29,7 @@ library ghc-options: -Wall build-depends: - base >= 4.0 && < 5.0 + base >= 4.10 && < 4.17 , chell >= 0.3 && < 0.6 , HUnit >= 1.3 && < 1.7 diff --git a/chell-quickcheck/chell-quickcheck.cabal b/chell-quickcheck/chell-quickcheck.cabal index a877362..4ace48f 100644 --- a/chell-quickcheck/chell-quickcheck.cabal +++ b/chell-quickcheck/chell-quickcheck.cabal @@ -1,3 +1,5 @@ +cabal-version: 3.0 + name: chell-quickcheck version: 0.2.5.2 @@ -9,7 +11,6 @@ license-file: license.txt author: John Millikin maintainer: Chris Martin, Julie Moronuki build-type: Simple -cabal-version: >= 1.6 homepage: https://github.com/typeclasses/chell bug-reports: https://github.com/typeclasses/chell/issues @@ -17,8 +18,6 @@ bug-reports: https://github.com/typeclasses/chell/issues description: QuickCheck support for the testing library. -tested-with: GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3 - extra-source-files: changelog.md @@ -30,10 +29,10 @@ library ghc-options: -Wall build-depends: - base >= 4.0 && < 5.0 + base >= 4.10 && < 4.17 , chell >= 0.3 && < 0.6 - , QuickCheck >= 2.3 && < 2.13 - , random + , QuickCheck >= 2.7 && < 2.15 + , random >= 1.1 && < 1.3 exposed-modules: Test.Chell.QuickCheck diff --git a/chell/chell.cabal b/chell/chell.cabal index d2e4cd3..ee921b6 100644 --- a/chell/chell.cabal +++ b/chell/chell.cabal @@ -1,3 +1,5 @@ +cabal-version: 3.0 + name: chell version: 0.5 @@ -9,45 +11,42 @@ license-file: license.txt author: John Millikin maintainer: Chris Martin, Julie Moronuki build-type: Simple -cabal-version: >= 1.6 homepage: https://github.com/typeclasses/chell bug-reports: https://github.com/typeclasses/chell/issues -tested-with: GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3 - description: Chell is a simple and intuitive library for automated testing. It natively supports assertion-based testing, and can use companion libraries such as @chell-quickcheck@ to support more complex testing strategies. - . - An example test suite, which verifies the behavior of artithmetic operators. - . + + An example test suite, which verifies the behavior of arithmetic operators. + @ {-\# LANGUAGE TemplateHaskell \#-} - . + import Test.Chell - . + tests_Math :: Suite tests_Math = suite \"math\" [ test_Addition , test_Subtraction ] - . + test_Addition :: Test test_Addition = assertions \"addition\" $ do $expect (equal (2 + 1) 3) $expect (equal (1 + 2) 3) - . + test_Subtraction :: Test test_Subtraction = assertions \"subtraction\" $ do $expect (equal (2 - 1) 1) $expect (equal (1 - 2) (-1)) - . + main :: IO () main = defaultMain [tests_Math] @ - . + @ $ ghc --make chell-example.hs $ ./chell-example @@ -69,18 +68,18 @@ library ghc-options: -Wall build-depends: - base >= 4.1 && < 5.0 - , bytestring >= 0.9 - , options >= 1.0 && < 2.0 + base >= 4.10 && < 4.17 + , bytestring >= 0.10.8.2 && < 0.12 + , options >= 1.2.1 && < 1.3 , patience >= 0.2 && < 0.4 - , random >= 1.0 - , template-haskell >= 2.3 - , text - , transformers >= 0.2 + , random >= 1.1 && < 1.3 + , template-haskell >= 2.12 && < 2.19 + , text >= 1.2.3 && < 1.2.6 + , transformers >= 0.5.2 && < 0.6 if flag(color-output) build-depends: - ansi-terminal >= 0.5 && < 0.9 + ansi-terminal >= 0.8 && < 0.12 exposed-modules: Test.Chell diff --git a/configurations/ghc-8.10.project b/configurations/ghc-8.10.project new file mode 100644 index 0000000..3eb862f --- /dev/null +++ b/configurations/ghc-8.10.project @@ -0,0 +1,13 @@ +packages: chell, chell-hunit, chell-quickcheck + +package chell + flags: +color-output + +constraints: + ansi-terminal ^>= 0.10 + , base ^>= 4.14 + , bytestring == 0.11.0.0 + , patience == 0.2.1.1 + , QuickCheck ^>= 2.13 + , template-haskell ^>= 2.16 + , text == 1.2.4.* diff --git a/configurations/ghc-8.2.project b/configurations/ghc-8.2.project new file mode 100644 index 0000000..8638618 --- /dev/null +++ b/configurations/ghc-8.2.project @@ -0,0 +1,15 @@ +packages: chell, chell-hunit, chell-quickcheck + +package chell + flags: +color-output + +constraints: + ansi-terminal ^>= 0.8 + , base ^>= 4.10 + , bytestring == 0.10.8.2 + , HUnit ^>= 1.3 + , patience == 0.2.0.0 + , QuickCheck ^>= 2.7 + , random == 1.1 + , template-haskell ^>= 2.12 + , transformers == 0.5.2.* diff --git a/configurations/ghc-8.4.project b/configurations/ghc-8.4.project new file mode 100644 index 0000000..0148c97 --- /dev/null +++ b/configurations/ghc-8.4.project @@ -0,0 +1,10 @@ +packages: chell, chell-hunit, chell-quickcheck + +package chell + flags: +color-output + +constraints: + base ^>= 4.11 + , QuickCheck ^>= 2.8 + , template-haskell ^>= 2.13 + , text == 1.2.3.* diff --git a/configurations/ghc-8.6.project b/configurations/ghc-8.6.project new file mode 100644 index 0000000..8e724ba --- /dev/null +++ b/configurations/ghc-8.6.project @@ -0,0 +1,11 @@ +packages: chell, chell-hunit, chell-quickcheck + +package chell + flags: +color-output + +constraints: + ansi-terminal ^>= 0.9 + , base ^>= 4.12 + , patience == 0.2.1.0 + , QuickCheck ^>= 2.9 + , template-haskell ^>= 2.14 diff --git a/configurations/ghc-8.8.project b/configurations/ghc-8.8.project new file mode 100644 index 0000000..f48d918 --- /dev/null +++ b/configurations/ghc-8.8.project @@ -0,0 +1,10 @@ +packages: chell, chell-hunit, chell-quickcheck + +package chell + flags: +color-output + +constraints: + base ^>= 4.13 + , bytestring == 0.10.8.2 + , QuickCheck ^>= 2.13 + , template-haskell ^>= 2.15 diff --git a/configurations/ghc-9.0.project b/configurations/ghc-9.0.project new file mode 100644 index 0000000..c3f6a63 --- /dev/null +++ b/configurations/ghc-9.0.project @@ -0,0 +1,12 @@ +packages: chell, chell-hunit, chell-quickcheck + +package chell + flags: +color-output + +constraints: + base ^>= 4.15 + , bytestring == 0.11.1.0 + , QuickCheck ^>= 2.14 + , random == 1.2.0 + , template-haskell ^>= 2.17 + , transformers == 0.5.6.* diff --git a/configurations/ghc-9.2.project b/configurations/ghc-9.2.project new file mode 100644 index 0000000..da397fb --- /dev/null +++ b/configurations/ghc-9.2.project @@ -0,0 +1,15 @@ +packages: chell, chell-hunit, chell-quickcheck + +package chell + flags: +color-output + +constraints: + ansi-terminal ^>= 0.11 + , base ^>= 4.16 + , bytestring == 0.11.2.0 + , HUnit ^>= 1.6 + , patience == 0.3 + , QuickCheck ^>= 2.14 + , random == 1.2.1 + , template-haskell ^>= 2.18 + , text == 1.2.5.* diff --git a/stack.yaml b/stack.yaml deleted file mode 100644 index bf68b6b..0000000 --- a/stack.yaml +++ /dev/null @@ -1,3 +0,0 @@ -resolver: "lts-13.7" -packages: [chell, chell-hunit, chell-quickcheck] -extra-deps: [patience-0.2.1.0] From b54e5356734c5d9ffd2ee4bab45a0993a5f25e3a Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Fri, 14 Jan 2022 03:41:49 -0700 Subject: [PATCH 30/36] bump versions --- chell-hunit/changelog.md | 5 +++++ chell-hunit/chell-hunit.cabal | 2 +- chell-quickcheck/changelog.md | 5 +++++ chell-quickcheck/chell-quickcheck.cabal | 2 +- chell/changelog.md | 5 +++++ chell/chell.cabal | 2 +- 6 files changed, 18 insertions(+), 3 deletions(-) diff --git a/chell-hunit/changelog.md b/chell-hunit/changelog.md index 72b6b5a..fa7ec87 100644 --- a/chell-hunit/changelog.md +++ b/chell-hunit/changelog.md @@ -1,5 +1,10 @@ # Release history for `chell-hunit` +0.3.0.1 - 2021 Jan 14 + + * Support up to GHC 9.2 + * Tighten various version bounds + 0.3 - 2019 Feb 16 * Add support for `HUnit` 1.3 through 1.6 diff --git a/chell-hunit/chell-hunit.cabal b/chell-hunit/chell-hunit.cabal index fd4db94..1746926 100644 --- a/chell-hunit/chell-hunit.cabal +++ b/chell-hunit/chell-hunit.cabal @@ -1,7 +1,7 @@ cabal-version: 3.0 name: chell-hunit -version: 0.3 +version: 0.3.0.1 synopsis: HUnit support for the Chell testing library category: Testing diff --git a/chell-quickcheck/changelog.md b/chell-quickcheck/changelog.md index c4b066d..b7a5795 100644 --- a/chell-quickcheck/changelog.md +++ b/chell-quickcheck/changelog.md @@ -1,5 +1,10 @@ # Release history for `chell-quickcheck` +0.2.5.3 - 2021 Jan 14 + + * Support up to GHC 9.2 + * Tighten various version bounds + 0.2.5.2 - 2019 Feb 16 * Add support for `QuickCheck` 2.12 diff --git a/chell-quickcheck/chell-quickcheck.cabal b/chell-quickcheck/chell-quickcheck.cabal index 4ace48f..0f359e7 100644 --- a/chell-quickcheck/chell-quickcheck.cabal +++ b/chell-quickcheck/chell-quickcheck.cabal @@ -1,7 +1,7 @@ cabal-version: 3.0 name: chell-quickcheck -version: 0.2.5.2 +version: 0.2.5.3 synopsis: QuickCheck support for the Chell testing library category: Testing diff --git a/chell/changelog.md b/chell/changelog.md index d15883e..4cb6a58 100644 --- a/chell/changelog.md +++ b/chell/changelog.md @@ -1,5 +1,10 @@ # Release history for `chell` +0.5.0.1 - 2021 Jan 14 + + * Support up to GHC 9.2 + * Tighten various version bounds + 0.5 - 2019 Feb 16 * Add support for `patience` 0.2 diff --git a/chell/chell.cabal b/chell/chell.cabal index ee921b6..3d5627b 100644 --- a/chell/chell.cabal +++ b/chell/chell.cabal @@ -1,7 +1,7 @@ cabal-version: 3.0 name: chell -version: 0.5 +version: 0.5.0.1 synopsis: A simple and intuitive library for automated testing. category: Testing From 5fbc0504943b724387da8a7dc2ded13ff80e7ec1 Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Fri, 14 Jan 2022 03:42:33 -0700 Subject: [PATCH 31/36] add default-language --- chell-hunit/chell-hunit.cabal | 1 + chell-quickcheck/chell-quickcheck.cabal | 1 + chell/chell.cabal | 1 + 3 files changed, 3 insertions(+) diff --git a/chell-hunit/chell-hunit.cabal b/chell-hunit/chell-hunit.cabal index 1746926..0088eca 100644 --- a/chell-hunit/chell-hunit.cabal +++ b/chell-hunit/chell-hunit.cabal @@ -26,6 +26,7 @@ source-repository head location: https://github.com/typeclasses/chell.git library + default-language: Haskell2010 ghc-options: -Wall build-depends: diff --git a/chell-quickcheck/chell-quickcheck.cabal b/chell-quickcheck/chell-quickcheck.cabal index 0f359e7..12c934c 100644 --- a/chell-quickcheck/chell-quickcheck.cabal +++ b/chell-quickcheck/chell-quickcheck.cabal @@ -26,6 +26,7 @@ source-repository head location: https://github.com/typeclasses/chell.git library + default-language: Haskell2010 ghc-options: -Wall build-depends: diff --git a/chell/chell.cabal b/chell/chell.cabal index 3d5627b..555fbbd 100644 --- a/chell/chell.cabal +++ b/chell/chell.cabal @@ -65,6 +65,7 @@ flag color-output default: True library + default-language: Haskell2010 ghc-options: -Wall build-depends: From e48eb91ffcda3adfb1ab8d881a39f9b410623e8c Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Tue, 11 Jul 2023 15:33:08 -0600 Subject: [PATCH 32/36] miscellaneous updates and cleanup --- .envrc | 3 + .github/workflows/test.yml | 37 -- .gitignore | 2 + chell-hunit/Setup.hs | 2 - chell-hunit/Test/Chell/HUnit.hs | 28 +- chell-hunit/changelog.md | 36 +- chell-hunit/chell-hunit.cabal | 33 +- chell-hunit/license.txt | 23 +- chell-hunit/readme.md | 3 + chell-quickcheck/Setup.hs | 2 - chell-quickcheck/Test/Chell/QuickCheck.hs | 167 ++--- chell-quickcheck/changelog.md | 33 +- chell-quickcheck/chell-quickcheck.cabal | 35 +- chell-quickcheck/license.txt | 23 +- chell-quickcheck/readme.md | 24 + chell/Setup.hs | 2 - chell/Test/Chell.hs | 704 +++++++++++----------- chell/Test/Chell/Main.hs | 562 +++++++++-------- chell/Test/Chell/Output.hs | 110 ++-- chell/Test/Chell/Types.hs | 290 ++++----- chell/changelog.md | 39 +- chell/chell.cabal | 100 +-- chell/license.txt | 23 +- chell/readme.md | 33 + configurations/ghc-8.10.project | 13 - configurations/ghc-8.2.project | 15 - configurations/ghc-8.4.project | 10 - configurations/ghc-8.6.project | 11 - configurations/ghc-8.8.project | 10 - configurations/ghc-9.0.project | 12 - configurations/ghc-9.2.project | 15 - flake.lock | 61 ++ flake.nix | 14 + license.txt | 22 - nix/default.nix | 88 +++ nix/haskell/monads-tf.nix | 10 + nix/haskell/options.nix | 13 + readme.md | 6 + 38 files changed, 1349 insertions(+), 1265 deletions(-) create mode 100644 .envrc delete mode 100644 .github/workflows/test.yml delete mode 100644 chell-hunit/Setup.hs mode change 120000 => 100644 chell-hunit/license.txt create mode 100644 chell-hunit/readme.md delete mode 100644 chell-quickcheck/Setup.hs mode change 120000 => 100644 chell-quickcheck/license.txt create mode 100644 chell-quickcheck/readme.md delete mode 100644 chell/Setup.hs mode change 120000 => 100644 chell/license.txt create mode 100644 chell/readme.md delete mode 100644 configurations/ghc-8.10.project delete mode 100644 configurations/ghc-8.2.project delete mode 100644 configurations/ghc-8.4.project delete mode 100644 configurations/ghc-8.6.project delete mode 100644 configurations/ghc-8.8.project delete mode 100644 configurations/ghc-9.0.project delete mode 100644 configurations/ghc-9.2.project create mode 100644 flake.lock create mode 100644 flake.nix delete mode 100644 license.txt create mode 100644 nix/default.nix create mode 100644 nix/haskell/monads-tf.nix create mode 100644 nix/haskell/options.nix diff --git a/.envrc b/.envrc new file mode 100644 index 0000000..cbc5034 --- /dev/null +++ b/.envrc @@ -0,0 +1,3 @@ +use flake + +watch_file **/*.cabal cabal.project.freeze **/*.nix flake.lock diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml deleted file mode 100644 index c867e64..0000000 --- a/.github/workflows/test.yml +++ /dev/null @@ -1,37 +0,0 @@ -on: [push] - -name: Test - -jobs: - build: - name: Build and test all the packages - runs-on: ${{ matrix.os }} - - strategy: - matrix: - ghc: ['8.2', '8.4', '8.6', '8.8', '8.10', '9.0', '9.2'] - os: ['ubuntu-latest', 'macos-latest'] - - steps: - - uses: actions/checkout@v2 - - - name: Cache Haskell dependencies - uses: actions/cache@v2 - with: - path: | - ~/.cabal/packages - ~/.cabal/store - key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('**/*.cabal', 'configurations/ghc-${{ matrix.ghc }}.project') }} - restore-keys: | - ${{ runner.os }}-${{ matrix.ghc }}- - ${{ runner.os }}- - - - uses: haskell/actions/setup@v1 - with: - ghc-version: ${{ matrix.ghc }} - - - name: Build - run: cabal build all --project-file ./configurations/ghc-${{ matrix.ghc }}.project - - - name: Test - run: cabal test all --enable-tests --project-file ./configurations/ghc-${{ matrix.ghc }}.project diff --git a/.gitignore b/.gitignore index fa9c82d..fcc048c 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,5 @@ dist dist-* .ghc.* +result +result-* diff --git a/chell-hunit/Setup.hs b/chell-hunit/Setup.hs deleted file mode 100644 index 9a994af..0000000 --- a/chell-hunit/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/chell-hunit/Test/Chell/HUnit.hs b/chell-hunit/Test/Chell/HUnit.hs index d6d9c94..94707bb 100644 --- a/chell-hunit/Test/Chell/HUnit.hs +++ b/chell-hunit/Test/Chell/HUnit.hs @@ -1,20 +1,18 @@ -module Test.Chell.HUnit - ( hunit - ) where +module Test.Chell.HUnit (hunit) where import qualified Test.Chell as Chell -import Test.HUnit.Lang (Assertion, Result (..), performTestCase) +import Test.HUnit.Lang (Assertion, Result (..), performTestCase) -- | Convert a sequence of HUnit assertions (embedded in IO) to a Chell -- 'Chell.Test'. -- -- @ ---import Test.Chell ---import Test.Chell.HUnit ---import Test.HUnit +-- import Test.Chell +-- import Test.Chell.HUnit +-- import Test.HUnit -- ---test_Addition :: Test ---test_addition = hunit \"addition\" $ do +-- test_Addition :: Test +-- test_addition = hunit \"addition\" $ do -- 1 + 2 \@?= 3 -- 2 + 3 \@?= 5 -- @ @@ -25,8 +23,10 @@ hunit name io = Chell.test name chell_io do result <- performTestCase io return $ - case result of - Success -> Chell.TestPassed [] - Failure _ msg -> Chell.TestFailed [] - [Chell.failure { Chell.failureMessage = msg }] - Error _ msg -> Chell.TestAborted [] msg + case result of + Success -> Chell.TestPassed [] + Failure _ msg -> + Chell.TestFailed + [] + [Chell.failure {Chell.failureMessage = msg}] + Error _ msg -> Chell.TestAborted [] msg diff --git a/chell-hunit/changelog.md b/chell-hunit/changelog.md index fa7ec87..d2eb9b0 100644 --- a/chell-hunit/changelog.md +++ b/chell-hunit/changelog.md @@ -1,13 +1,33 @@ -# Release history for `chell-hunit` +## 0.3.0.2 -0.3.0.1 - 2021 Jan 14 +Miscellaneous updates and cleanup - * Support up to GHC 9.2 - * Tighten various version bounds +Published by: Chris Martin -0.3 - 2019 Feb 16 +Date: 2023-07-11 - * Add support for `HUnit` 1.3 through 1.6 - * Drop support for `HUnit` 1.1 through 1.2 +## 0.3.0.1 -0.2.1 - 2014 May 18 +Support up to GHC 9.2 + +Tighten various version bounds + +Published by: Chris Martin + +Date: 2021-01-14 + +## 0.3 + +Add support for `HUnit` 1.3 through 1.6 + +Drop support for `HUnit` 1.1 through 1.2 + +Published by: Chris Martin + +Date: 2019-02-16 + +## 0.2.1 + +Published by: John Millikin + +Date: 2014-05-18 diff --git a/chell-hunit/chell-hunit.cabal b/chell-hunit/chell-hunit.cabal index 0088eca..55703cf 100644 --- a/chell-hunit/chell-hunit.cabal +++ b/chell-hunit/chell-hunit.cabal @@ -1,38 +1,31 @@ cabal-version: 3.0 name: chell-hunit -version: 0.3.0.1 +version: 0.3.0.2 -synopsis: HUnit support for the Chell testing library +synopsis: HUnit support for Chell category: Testing license: MIT license-file: license.txt author: John Millikin maintainer: Chris Martin, Julie Moronuki -build-type: Simple -homepage: https://github.com/typeclasses/chell -bug-reports: https://github.com/typeclasses/chell/issues +homepage: https://github.com/typeclasses/chell description: - HUnit support for the testing library. + HUnit support for the Chell testing library. -extra-source-files: - changelog.md - -source-repository head - type: git - location: https://github.com/typeclasses/chell.git +extra-source-files: *.md library - default-language: Haskell2010 - ghc-options: -Wall + default-language: GHC2021 + ghc-options: -Wall - build-depends: - base >= 4.10 && < 4.17 - , chell >= 0.3 && < 0.6 - , HUnit >= 1.3 && < 1.7 + build-depends: + , base ^>= 4.16 || ^>= 4.17 || ^>= 4.18 + , chell ^>= 0.5 + , HUnit ^>= 1.6.2 - exposed-modules: - Test.Chell.HUnit + exposed-modules: + Test.Chell.HUnit diff --git a/chell-hunit/license.txt b/chell-hunit/license.txt deleted file mode 120000 index 0194195..0000000 --- a/chell-hunit/license.txt +++ /dev/null @@ -1 +0,0 @@ -../license.txt \ No newline at end of file diff --git a/chell-hunit/license.txt b/chell-hunit/license.txt new file mode 100644 index 0000000..2cdd7ee --- /dev/null +++ b/chell-hunit/license.txt @@ -0,0 +1,22 @@ +Copyright (c) 2011 John Millikin + +Permission is hereby granted, free of charge, to any person +obtaining a copy of this software and associated documentation +files (the "Software"), to deal in the Software without +restriction, including without limitation the rights to use, +copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the +Software is furnished to do so, subject to the following +conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +OTHER DEALINGS IN THE SOFTWARE. diff --git a/chell-hunit/readme.md b/chell-hunit/readme.md new file mode 100644 index 0000000..69ce297 --- /dev/null +++ b/chell-hunit/readme.md @@ -0,0 +1,3 @@ +HUnit support for the [Chell] testing library. + + [Chell]: https://hackage.haskell.org/package/chell diff --git a/chell-quickcheck/Setup.hs b/chell-quickcheck/Setup.hs deleted file mode 100644 index 9a994af..0000000 --- a/chell-quickcheck/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/chell-quickcheck/Test/Chell/QuickCheck.hs b/chell-quickcheck/Test/Chell/QuickCheck.hs index ccf2bfd..ea1c488 100644 --- a/chell-quickcheck/Test/Chell/QuickCheck.hs +++ b/chell-quickcheck/Test/Chell/QuickCheck.hs @@ -1,140 +1,81 @@ -{-# LANGUAGE CPP #-} +module Test.Chell.QuickCheck (property) where -module Test.Chell.QuickCheck - ( property - ) where - -import Data.Monoid (mempty) -import System.Random (mkStdGen) - -import qualified Test.Chell as Chell -import qualified Test.QuickCheck as QuickCheck -import qualified Test.QuickCheck.Gen as Gen -#if MIN_VERSION_QuickCheck(2,7,0) -import Test.QuickCheck.Property (unProperty) -import qualified Test.QuickCheck.Random as QCRandom -#endif -import qualified Test.QuickCheck.State as State -import qualified Test.QuickCheck.Test as Test -import qualified Test.QuickCheck.Text as Text +import Test.Chell qualified as Chell +import Test.QuickCheck qualified as QuickCheck +import Test.QuickCheck.Random qualified as QCRandom +import Test.QuickCheck.State qualified as State +import Test.QuickCheck.Test qualified as Test +import Test.QuickCheck.Text qualified as Text -- | Convert a QuickCheck property to a Chell 'Chell.Test'. -- -- @ ---import Test.Chell ---import Test.Chell.QuickCheck ---import Test.QuickCheck hiding (property) +-- import Test.Chell +-- import Test.Chell.QuickCheck +-- import Test.QuickCheck hiding (property) -- ---test_NullLength :: Test ---test_NullLength = property \"null-length\" +-- test_NullLength :: Test +-- test_NullLength = property \"null-length\" -- (\xs -> not (null xs) ==> length xs > 0) -- @ property :: QuickCheck.Testable prop => String -> prop -> Chell.Test -#if MIN_VERSION_QuickCheck(2,6,0) property name prop = Chell.test name $ \opts -> Text.withNullTerminal $ \term -> do -#else -property name prop = Chell.test name $ \opts -> - do - term <- Text.newNullTerminal -#endif - - let - seed = Chell.testOptionSeed opts + let seed = Chell.testOptionSeed opts args = QuickCheck.stdArgs - state = State.MkState - { State.terminal = term - , State.maxSuccessTests = QuickCheck.maxSuccess args -#if MIN_VERSION_QuickCheck(2,10,1) - , State.maxDiscardedRatio = QuickCheck.maxDiscardRatio args -#else - , State.maxDiscardedTests = maxDiscardedTests args prop -#endif - - , State.computeSize = computeSize (QuickCheck.maxSize args) (QuickCheck.maxSuccess args) - , State.numSuccessTests = 0 - , State.numDiscardedTests = 0 -#if MIN_VERSION_QuickCheck(2,12,0) - , State.classes = mempty - , State.tables = mempty - , State.requiredCoverage = mempty - , State.expected = True - , State.coverageConfidence = Nothing -#else - , State.collected = [] - , State.expectedFailure = False -#endif - -#if MIN_VERSION_QuickCheck(2,7,0) - , State.randomSeed = QCRandom.mkQCGen seed -#else - , State.randomSeed = mkStdGen seed -#endif - , State.numSuccessShrinks = 0 - , State.numTryShrinks = 0 -#if MIN_VERSION_QuickCheck(2,5,0) - , State.numTotTryShrinks = 0 -#endif -#if MIN_VERSION_QuickCheck(2,5,1) - , State.numRecentlyDiscardedTests = 0 -#endif -#if MIN_VERSION_QuickCheck(2,8,0) - , State.labels = mempty -#endif -#if MIN_VERSION_QuickCheck(2,10,0) - , State.numTotMaxShrinks = QuickCheck.maxShrinks args -#endif + state = + State.MkState + { State.terminal = term, + State.maxSuccessTests = QuickCheck.maxSuccess args, + State.maxDiscardedRatio = QuickCheck.maxDiscardRatio args, + State.computeSize = computeSize (QuickCheck.maxSize args) (QuickCheck.maxSuccess args), + State.numSuccessTests = 0, + State.numDiscardedTests = 0, + State.classes = mempty, + State.tables = mempty, + State.requiredCoverage = mempty, + State.expected = True, + State.coverageConfidence = Nothing, + State.randomSeed = QCRandom.mkQCGen seed, + State.numSuccessShrinks = 0, + State.numTryShrinks = 0, + State.numTotTryShrinks = 0, + State.numRecentlyDiscardedTests = 0, + State.labels = mempty, + State.numTotMaxShrinks = QuickCheck.maxShrinks args } -#if MIN_VERSION_QuickCheck(2,12,0) result <- Test.test state (QuickCheck.property prop) -#else -#if MIN_VERSION_QuickCheck(2,7,0) - let - genProp = unProperty (QuickCheck.property prop) -#else - let - genProp = QuickCheck.property prop -#endif - result <- Test.test state (Gen.unGen genProp) -#endif - let - output = Test.output result + let output = Test.output result notes = [("seed", show seed)] - failure = Chell.failure { Chell.failureMessage = output } + failure = Chell.failure {Chell.failureMessage = output} return $ - case result of - Test.Success{} -> Chell.TestPassed notes - Test.Failure{} -> Chell.TestFailed notes [failure] - Test.GaveUp{} -> Chell.TestAborted notes output - Test.NoExpectedFailure{} -> Chell.TestFailed notes [failure] + case result of + Test.Success {} -> Chell.TestPassed notes + Test.Failure {} -> Chell.TestFailed notes [failure] + Test.GaveUp {} -> Chell.TestAborted notes output + Test.NoExpectedFailure {} -> Chell.TestFailed notes [failure] -- copied from quickcheck-2.4.1.1/src/Test/QuickCheck/Test.hs computeSize :: Int -> Int -> Int -> Int -> Int computeSize maxSize maxSuccess n d - -- e.g. with maxSuccess = 250, maxSize = 100, goes like this: - -- 0, 1, 2, ..., 99, 0, 1, 2, ..., 99, 0, 2, 4, ..., 98. - | n `roundTo` maxSize + maxSize <= maxSuccess || - n >= maxSuccess || - maxSuccess `mod` maxSize == 0 = - n `mod` maxSize + d `div` 10 - | otherwise = - (n `mod` maxSize) * maxSize `div` (maxSuccess `mod` maxSize) + d `div` 10 + -- e.g. with maxSuccess = 250, maxSize = 100, goes like this: + -- 0, 1, 2, ..., 99, 0, 1, 2, ..., 99, 0, 2, 4, ..., 98. + | n + `roundTo` maxSize + + maxSize + <= maxSuccess + || n + >= maxSuccess + || maxSuccess + `mod` maxSize + == 0 = + n `mod` maxSize + d `div` 10 + | otherwise = + (n `mod` maxSize) * maxSize `div` (maxSuccess `mod` maxSize) + d `div` 10 roundTo :: Int -> Int -> Int roundTo n m = (n `div` m) * m - -maxDiscardedTests :: QuickCheck.Testable prop => QuickCheck.Args -> prop -> Int -#if MIN_VERSION_QuickCheck(2,9,0) -maxDiscardedTests args _ = QuickCheck.maxDiscardRatio args -#elif MIN_VERSION_QuickCheck(2,5,0) -maxDiscardedTests args p = - if QuickCheck.exhaustive p - then QuickCheck.maxDiscardRatio args - else QuickCheck.maxDiscardRatio args * QuickCheck.maxSuccess args -#else -maxDiscardedTests args _ = QuickCheck.maxDiscard args -#endif diff --git a/chell-quickcheck/changelog.md b/chell-quickcheck/changelog.md index b7a5795..c01f163 100644 --- a/chell-quickcheck/changelog.md +++ b/chell-quickcheck/changelog.md @@ -1,12 +1,31 @@ -# Release history for `chell-quickcheck` +## 0.2.5.4 -0.2.5.3 - 2021 Jan 14 +Miscellaneous updates and cleanup - * Support up to GHC 9.2 - * Tighten various version bounds +Published by: Chris Martin -0.2.5.2 - 2019 Feb 16 +Date: 2023-07-11 - * Add support for `QuickCheck` 2.12 +## 0.2.5.3 -0.2.5.1 - 2017 Dec 12 +Support up to GHC 9.2 + +Tighten various version bounds + +Published by: Chris Martin + +Date: 2021-01-14 + +## 0.2.5.2 + +Add support for `QuickCheck` 2.12 + +Published by: Chris Martin + +Date: 2019-02-16 + +## 0.2.5.1 + +Published by: John Millikin + +Date: 2017-12-12 diff --git a/chell-quickcheck/chell-quickcheck.cabal b/chell-quickcheck/chell-quickcheck.cabal index 12c934c..dbb922b 100644 --- a/chell-quickcheck/chell-quickcheck.cabal +++ b/chell-quickcheck/chell-quickcheck.cabal @@ -1,39 +1,32 @@ cabal-version: 3.0 name: chell-quickcheck -version: 0.2.5.3 +version: 0.2.5.4 -synopsis: QuickCheck support for the Chell testing library +synopsis: QuickCheck support for Chell category: Testing license: MIT license-file: license.txt author: John Millikin maintainer: Chris Martin, Julie Moronuki -build-type: Simple -homepage: https://github.com/typeclasses/chell -bug-reports: https://github.com/typeclasses/chell/issues +homepage: https://github.com/typeclasses/chell description: - QuickCheck support for the testing library. + QuickCheck support for the Chell testing library. -extra-source-files: - changelog.md - -source-repository head - type: git - location: https://github.com/typeclasses/chell.git +extra-source-files: *.md library - default-language: Haskell2010 - ghc-options: -Wall + default-language: GHC2021 + ghc-options: -Wall - build-depends: - base >= 4.10 && < 4.17 - , chell >= 0.3 && < 0.6 - , QuickCheck >= 2.7 && < 2.15 - , random >= 1.1 && < 1.3 + build-depends: + , base ^>= 4.16 || ^>= 4.17 || ^>= 4.18 + , chell ^>= 0.5 + , QuickCheck ^>= 2.14.2 + , random ^>= 1.2.1 - exposed-modules: - Test.Chell.QuickCheck + exposed-modules: + Test.Chell.QuickCheck diff --git a/chell-quickcheck/license.txt b/chell-quickcheck/license.txt deleted file mode 120000 index 0194195..0000000 --- a/chell-quickcheck/license.txt +++ /dev/null @@ -1 +0,0 @@ -../license.txt \ No newline at end of file diff --git a/chell-quickcheck/license.txt b/chell-quickcheck/license.txt new file mode 100644 index 0000000..2cdd7ee --- /dev/null +++ b/chell-quickcheck/license.txt @@ -0,0 +1,22 @@ +Copyright (c) 2011 John Millikin + +Permission is hereby granted, free of charge, to any person +obtaining a copy of this software and associated documentation +files (the "Software"), to deal in the Software without +restriction, including without limitation the rights to use, +copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the +Software is furnished to do so, subject to the following +conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +OTHER DEALINGS IN THE SOFTWARE. diff --git a/chell-quickcheck/readme.md b/chell-quickcheck/readme.md new file mode 100644 index 0000000..dd31692 --- /dev/null +++ b/chell-quickcheck/readme.md @@ -0,0 +1,24 @@ +QuickCheck support for the [Chell] testing library. + + [Chell]: https://hackage.haskell.org/package/chell + +```haskell +import Test.Chell +import Test.Chell.QuickCheck + +tests :: Suite +tests = + suite "tests" + [ test_Equality + , test_Increment + ] + +test_Equality :: Test +test_Equality = property "equality" (\x -> x == x) + +test_Increment :: Test +test_Increment = property "equality" (\x -> x + 1 > x) + +main :: IO () +main = defaultMain [tests] +``` diff --git a/chell/Setup.hs b/chell/Setup.hs deleted file mode 100644 index 9a994af..0000000 --- a/chell/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/chell/Test/Chell.hs b/chell/Test/Chell.hs index ea492ef..a1fa0a1 100644 --- a/chell/Test/Chell.hs +++ b/chell/Test/Chell.hs @@ -1,144 +1,137 @@ {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE FlexibleInstances #-} -- | Chell is a simple and intuitive library for automated testing. It natively -- supports assertion-based testing, and can use companion libraries -- such as @chell-quickcheck@ to support more complex testing strategies. -- --- An example test suite, which verifies the behavior of artithmetic operators. +-- An example test suite, which verifies the behavior of arithmetic operators. -- -- @ ---{-\# LANGUAGE TemplateHaskell \#-} +-- {-\# LANGUAGE TemplateHaskell \#-} -- ---import Test.Chell +-- import Test.Chell -- ---suite_Math :: Suite ---suite_Math = 'suite' \"math\" +-- suite_Math :: Suite +-- suite_Math = 'suite' \"math\" -- [ test_Addition -- , test_Subtraction -- ] -- ---test_Addition :: Test ---test_Addition = 'assertions' \"addition\" $ do +-- test_Addition :: Test +-- test_Addition = 'assertions' \"addition\" $ do -- $'expect' ('equal' (2 + 1) 3) -- $'expect' ('equal' (1 + 2) 3) -- ---test_Subtraction :: Test ---test_Subtraction = 'assertions' \"subtraction\" $ do +-- test_Subtraction :: Test +-- test_Subtraction = 'assertions' \"subtraction\" $ do -- $'expect' ('equal' (2 - 1) 1) -- $'expect' ('equal' (1 - 2) (-1)) -- ---main :: IO () ---main = 'defaultMain' [suite_Math] +-- main :: IO () +-- main = 'defaultMain' [suite_Math] -- @ -- -- >$ ghc --make chell-example.hs -- >$ ./chell-example -- >PASS: 2 tests run, 2 tests passed module Test.Chell - ( - - -- * Main - defaultMain - - -- * Test suites - , Suite - , suite - , suiteName - , suiteTests - - -- ** Skipping some tests - , SuiteOrTest - , skipIf - , skipWhen - - -- * Basic testing library - , Assertions - , assertions - , IsAssertion - , Assertion - , assertionPassed - , assertionFailed - , assert - , expect - , die - , trace - , note - , afterTest - , requireLeft - , requireRight - - -- ** Built-in assertions - , equal - , notEqual - , equalWithin - , just - , nothing - , left - , right - , throws - , throwsEq - , greater - , greaterEqual - , lesser - , lesserEqual - , sameItems - , equalItems - , IsText - , equalLines - , equalLinesWith - - -- * Custom test types - , Test - , test - , testName - , runTest - - -- ** Test results - , TestResult (..) - - -- *** Failures - , Failure - , failure - , failureLocation - , failureMessage - - -- *** Failure locations - , Location - , location - , locationFile - , locationModule - , locationLine - - -- ** Test options - , TestOptions - , defaultTestOptions - , testOptionSeed - , testOptionTimeout - ) where - -import qualified Control.Applicative -import qualified Control.Exception -import Control.Exception (Exception) -import Control.Monad (ap, liftM) -import Control.Monad.IO.Class (MonadIO, liftIO) -import qualified Data.ByteString.Char8 -import qualified Data.ByteString.Lazy.Char8 -import Data.Foldable (Foldable, foldMap) -import Data.List (foldl', intercalate, sort) -import Data.Maybe (isJust, isNothing) -import Data.IORef (IORef, newIORef, readIORef, modifyIORef) -import qualified Data.Text -import Data.Text (Text) -import qualified Data.Text.Lazy - -import qualified Language.Haskell.TH as TH - -import qualified Patience - -import Test.Chell.Main (defaultMain) -import Test.Chell.Types + ( -- * Main + defaultMain, + + -- * Test suites + Suite, + suite, + suiteName, + suiteTests, + + -- ** Skipping some tests + SuiteOrTest, + skipIf, + skipWhen, + + -- * Basic testing library + Assertions, + assertions, + IsAssertion, + Assertion, + assertionPassed, + assertionFailed, + assert, + expect, + die, + trace, + note, + afterTest, + requireLeft, + requireRight, + + -- ** Built-in assertions + equal, + notEqual, + equalWithin, + just, + nothing, + left, + right, + throws, + throwsEq, + greater, + greaterEqual, + lesser, + lesserEqual, + sameItems, + equalItems, + IsText, + equalLines, + equalLinesWith, + + -- * Custom test types + Test, + test, + testName, + runTest, + + -- ** Test results + TestResult (..), + + -- *** Failures + Failure, + failure, + failureLocation, + failureMessage, + + -- *** Failure locations + Location, + location, + locationFile, + locationModule, + locationLine, + + -- ** Test options + TestOptions, + defaultTestOptions, + testOptionSeed, + testOptionTimeout, + ) +where + +import Control.Applicative qualified +import Control.Exception (Exception) +import Control.Exception qualified +import Control.Monad (ap, liftM) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.ByteString.Char8 qualified +import Data.ByteString.Lazy.Char8 qualified +import Data.IORef (IORef, modifyIORef, newIORef, readIORef) +import Data.List (foldl', intercalate, sort) +import Data.Maybe (isJust, isNothing) +import Data.Text (Text) +import Data.Text qualified +import Data.Text.Lazy qualified +import Language.Haskell.TH qualified as TH +import Patience qualified +import Test.Chell.Main (defaultMain) +import Test.Chell.Types -- | A single pass/fail assertion. Failed assertions include an explanatory -- message. @@ -156,68 +149,55 @@ assertionFailed :: String -> Assertion assertionFailed = AssertionFailed -- | See 'assert' and 'expect'. -class IsAssertion a - where - runAssertion :: a -> IO Assertion +class IsAssertion a where + runAssertion :: a -> IO Assertion -instance IsAssertion Assertion - where - runAssertion = return +instance IsAssertion Assertion where + runAssertion = return -instance IsAssertion Bool - where - runAssertion x = - return - ( - if x - then assertionPassed - else assertionFailed "boolean assertion failed" - ) +instance IsAssertion Bool where + runAssertion x = + return + ( if x + then assertionPassed + else assertionFailed "boolean assertion failed" + ) -instance IsAssertion a => IsAssertion (IO a) - where - runAssertion x = x >>= runAssertion +instance IsAssertion a => IsAssertion (IO a) where + runAssertion x = x >>= runAssertion type TestState = (IORef [(String, String)], IORef [IO ()], [Failure]) -- | See 'assertions'. -newtype Assertions a = - Assertions - { unAssertions :: TestState -> IO (Maybe a, TestState) } +newtype Assertions a = Assertions + {unAssertions :: TestState -> IO (Maybe a, TestState)} -instance Functor Assertions - where - fmap = liftM +instance Functor Assertions where + fmap = liftM -instance Control.Applicative.Applicative Assertions - where - pure = return - (<*>) = ap +instance Control.Applicative.Applicative Assertions where + pure x = Assertions (\s -> pure (Just x, s)) + (<*>) = ap -instance Monad Assertions - where - return x = - Assertions (\s -> return (Just x, s)) - - m >>= f = - Assertions - (\s -> - do - (maybe_a, s') <- unAssertions m s - case maybe_a of - Nothing -> return (Nothing, s') - Just a -> unAssertions (f a) s' - ) - -instance MonadIO Assertions - where - liftIO io = - Assertions - (\s -> - do - x <- io - return (Just x, s) - ) +instance Monad Assertions where + m >>= f = + Assertions + ( \s -> + do + (maybe_a, s') <- unAssertions m s + case maybe_a of + Nothing -> return (Nothing, s') + Just a -> unAssertions (f a) s' + ) + +instance MonadIO Assertions where + liftIO io = + Assertions + ( \s -> + do + x <- io + return (Just x, s) + ) -- | Convert a sequence of pass/fail assertions into a runnable test. -- @@ -229,57 +209,55 @@ instance MonadIO Assertions -- @ assertions :: String -> Assertions a -> Test assertions name testm = - test name $ \opts -> - do - noteRef <- newIORef [] - afterTestRef <- newIORef [] - - let - getNotes = fmap reverse (readIORef noteRef) - - let - getResult = - do - res <- unAssertions testm (noteRef, afterTestRef, []) - case res of - (_, (_, _, [])) -> - do - notes <- getNotes - return (TestPassed notes) - (_, (_, _, fs)) -> - do - notes <- getNotes - return (TestFailed notes (reverse fs)) - - Control.Exception.finally - (handleJankyIO opts getResult getNotes) - (runAfterTest afterTestRef) + test name $ \opts -> + do + noteRef <- newIORef [] + afterTestRef <- newIORef [] + + let getNotes = fmap reverse (readIORef noteRef) + + let getResult = + do + res <- unAssertions testm (noteRef, afterTestRef, []) + case res of + (_, (_, _, [])) -> + do + notes <- getNotes + return (TestPassed notes) + (_, (_, _, fs)) -> + do + notes <- getNotes + return (TestFailed notes (reverse fs)) + + Control.Exception.finally + (handleJankyIO opts getResult getNotes) + (runAfterTest afterTestRef) runAfterTest :: IORef [IO ()] -> IO () runAfterTest ref = readIORef ref >>= loop where loop [] = return () - loop (io:ios) = Control.Exception.finally (loop ios) io + loop (io : ios) = Control.Exception.finally (loop ios) io addFailure :: Maybe TH.Loc -> String -> Assertions () addFailure maybe_loc msg = - Assertions $ \(notes, afterTestRef, fs) -> - do - let - loc = - do - th_loc <- maybe_loc - return $ location - { locationFile = TH.loc_filename th_loc - , locationModule = TH.loc_module th_loc - , locationLine = Just (toInteger (fst (TH.loc_start th_loc))) - } - let - f = failure - { failureLocation = loc - , failureMessage = msg - } - return (Just (), (notes, afterTestRef, f : fs)) + Assertions $ \(notes, afterTestRef, fs) -> + do + let loc = + do + th_loc <- maybe_loc + return $ + location + { locationFile = TH.loc_filename th_loc, + locationModule = TH.loc_module th_loc, + locationLine = Just (toInteger (fst (TH.loc_start th_loc))) + } + let f = + failure + { failureLocation = loc, + failureMessage = msg + } + return (Just (), (notes, afterTestRef, f : fs)) -- | Cause a test to immediately fail, with a message. -- @@ -287,15 +265,16 @@ addFailure maybe_loc msg = -- which it was used. Its effective type is: -- -- @ + -- $die :: 'String' -> 'Assertions' a -- @ + die :: TH.Q TH.Exp die = do loc <- TH.location - let - qloc = liftLoc loc - [| \msg -> dieAt $qloc ("die: " ++ msg) |] + let qloc = liftLoc loc + [|\msg -> dieAt $qloc ("die: " ++ msg)|] dieAt :: TH.Loc -> String -> Assertions a dieAt loc msg = @@ -311,22 +290,22 @@ dieAt loc msg = -- from which it was used. Its effective type is: -- -- @ + -- $trace :: 'String' -> 'Assertions' () -- @ + trace :: TH.Q TH.Exp trace = do loc <- TH.location - let - qloc = liftLoc loc - [| traceAt $qloc |] + let qloc = liftLoc loc + [|traceAt $qloc|] traceAt :: TH.Loc -> String -> Assertions () traceAt loc msg = liftIO $ do - let - file = TH.loc_filename loc + let file = TH.loc_filename loc line = fst (TH.loc_start loc) putStr ("[" ++ file ++ ":" ++ show line ++ "] ") putStrLn msg @@ -336,19 +315,23 @@ traceAt loc msg = -- debugging failing tests. note :: String -> String -> Assertions () note key value = - Assertions (\(notes, afterTestRef, fs) -> - do - modifyIORef notes ((key, value) :) - return (Just (), (notes, afterTestRef, fs))) + Assertions + ( \(notes, afterTestRef, fs) -> + do + modifyIORef notes ((key, value) :) + return (Just (), (notes, afterTestRef, fs)) + ) -- | Register an IO action to be run after the test completes. This action -- will run even if the test failed or aborted. afterTest :: IO () -> Assertions () afterTest io = - Assertions (\(notes, ref, fs) -> - do - modifyIORef ref (io :) - return (Just (), (notes, ref, fs))) + Assertions + ( \(notes, ref, fs) -> + do + modifyIORef ref (io :) + return (Just (), (notes, ref, fs)) + ) -- | Require an 'Either' value to be 'Left', and return its contents. If -- the value is 'Right', fail the test. @@ -357,25 +340,25 @@ afterTest io = -- location from which it was used. Its effective type is: -- -- @ + -- $requireLeft :: 'Show' b => 'Either' a b -> 'Assertions' a -- @ + requireLeft :: TH.Q TH.Exp requireLeft = do loc <- TH.location - let - qloc = liftLoc loc - [| requireLeftAt $qloc |] + let qloc = liftLoc loc + [|requireLeftAt $qloc|] requireLeftAt :: Show b => TH.Loc -> Either a b -> Assertions a requireLeftAt loc val = - case val of - Left a -> return a - Right b -> - do - let - dummy = Right b `asTypeOf` Left () - dieAt loc ("requireLeft: received " ++ showsPrec 11 dummy "") + case val of + Left a -> return a + Right b -> + do + let dummy = Right b `asTypeOf` Left () + dieAt loc ("requireLeft: received " ++ showsPrec 11 dummy "") -- | Require an 'Either' value to be 'Right', and return its contents. If -- the value is 'Left', fail the test. @@ -384,29 +367,29 @@ requireLeftAt loc val = -- location from which it was used. Its effective type is: -- -- @ + -- $requireRight :: 'Show' a => 'Either' a b -> 'Assertions' b -- @ + requireRight :: TH.Q TH.Exp requireRight = do loc <- TH.location - let - qloc = liftLoc loc - [| requireRightAt $qloc |] + let qloc = liftLoc loc + [|requireRightAt $qloc|] requireRightAt :: Show a => TH.Loc -> Either a b -> Assertions b requireRightAt loc val = - case val of - Left a -> - do - let - dummy = Left a `asTypeOf` Right () - dieAt loc ("requireRight: received " ++ showsPrec 11 dummy "") - Right b -> return b + case val of + Left a -> + do + let dummy = Left a `asTypeOf` Right () + dieAt loc ("requireRight: received " ++ showsPrec 11 dummy "") + Right b -> return b liftLoc :: TH.Loc -> TH.Q TH.Exp liftLoc loc = - [| TH.Loc filename package module_ start end |] + [|TH.Loc filename package module_ start end|] where filename = TH.loc_filename loc package = TH.loc_package loc @@ -419,11 +402,11 @@ assertAt loc fatal assertion = do result <- liftIO (runAssertion assertion) case result of - AssertionPassed -> return () - AssertionFailed err -> - if fatal - then dieAt loc err - else addFailure (Just loc) err + AssertionPassed -> return () + AssertionFailed err -> + if fatal + then dieAt loc err + else addFailure (Just loc) err -- | Check an assertion. If the assertion fails, the test will immediately -- fail. @@ -435,15 +418,16 @@ assertAt loc fatal assertion = -- from which it was used. Its effective type is: -- -- @ + -- $assert :: 'IsAssertion' assertion => assertion -> 'Assertions' () -- @ + assert :: TH.Q TH.Exp assert = do loc <- TH.location - let - qloc = liftLoc loc - [| assertAt $qloc True |] + let qloc = liftLoc loc + [|assertAt $qloc True|] -- | Check an assertion. If the assertion fails, the test will continue to -- run until it finishes, a call to 'assert' fails, or the test runs 'die'. @@ -455,42 +439,47 @@ assert = -- from which it was used. Its effective type is: -- -- @ + -- $expect :: 'IsAssertion' assertion => assertion -> 'Assertions' () -- @ + expect :: TH.Q TH.Exp expect = do loc <- TH.location - let - qloc = liftLoc loc - [| assertAt $qloc False |] + let qloc = liftLoc loc + [|assertAt $qloc False|] assertBool :: Bool -> String -> Assertion -assertBool True _ = assertionPassed +assertBool True _ = assertionPassed assertBool False err = AssertionFailed err -- | Assert that two values are equal. equal :: (Show a, Eq a) => a -> a -> Assertion equal x y = - assertBool - (x == y) - ("equal: " ++ show x ++ " is not equal to " ++ show y) + assertBool + (x == y) + ("equal: " ++ show x ++ " is not equal to " ++ show y) -- | Assert that two values are not equal. notEqual :: (Eq a, Show a) => a -> a -> Assertion notEqual x y = - assertBool - (x /= y) - ("notEqual: " ++ show x ++ " is equal to " ++ show y) + assertBool + (x /= y) + ("notEqual: " ++ show x ++ " is equal to " ++ show y) -- | Assert that two values are within some delta of each other. -equalWithin :: (Real a, Show a) => a -> a - -> a -- ^ delta - -> Assertion +equalWithin :: + (Real a, Show a) => + a -> + a -> + -- | delta + a -> + Assertion equalWithin x y delta = - assertBool - ((x - delta <= y) && (x + delta >= y)) - ("equalWithin: " ++ show x ++ " is not within " ++ show delta ++ " of " ++ show y) + assertBool + ((x - delta <= y) && (x + delta >= y)) + ("equalWithin: " ++ show x ++ " is not within " ++ show delta ++ " of " ++ show y) -- | Assert that some value is @Just@. just :: Maybe a -> Assertion @@ -499,9 +488,9 @@ just x = assertBool (isJust x) ("just: received Nothing") -- | Assert that some value is @Nothing@. nothing :: Show a => Maybe a -> Assertion nothing x = - assertBool - (isNothing x) - ("nothing: received " ++ showsPrec 11 x "") + assertBool + (isNothing x) + ("nothing: received " ++ showsPrec 11 x "") -- | Assert that some value is @Left@. left :: Show b => Either a b -> Assertion @@ -525,13 +514,17 @@ throws p io = do either_exc <- Control.Exception.try io return $ - case either_exc of - Left exc -> - if p exc - then assertionPassed - else assertionFailed ("throws: exception " ++ show exc ++ - " did not match predicate") - Right _ -> assertionFailed "throws: no exception thrown" + case either_exc of + Left exc -> + if p exc + then assertionPassed + else + assertionFailed + ( "throws: exception " + ++ show exc + ++ " did not match predicate" + ) + Right _ -> assertionFailed "throws: no exception thrown" -- | Assert that some computation throws an exception equal to the given -- exception. This is better than just checking that the correct type was @@ -542,110 +535,117 @@ throwsEq expected io = do either_exc <- Control.Exception.try io return $ - case either_exc of - Left exc -> - if exc == expected - then assertionPassed - else assertionFailed ("throwsEq: exception " ++ show exc ++ - " is not equal to " ++ show expected) - Right _ -> assertionFailed "throwsEq: no exception thrown" + case either_exc of + Left exc -> + if exc == expected + then assertionPassed + else + assertionFailed + ( "throwsEq: exception " + ++ show exc + ++ " is not equal to " + ++ show expected + ) + Right _ -> assertionFailed "throwsEq: no exception thrown" -- | Assert a value is greater than another. greater :: (Ord a, Show a) => a -> a -> Assertion greater x y = - assertBool - (x > y) - ("greater: " ++ show x ++ " is not greater than " ++ show y) + assertBool + (x > y) + ("greater: " ++ show x ++ " is not greater than " ++ show y) -- | Assert a value is greater than or equal to another. greaterEqual :: (Ord a, Show a) => a -> a -> Assertion greaterEqual x y = - assertBool - (x >= y) - ("greaterEqual: " ++ show x ++ " is not greater than or equal to " ++ show y) + assertBool + (x >= y) + ("greaterEqual: " ++ show x ++ " is not greater than or equal to " ++ show y) -- | Assert a value is less than another. lesser :: (Ord a, Show a) => a -> a -> Assertion lesser x y = - assertBool - (x < y) - ("lesser: " ++ show x ++ " is not less than " ++ show y) + assertBool + (x < y) + ("lesser: " ++ show x ++ " is not less than " ++ show y) -- | Assert a value is less than or equal to another. lesserEqual :: (Ord a, Show a) => a -> a -> Assertion lesserEqual x y = - assertBool - (x <= y) - ("lesserEqual: " ++ show x ++ " is not less than or equal to " ++ show y) + assertBool + (x <= y) + ("lesserEqual: " ++ show x ++ " is not less than or equal to " ++ show y) -- | Assert that two containers have the same items, in any order. -sameItems :: (Foldable container, Show item, Ord item) => - container item -> container item -> Assertion +sameItems :: + (Foldable container, Show item, Ord item) => + container item -> + container item -> + Assertion sameItems x y = equalDiff' "sameItems" sort x y -- | Assert that two containers have the same items, in the same order. -equalItems :: (Foldable container, Show item, Ord item) => - container item -> container item -> Assertion +equalItems :: + (Foldable container, Show item, Ord item) => + container item -> + container item -> + Assertion equalItems x y = equalDiff' "equalItems" id x y -equalDiff' :: (Foldable container, Show item, Ord item) - => String - -> ([item] - -> [item]) - -> container item - -> container item - -> Assertion +equalDiff' :: + (Foldable container, Show item, Ord item) => + String -> + ( [item] -> + [item] + ) -> + container item -> + container item -> + Assertion equalDiff' label norm x y = checkDiff (items x) (items y) where - items = norm . foldMap (:[]) + items = norm . foldMap (: []) checkDiff xs ys = - case checkItems (Patience.diff xs ys) of - (same, diff) -> assertBool same diff + case checkItems (Patience.diff xs ys) of + (same, diff) -> assertBool same diff checkItems diffItems = - case foldl' checkItem (True, []) diffItems of - (same, diff) -> (same, errorMsg (intercalate "\n" (reverse diff))) + case foldl' checkItem (True, []) diffItems of + (same, diff) -> (same, errorMsg (intercalate "\n" (reverse diff))) checkItem (same, acc) item = - case item of - Patience.Old t -> (False, ("\t- " ++ show t) : acc) - Patience.New t -> (False, ("\t+ " ++ show t) : acc) - Patience.Both t _-> (same, ("\t " ++ show t) : acc) + case item of + Patience.Old t -> (False, ("\t- " ++ show t) : acc) + Patience.New t -> (False, ("\t+ " ++ show t) : acc) + Patience.Both t _ -> (same, ("\t " ++ show t) : acc) errorMsg diff = label ++ ": items differ\n" ++ diff -- | Class for types which can be treated as text; see 'equalLines'. -class IsText a - where - toLines :: a -> [a] - unpack :: a -> String +class IsText a where + toLines :: a -> [a] + unpack :: a -> String -instance IsText String - where - toLines = lines - unpack = id +instance IsText String where + toLines = lines + unpack = id -instance IsText Text - where - toLines = Data.Text.lines - unpack = Data.Text.unpack +instance IsText Text where + toLines = Data.Text.lines + unpack = Data.Text.unpack -instance IsText Data.Text.Lazy.Text - where - toLines = Data.Text.Lazy.lines - unpack = Data.Text.Lazy.unpack +instance IsText Data.Text.Lazy.Text where + toLines = Data.Text.Lazy.lines + unpack = Data.Text.Lazy.unpack -- | Uses @Data.ByteString.Char8@ -instance IsText Data.ByteString.Char8.ByteString - where - toLines = Data.ByteString.Char8.lines - unpack = Data.ByteString.Char8.unpack +instance IsText Data.ByteString.Char8.ByteString where + toLines = Data.ByteString.Char8.lines + unpack = Data.ByteString.Char8.unpack -- | Uses @Data.ByteString.Lazy.Char8@ -instance IsText Data.ByteString.Lazy.Char8.ByteString - where - toLines = Data.ByteString.Lazy.Char8.lines - unpack = Data.ByteString.Lazy.Char8.unpack +instance IsText Data.ByteString.Lazy.Char8.ByteString where + toLines = Data.ByteString.Lazy.Char8.lines + unpack = Data.ByteString.Lazy.Char8.unpack -- | Assert that two pieces of text are equal. This uses a diff algorithm -- to check line-by-line, so the error message will be easier to read on @@ -662,17 +662,17 @@ checkLinesDiff :: (Ord a, IsText a) => String -> [a] -> [a] -> Assertion checkLinesDiff label = go where go xs ys = - case checkItems (Patience.diff xs ys) of - (same, diff) -> assertBool same diff + case checkItems (Patience.diff xs ys) of + (same, diff) -> assertBool same diff checkItems diffItems = - case foldl' checkItem (True, []) diffItems of - (same, diff) -> (same, errorMsg (intercalate "\n" (reverse diff))) + case foldl' checkItem (True, []) diffItems of + (same, diff) -> (same, errorMsg (intercalate "\n" (reverse diff))) checkItem (same, acc) item = - case item of - Patience.Old t -> (False, ("\t- " ++ unpack t) : acc) - Patience.New t -> (False, ("\t+ " ++ unpack t) : acc) - Patience.Both t _-> (same, ("\t " ++ unpack t) : acc) + case item of + Patience.Old t -> (False, ("\t- " ++ unpack t) : acc) + Patience.New t -> (False, ("\t+ " ++ unpack t) : acc) + Patience.Both t _ -> (same, ("\t " ++ unpack t) : acc) errorMsg diff = label ++ ": lines differ\n" ++ diff diff --git a/chell/Test/Chell/Main.hs b/chell/Test/Chell/Main.hs index 7281ae9..190ab58 100644 --- a/chell/Test/Chell/Main.hs +++ b/chell/Test/Chell/Main.hs @@ -1,82 +1,86 @@ -module Test.Chell.Main - ( defaultMain - ) where - -import Control.Applicative -import Control.Monad (forM, forM_, when) -import Control.Monad.Trans.Class (lift) -import qualified Control.Monad.Trans.State as State -import qualified Control.Monad.Trans.Writer as Writer -import Data.Char (ord) -import Data.List (isPrefixOf) -import System.Exit (exitSuccess, exitFailure) -import System.IO (hPutStr, hPutStrLn, hIsTerminalDevice, stderr, stdout, withBinaryFile, IOMode(..)) -import System.Random (randomIO) -import Text.Printf (printf) - -import Options - -import Test.Chell.Output -import Test.Chell.Types - -data MainOptions = - MainOptions - { optVerbose :: Bool - , optXmlReport :: String - , optJsonReport :: String - , optTextReport :: String - , optSeed :: Maybe Int - , optTimeout :: Maybe Int - , optColor :: ColorMode - } +module Test.Chell.Main (defaultMain) where + +import Control.Monad (forM, forM_, when) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.State qualified as State +import Control.Monad.Trans.Writer qualified as Writer +import Data.Char (ord) +import Data.List (isPrefixOf) +import Options +import System.Exit (exitFailure, exitSuccess) +import System.IO (IOMode (..), hIsTerminalDevice, hPutStr, hPutStrLn, stderr, stdout, withBinaryFile) +import System.Random (randomIO) +import Test.Chell.Output +import Test.Chell.Types +import Text.Printf (printf) + +data MainOptions = MainOptions + { optVerbose :: Bool, + optXmlReport :: String, + optJsonReport :: String, + optTextReport :: String, + optSeed :: Maybe Int, + optTimeout :: Maybe Int, + optColor :: ColorMode + } optionType_ColorMode :: OptionType ColorMode optionType_ColorMode = optionType "ColorMode" ColorModeAuto parseMode showMode where parseMode s = - case s of - "always" -> Right ColorModeAlways - "never" -> Right ColorModeNever - "auto" -> Right ColorModeAuto - _ -> Left (show s ++ " is not in {\"always\", \"never\", \"auto\"}.") + case s of + "always" -> Right ColorModeAlways + "never" -> Right ColorModeNever + "auto" -> Right ColorModeAuto + _ -> Left (show s ++ " is not in {\"always\", \"never\", \"auto\"}.") showMode mode = - case mode of - ColorModeAlways -> "always" - ColorModeNever -> "never" - ColorModeAuto -> "auto" - -instance Options MainOptions - where - defineOptions = pure MainOptions - <*> defineOption optionType_bool - (\o -> o - { optionShortFlags = ['v'] - , optionLongFlags = ["verbose"] - , optionDefault = False - , optionDescription = "Print more output." - } - ) - - <*> simpleOption "xml-report" "" - "Write a parsable report to a given path, in XML." - <*> simpleOption "json-report" "" - "Write a parsable report to a given path, in JSON." - <*> simpleOption "text-report" "" - "Write a human-readable report to a given path." - - <*> simpleOption "seed" Nothing - "The seed used for random numbers in (for example) quickcheck." - - <*> simpleOption "timeout" Nothing - "The maximum duration of a test, in milliseconds." - - <*> defineOption optionType_ColorMode - (\o -> o - { optionLongFlags = ["color"] - , optionDefault = ColorModeAuto - , optionDescription = "Whether to enable color ('always', 'auto', or 'never')." - } - ) + case mode of + ColorModeAlways -> "always" + ColorModeNever -> "never" + ColorModeAuto -> "auto" + +instance Options MainOptions where + defineOptions = + pure MainOptions + <*> defineOption + optionType_bool + ( \o -> + o + { optionShortFlags = ['v'], + optionLongFlags = ["verbose"], + optionDefault = False, + optionDescription = "Print more output." + } + ) + <*> simpleOption + "xml-report" + "" + "Write a parsable report to a given path, in XML." + <*> simpleOption + "json-report" + "" + "Write a parsable report to a given path, in JSON." + <*> simpleOption + "text-report" + "" + "Write a human-readable report to a given path." + <*> simpleOption + "seed" + Nothing + "The seed used for random numbers in (for example) quickcheck." + <*> simpleOption + "timeout" + Nothing + "The maximum duration of a test, in milliseconds." + <*> defineOption + optionType_ColorMode + ( \o -> + o + { optionLongFlags = ["color"], + optionDefault = ColorModeAuto, + optionDescription = "Whether to enable color ('always', 'auto', or 'never')." + } + ) -- | A simple default main function, which runs a list of tests and logs -- statistics to stdout. @@ -85,45 +89,43 @@ defaultMain suites = runCommand $ \opts args -> do -- validate/sanitize test options seed <- - case optSeed opts of - Just s -> return s - Nothing -> randomIO + case optSeed opts of + Just s -> return s + Nothing -> randomIO timeout <- - case optTimeout opts of - Nothing -> return Nothing - Just t -> if toInteger t * 1000 > toInteger (maxBound :: Int) - then - do - hPutStrLn stderr "Test.Chell.defaultMain: Ignoring --timeout because it is too large." - return Nothing - else - return (Just t) - let - testOptions = defaultTestOptions - { testOptionSeed = seed - , testOptionTimeout = timeout + case optTimeout opts of + Nothing -> return Nothing + Just t -> + if toInteger t * 1000 > toInteger (maxBound :: Int) + then do + hPutStrLn stderr "Test.Chell.defaultMain: Ignoring --timeout because it is too large." + return Nothing + else return (Just t) + let testOptions = + defaultTestOptions + { testOptionSeed = seed, + testOptionTimeout = timeout } -- find which tests to run - let - allTests = concatMap suiteTests suites + let allTests = concatMap suiteTests suites tests = - if null args - then allTests - else filter (matchesFilter args) allTests + if null args + then allTests + else filter (matchesFilter args) allTests -- output mode output <- - case optColor opts of - ColorModeNever -> return (plainOutput (optVerbose opts)) - ColorModeAlways -> return (colorOutput (optVerbose opts)) - ColorModeAuto -> - do - isTerm <- hIsTerminalDevice stdout - return $ - if isTerm - then colorOutput (optVerbose opts) - else plainOutput (optVerbose opts) + case optColor opts of + ColorModeNever -> return (plainOutput (optVerbose opts)) + ColorModeAlways -> return (colorOutput (optVerbose opts)) + ColorModeAuto -> + do + isTerm <- hIsTerminalDevice stdout + return $ + if isTerm + then colorOutput (optVerbose opts) + else plainOutput (optVerbose opts) -- run tests results <- forM tests $ \t -> @@ -134,24 +136,22 @@ defaultMain suites = runCommand $ \opts args -> return (t, result) -- generate reports - let - reports = getReports opts + let reports = getReports opts forM_ reports $ \(path, fmt, toText) -> - withBinaryFile path WriteMode $ \h -> - do - when (optVerbose opts) $ - putStrLn ("Writing " ++ fmt ++ " report to " ++ show path) - hPutStr h (toText results) + withBinaryFile path WriteMode $ \h -> + do + when (optVerbose opts) $ + putStrLn ("Writing " ++ fmt ++ " report to " ++ show path) + hPutStr h (toText results) - let - stats = resultStatistics results + let stats = resultStatistics results (_, _, failed, aborted) = stats putStrLn (formatResultStatistics stats) if failed == 0 && aborted == 0 - then exitSuccess - else exitFailure + then exitSuccess + else exitFailure matchesFilter :: [String] -> Test -> Bool matchesFilter filters = check @@ -165,14 +165,14 @@ getReports :: MainOptions -> [(String, String, Report)] getReports opts = concat [xml, json, text] where xml = case optXmlReport opts of - "" -> [] - path -> [(path, "XML", xmlReport)] + "" -> [] + path -> [(path, "XML", xmlReport)] json = case optJsonReport opts of - "" -> [] - path -> [(path, "JSON", jsonReport)] + "" -> [] + path -> [(path, "JSON", jsonReport)] text = case optTextReport opts of - "" -> [] - path -> [(path, "text", textReport)] + "" -> [] + path -> [(path, "text", textReport)] jsonReport :: [(Test, TestResult)] -> String jsonReport results = Writer.execWriter writer @@ -186,68 +186,68 @@ jsonReport results = Writer.execWriter writer tell "]}" tellResult (t, result) = - case result of - TestPassed notes -> - do - tell "{\"test\": \"" - tell (escapeJSON (testName t)) - tell "\", \"result\": \"passed\"" - tellNotes notes - tell "}" - TestSkipped -> - do - tell "{\"test\": \"" - tell (escapeJSON (testName t)) - tell "\", \"result\": \"skipped\"}" - TestFailed notes fs -> - do - tell "{\"test\": \"" - tell (escapeJSON (testName t)) - tell "\", \"result\": \"failed\", \"failures\": [" - commas fs $ \f -> - do - tell "{\"message\": \"" - tell (escapeJSON (failureMessage f)) - tell "\"" - case failureLocation f of - Just loc -> - do - tell ", \"location\": {\"module\": \"" - tell (escapeJSON (locationModule loc)) - tell "\", \"file\": \"" - tell (escapeJSON (locationFile loc)) - case locationLine loc of - Just line -> - do - tell "\", \"line\": " - tell (show line) - Nothing -> tell "\"" - tell "}" - Nothing -> return () - tell "}" - tell "]" - tellNotes notes - tell "}" - TestAborted notes msg -> + case result of + TestPassed notes -> + do + tell "{\"test\": \"" + tell (escapeJSON (testName t)) + tell "\", \"result\": \"passed\"" + tellNotes notes + tell "}" + TestSkipped -> + do + tell "{\"test\": \"" + tell (escapeJSON (testName t)) + tell "\", \"result\": \"skipped\"}" + TestFailed notes fs -> + do + tell "{\"test\": \"" + tell (escapeJSON (testName t)) + tell "\", \"result\": \"failed\", \"failures\": [" + commas fs $ \f -> do - tell "{\"test\": \"" - tell (escapeJSON (testName t)) - tell "\", \"result\": \"aborted\", \"abortion\": {\"message\": \"" - tell (escapeJSON msg) - tell "\"}" - tellNotes notes + tell "{\"message\": \"" + tell (escapeJSON (failureMessage f)) + tell "\"" + case failureLocation f of + Just loc -> + do + tell ", \"location\": {\"module\": \"" + tell (escapeJSON (locationModule loc)) + tell "\", \"file\": \"" + tell (escapeJSON (locationFile loc)) + case locationLine loc of + Just line -> + do + tell "\", \"line\": " + tell (show line) + Nothing -> tell "\"" + tell "}" + Nothing -> return () tell "}" - _ -> return () + tell "]" + tellNotes notes + tell "}" + TestAborted notes msg -> + do + tell "{\"test\": \"" + tell (escapeJSON (testName t)) + tell "\", \"result\": \"aborted\", \"abortion\": {\"message\": \"" + tell (escapeJSON msg) + tell "\"}" + tellNotes notes + tell "}" + _ -> return () escapeJSON = - concatMap - (\c -> - case c of - '"' -> "\\\"" - '\\' -> "\\\\" - _ | ord c <= 0x1F -> printf "\\u%04X" (ord c) - _ -> [c] - ) + concatMap + ( \c -> + case c of + '"' -> "\\\"" + '\\' -> "\\\\" + _ | ord c <= 0x1F -> printf "\\u%04X" (ord c) + _ -> [c] + ) tellNotes notes = do @@ -264,12 +264,11 @@ jsonReport results = Writer.execWriter writer commas xs block = State.evalStateT (commaState xs block) False commaState xs block = forM_ xs $ \x -> do - let - tell' = lift . Writer.tell + let tell' = lift . Writer.tell needComma <- State.get if needComma - then tell' "\n, " - else tell' "\n " + then tell' "\n, " + else tell' "\n " State.put True lift (block x) @@ -309,22 +308,22 @@ xmlReport results = Writer.execWriter writer tell "\t\t\n" - tell "\t\t\t\n" - tell "\t\t\n" - Nothing -> tell "'/>\n" + Just loc -> + do + tell "'>\n" + tell "\t\t\t\n" + tell "\t\t\n" + Nothing -> tell "'/>\n" tellNotes notes tell "\t\n" TestAborted notes msg -> @@ -340,16 +339,16 @@ xmlReport results = Writer.execWriter writer _ -> return () escapeXML = - concatMap - (\c -> - case c of - '&' -> "&" - '<' -> "<" - '>' -> ">" - '"' -> """ - '\'' -> "'" - _ -> [c] - ) + concatMap + ( \c -> + case c of + '&' -> "&" + '<' -> "<" + '>' -> ">" + '"' -> """ + '\'' -> "'" + _ -> [c] + ) tellNotes notes = forM_ notes $ \(key, value) -> do @@ -371,62 +370,62 @@ textReport results = Writer.execWriter writer tell (formatResultStatistics stats) tellResult (t, result) = - case result of - TestPassed notes -> - do - tell (replicate 70 '=') - tell "\n" - tell "PASSED: " - tell (testName t) - tell "\n" - tellNotes notes - tell "\n\n" - TestSkipped -> - do - tell (replicate 70 '=') - tell "\n" - tell "SKIPPED: " - tell (testName t) - tell "\n\n" - TestFailed notes fs -> + case result of + TestPassed notes -> + do + tell (replicate 70 '=') + tell "\n" + tell "PASSED: " + tell (testName t) + tell "\n" + tellNotes notes + tell "\n\n" + TestSkipped -> + do + tell (replicate 70 '=') + tell "\n" + tell "SKIPPED: " + tell (testName t) + tell "\n\n" + TestFailed notes fs -> + do + tell (replicate 70 '=') + tell "\n" + tell "FAILED: " + tell (testName t) + tell "\n" + tellNotes notes + tell (replicate 70 '-') + tell "\n" + forM_ fs $ \f -> do - tell (replicate 70 '=') - tell "\n" - tell "FAILED: " - tell (testName t) - tell "\n" - tellNotes notes - tell (replicate 70 '-') - tell "\n" - forM_ fs $ \f -> - do - case failureLocation f of - Just loc -> + case failureLocation f of + Just loc -> + do + tell (locationFile loc) + case locationLine loc of + Just line -> do - tell (locationFile loc) - case locationLine loc of - Just line -> - do - tell ":" - tell (show line) - Nothing -> return () - tell "\n" + tell ":" + tell (show line) Nothing -> return () - tell (failureMessage f) - tell "\n\n" - TestAborted notes msg -> - do - tell (replicate 70 '=') - tell "\n" - tell "ABORTED: " - tell (testName t) - tell "\n" - tellNotes notes - tell (replicate 70 '-') - tell "\n" - tell msg + tell "\n" + Nothing -> return () + tell (failureMessage f) tell "\n\n" - _ -> return () + TestAborted notes msg -> + do + tell (replicate 70 '=') + tell "\n" + tell "ABORTED: " + tell (testName t) + tell "\n" + tellNotes notes + tell (replicate 70 '-') + tell "\n" + tell msg + tell "\n\n" + _ -> return () tellNotes notes = forM_ notes $ \(key, value) -> do @@ -436,37 +435,36 @@ textReport results = Writer.execWriter writer tell "\n" formatResultStatistics :: (Integer, Integer, Integer, Integer) -> String -formatResultStatistics stats = Writer.execWriter writer where - writer = - do - let - (passed, skipped, failed, aborted) = stats +formatResultStatistics stats = Writer.execWriter writer + where + writer = + do + let (passed, skipped, failed, aborted) = stats - if failed == 0 && aborted == 0 + if failed == 0 && aborted == 0 then Writer.tell "PASS: " else Writer.tell "FAIL: " - let - putNum comma n what = Writer.tell $ - if n == 1 + let putNum comma n what = + Writer.tell $ + if n == 1 then comma ++ "1 test " ++ what else comma ++ show n ++ " tests " ++ what - let - total = sum [passed, skipped, failed, aborted] + let total = sum [passed, skipped, failed, aborted] - putNum "" total "run" - (putNum ", " passed "passed") - when (skipped > 0) (putNum ", " skipped "skipped") - when (failed > 0) (putNum ", " failed "failed") - when (aborted > 0) (putNum ", " aborted "aborted") + putNum "" total "run" + (putNum ", " passed "passed") + when (skipped > 0) (putNum ", " skipped "skipped") + when (failed > 0) (putNum ", " failed "failed") + when (aborted > 0) (putNum ", " aborted "aborted") resultStatistics :: [(Test, TestResult)] -> (Integer, Integer, Integer, Integer) resultStatistics results = State.execState state (0, 0, 0, 0) where state = forM_ results $ \(_, result) -> case result of - TestPassed{} -> State.modify (\(p, s, f, a) -> (p+1, s, f, a)) - TestSkipped{} -> State.modify (\(p, s, f, a) -> (p, s+1, f, a)) - TestFailed{} -> State.modify (\(p, s, f, a) -> (p, s, f+1, a)) - TestAborted{} -> State.modify (\(p, s, f, a) -> (p, s, f, a+1)) - _ -> return () + TestPassed {} -> State.modify (\(p, s, f, a) -> (p + 1, s, f, a)) + TestSkipped {} -> State.modify (\(p, s, f, a) -> (p, s + 1, f, a)) + TestFailed {} -> State.modify (\(p, s, f, a) -> (p, s, f + 1, a)) + TestAborted {} -> State.modify (\(p, s, f, a) -> (p, s, f, a + 1)) + _ -> return () diff --git a/chell/Test/Chell/Output.hs b/chell/Test/Chell/Output.hs index e2ad45e..d436cf9 100644 --- a/chell/Test/Chell/Output.hs +++ b/chell/Test/Chell/Output.hs @@ -1,57 +1,55 @@ {-# LANGUAGE CPP #-} module Test.Chell.Output - ( Output - , outputStart - , outputResult + ( Output, + outputStart, + outputResult, + ColorMode (..), + plainOutput, + colorOutput, + ) +where - , ColorMode(..) - - , plainOutput - , colorOutput - ) where - -import Control.Monad (forM_, unless, when) +import Control.Monad (forM_, unless, when) #ifdef MIN_VERSION_ansi_terminal import qualified System.Console.ANSI as AnsiTerminal #endif -import Test.Chell.Types +import Test.Chell.Types -data Output = - Output - { outputStart :: Test -> IO () - , outputResult :: Test -> TestResult -> IO () - } +data Output = Output + { outputStart :: Test -> IO (), + outputResult :: Test -> TestResult -> IO () + } plainOutput :: Bool -> Output plainOutput v = Output - { outputStart = plainOutputStart v - , outputResult = plainOutputResult v + { outputStart = plainOutputStart v, + outputResult = plainOutputResult v } plainOutputStart :: Bool -> Test -> IO () plainOutputStart v t = - when v $ - do - putStr "[ RUN ] " - putStrLn (testName t) + when v $ + do + putStr "[ RUN ] " + putStrLn (testName t) plainOutputResult :: Bool -> Test -> TestResult -> IO () plainOutputResult v t (TestPassed _) = - when v $ - do - putStr "[ PASS ] " - putStrLn (testName t) - putStrLn "" + when v $ + do + putStr "[ PASS ] " + putStrLn (testName t) + putStrLn "" plainOutputResult v t TestSkipped = - when v $ - do - putStr "[ SKIP ] " - putStrLn (testName t) - putStrLn "" + when v $ + do + putStr "[ SKIP ] " + putStrLn (testName t) + putStrLn "" plainOutputResult _ t (TestFailed notes fs) = do putStr "[ FAIL ] " @@ -154,30 +152,30 @@ colorOutputResult _ _ _ = return () printNotes :: [(String, String)] -> IO () printNotes notes = - unless (null notes) $ - do - forM_ notes $ \(key, value) -> - do - putStr " note: " - putStr key - putStr "=" - putStrLn value - putStrLn "" + unless (null notes) $ + do + forM_ notes $ \(key, value) -> + do + putStr " note: " + putStr key + putStr "=" + putStrLn value + putStrLn "" printFailures :: [Failure] -> IO () printFailures fs = - forM_ fs $ \f -> - do - putStr " " - case failureLocation f of - Just loc -> - do - putStr (locationFile loc) - putStr ":" - case locationLine loc of - Just line -> putStrLn (show line) - Nothing -> putStrLn "" - Nothing -> return () - putStr " " - putStr (failureMessage f) - putStrLn "\n" + forM_ fs $ \f -> + do + putStr " " + case failureLocation f of + Just loc -> + do + putStr (locationFile loc) + putStr ":" + case locationLine loc of + Just line -> putStrLn (show line) + Nothing -> putStrLn "" + Nothing -> return () + putStr " " + putStr (failureMessage f) + putStrLn "\n" diff --git a/chell/Test/Chell/Types.hs b/chell/Test/Chell/Types.hs index dc5907c..b6f33eb 100644 --- a/chell/Test/Chell/Types.hs +++ b/chell/Test/Chell/Types.hs @@ -1,52 +1,44 @@ module Test.Chell.Types - ( Test - , test - , testName - - , TestOptions - , defaultTestOptions - , testOptionSeed - , testOptionTimeout - - , TestResult(TestPassed, TestSkipped, TestFailed, TestAborted) - - , Failure - , failure - , failureLocation - , failureMessage - - , Location - , location - , locationFile - , locationModule - , locationLine - - , Suite - , suite - , suiteName - , suiteTests - - , SuiteOrTest - , skipIf - , skipWhen - - , runTest - - , handleJankyIO - ) where - -import qualified Control.Exception -import Control.Exception (SomeException, Handler(..), catches, throwIO) -import System.Timeout (timeout) + ( Test, + test, + testName, + TestOptions, + defaultTestOptions, + testOptionSeed, + testOptionTimeout, + TestResult (TestPassed, TestSkipped, TestFailed, TestAborted), + Failure, + failure, + failureLocation, + failureMessage, + Location, + location, + locationFile, + locationModule, + locationLine, + Suite, + suite, + suiteName, + suiteTests, + SuiteOrTest, + skipIf, + skipWhen, + runTest, + handleJankyIO, + ) +where + +import Control.Exception (Handler (..), SomeException, catches, throwIO) +import Control.Exception qualified +import System.Timeout (timeout) -- | A 'Test' is, essentially, an IO action that returns a 'TestResult'. Tests -- are aggregated into suites (see 'Suite'). -data Test = - Test String (TestOptions -> IO TestResult) +data Test + = Test String (TestOptions -> IO TestResult) -instance Show Test - where - showsPrec d (Test name _) = showParen (d > 10) (showString "Test " . shows name) +instance Show Test where + showsPrec d (Test name _) = showParen (d > 10) (showString "Test " . shows name) -- | Define a test, with the given name and implementation. test :: String -> (TestOptions -> IO TestResult) -> Test @@ -58,11 +50,8 @@ testName (Test name _) = name -- | Test options are passed to each test, and control details about how the -- test should be run. -data TestOptions = - TestOptions - { - - -- | Get the RNG seed for this test run. The seed is generated once, in +data TestOptions = TestOptions + { -- | Get the RNG seed for this test run. The seed is generated once, in -- 'defaultMain', and used for all tests. It is also logged to reports -- using a note. -- @@ -71,9 +60,8 @@ data TestOptions = -- -- 'testOptionSeed' is a field accessor, and can be used to update -- a 'TestOptions' value. - testOptionSeed :: Int - - -- | An optional timeout, in millseconds. Tests which run longer than + testOptionSeed :: Int, + -- | An optional timeout, in milliseconds. Tests which run longer than -- this timeout will be aborted. -- -- When using 'defaultMain', users may specify a timeout using the @@ -81,9 +69,9 @@ data TestOptions = -- -- 'testOptionTimeout' is a field accessor, and can be used to update -- a 'TestOptions' value. - , testOptionTimeout :: Maybe Int - } - deriving (Show, Eq) + testOptionTimeout :: Maybe Int + } + deriving (Show, Eq) -- | Default test options. -- @@ -98,8 +86,8 @@ data TestOptions = defaultTestOptions :: TestOptions defaultTestOptions = TestOptions - { testOptionSeed = 0 - , testOptionTimeout = Nothing + { testOptionSeed = 0, + testOptionTimeout = Nothing } -- | The result of running a test. @@ -108,71 +96,60 @@ defaultTestOptions = -- who pattern-match against the 'TestResult' constructors should include a -- default case. If no default case is provided, a warning will be issued. data TestResult - -- | The test passed, and generated the given notes. - = TestPassed [(String, String)] - - -- | The test did not run, because it was skipped with 'skipIf' - -- or 'skipWhen'. - | TestSkipped - - -- | The test failed, generating the given notes and failures. - | TestFailed [(String, String)] [Failure] - - -- | The test aborted with an error message, and generated the given - -- notes. - | TestAborted [(String, String)] String - - -- Not exported; used to generate GHC warnings for users who don't - -- provide a default case. - | TestResultCaseMustHaveDefault + = -- | The test passed, and generated the given notes. + TestPassed [(String, String)] + | -- | The test did not run, because it was skipped with 'skipIf' + -- or 'skipWhen'. + TestSkipped + | -- | The test failed, generating the given notes and failures. + TestFailed [(String, String)] [Failure] + | -- | The test aborted with an error message, and generated the given + -- notes. + TestAborted [(String, String)] String + | -- Not exported; used to generate GHC warnings for users who don't + -- provide a default case. + TestResultCaseMustHaveDefault deriving (Show, Eq) -- | Contains details about a test failure. -data Failure = - Failure - { - -- | If given, the location of the failing assertion, expectation, +data Failure = Failure + { -- | If given, the location of the failing assertion, expectation, -- etc. -- -- 'failureLocation' is a field accessor, and can be used to update -- a 'Failure' value. - failureLocation :: Maybe Location - + failureLocation :: Maybe Location, -- | If given, a message which explains why the test failed. -- -- 'failureMessage' is a field accessor, and can be used to update -- a 'Failure' value. - , failureMessage :: String - } - deriving (Show, Eq) + failureMessage :: String + } + deriving (Show, Eq) -- | An empty 'Failure'; use the field accessors to populate this value. failure :: Failure failure = Failure Nothing "" -- | Contains details about a location in the test source file. -data Location = - Location - { - -- | A path to a source file, or empty if not provided. +data Location = Location + { -- | A path to a source file, or empty if not provided. -- -- 'locationFile' is a field accessor, and can be used to update -- a 'Location' value. - locationFile :: String - + locationFile :: String, -- | A Haskell module name, or empty if not provided. -- -- 'locationModule' is a field accessor, and can be used to update -- a 'Location' value. - , locationModule :: String - + locationModule :: String, -- | A line number, or Nothing if not provided. -- -- 'locationLine' is a field accessor, and can be used to update -- a 'Location' value. - , locationLine :: Maybe Integer - } - deriving (Show, Eq) + locationLine :: Maybe Integer + } + deriving (Show, Eq) -- | An empty 'Location'; use the field accessors to populate this value. location :: Location @@ -183,52 +160,49 @@ location = Location "" "" Nothing -- Note: earlier versions of Chell permitted arbitrary nesting of test suites. -- This feature proved too unwieldy, and was removed. A similar result can be -- achieved with 'suiteTests'; see the documentation for 'suite'. -data Suite = - Suite String [Test] - deriving Show - -class SuiteOrTest a - where - skipIf_ :: Bool -> a -> a - skipWhen_ :: IO Bool -> a -> a - -instance SuiteOrTest Suite - where - skipIf_ skip s@(Suite name children) = - if skip - then Suite name (map (skipIf_ skip) children) - else s - - skipWhen_ p (Suite name children) = - Suite name (map (skipWhen_ p) children) - -instance SuiteOrTest Test - where - skipIf_ skip t@(Test name _) = - if skip - then Test name (\_ -> return TestSkipped) - else t - - skipWhen_ p (Test name io) = - Test name - (\opts -> - do - skip <- p - if skip then return TestSkipped else io opts - ) +data Suite + = Suite String [Test] + deriving (Show) + +class SuiteOrTest a where + skipIf_ :: Bool -> a -> a + skipWhen_ :: IO Bool -> a -> a + +instance SuiteOrTest Suite where + skipIf_ skip s@(Suite name children) = + if skip + then Suite name (map (skipIf_ skip) children) + else s + + skipWhen_ p (Suite name children) = + Suite name (map (skipWhen_ p) children) + +instance SuiteOrTest Test where + skipIf_ skip t@(Test name _) = + if skip + then Test name (\_ -> return TestSkipped) + else t + + skipWhen_ p (Test name io) = + Test + name + ( \opts -> + do + skip <- p + if skip then return TestSkipped else io opts + ) -- | Conditionally skip tests. Use this to avoid commenting out tests -- which are currently broken, or do not work on the current platform. -- -- @ ---tests :: Suite ---tests = 'suite' \"tests\" +-- tests :: Suite +-- tests = 'suite' \"tests\" -- [ test_Foo -- , 'skipIf' builtOnUnix test_WindowsSpecific -- , test_Bar -- ] -- @ --- skipIf :: SuiteOrTest a => Bool -> a -> a skipIf = skipIf_ @@ -236,8 +210,8 @@ skipIf = skipIf_ -- predicate is checked before each test is started. -- -- @ ---tests :: Suite ---tests = 'suite' \"tests\" +-- tests :: Suite +-- tests = 'suite' \"tests\" -- [ test_Foo -- , 'skipWhen' noNetwork test_PingGoogle -- , test_Bar @@ -253,18 +227,18 @@ skipWhen = skipWhen_ -- achieved with 'suiteTests': -- -- @ ---test_Addition :: Test ---test_Subtraction :: Test ---test_Show :: Test +-- test_Addition :: Test +-- test_Subtraction :: Test +-- test_Show :: Test -- ---suite_Math :: Suite ---suite_Math = 'suite' \"math\" +-- suite_Math :: Suite +-- suite_Math = 'suite' \"math\" -- [ test_Addition -- , test_Subtraction -- ] -- ---suite_Prelude :: Suite ---suite_Prelude = 'suite' \"prelude\" +-- suite_Prelude :: Suite +-- suite_Prelude = 'suite' \"prelude\" -- ( -- [ test_Show -- ] @@ -298,12 +272,12 @@ suiteTests :: Suite -> [Test] suiteTests = go "" where prefixed prefix str = - if null prefix - then str - else prefix ++ "." ++ str + if null prefix + then str + else prefix ++ "." ++ str go prefix (Suite name children) = - concatMap (step (prefixed prefix name)) children + concatMap (step (prefixed prefix name)) children step prefix (Test name io) = [Test (prefixed prefix name) io] @@ -315,29 +289,27 @@ runTest (Test _ io) options = handleJankyIO options (io options) (return []) handleJankyIO :: TestOptions -> IO TestResult -> IO [(String, String)] -> IO TestResult handleJankyIO opts getResult getNotes = do - let - withTimeout = - case testOptionTimeout opts of - Just time -> timeout (time * 1000) - Nothing -> fmap Just + let withTimeout = + case testOptionTimeout opts of + Just time -> timeout (time * 1000) + Nothing -> fmap Just - let - hitTimeout = str + let hitTimeout = str where str = "Test timed out after " ++ show time ++ " milliseconds" Just time = testOptionTimeout opts tried <- withTimeout (try getResult) case tried of - Just (Right ret) -> return ret - Nothing -> - do - notes <- getNotes - return (TestAborted notes hitTimeout) - Just (Left err) -> - do - notes <- getNotes - return (TestAborted notes err) + Just (Right ret) -> return ret + Nothing -> + do + notes <- getNotes + return (TestAborted notes hitTimeout) + Just (Left err) -> + do + notes <- getNotes + return (TestAborted notes err) try :: IO a -> IO (Either String a) try io = catches (fmap Right io) [Handler handleAsync, Handler handleExc] diff --git a/chell/changelog.md b/chell/changelog.md index 4cb6a58..785b6d8 100644 --- a/chell/changelog.md +++ b/chell/changelog.md @@ -1,14 +1,35 @@ -# Release history for `chell` +## 0.5.0.2 -0.5.0.1 - 2021 Jan 14 +Miscellaneous updates and cleanup - * Support up to GHC 9.2 - * Tighten various version bounds +Published by: Chris Martin -0.5 - 2019 Feb 16 +Date: 2023-07-11 - * Add support for `patience` 0.2 - * Drop support for `patience` 0.1 - * Add support for `ansi-terminal` 0.8 +## 0.5.0.1 -0.4.0.2 - 2017 Dec 12 +Support up to GHC 9.2 + +Tighten various version bounds + +Published by: Chris Martin + +Date: 2021-01-14 + +## 0.5 + +Add support for `patience` 0.2 + +Drop support for `patience` 0.1 + +Add support for `ansi-terminal` 0.8 + +Published by: Chris Martin + +Date: 2019-02-16 + +## 0.4.0.2 + +Published by: John Millikin + +Date: 2017-12-12 diff --git a/chell/chell.cabal b/chell/chell.cabal index 555fbbd..d39bcf5 100644 --- a/chell/chell.cabal +++ b/chell/chell.cabal @@ -1,7 +1,7 @@ cabal-version: 3.0 name: chell -version: 0.5.0.1 +version: 0.5.0.2 synopsis: A simple and intuitive library for automated testing. category: Testing @@ -10,82 +10,42 @@ license: MIT license-file: license.txt author: John Millikin maintainer: Chris Martin, Julie Moronuki -build-type: Simple -homepage: https://github.com/typeclasses/chell -bug-reports: https://github.com/typeclasses/chell/issues +homepage: https://github.com/typeclasses/chell description: - Chell is a simple and intuitive library for automated testing. It natively - supports assertion-based testing, and can use companion libraries - such as @chell-quickcheck@ to support more complex testing strategies. + Chell is a simple and intuitive library for automated testing. + It natively supports assertion-based testing, and can use companion libraries + such as @chell-quickcheck@ to support more complex testing strategies. - An example test suite, which verifies the behavior of arithmetic operators. - - @ - {-\# LANGUAGE TemplateHaskell \#-} - - import Test.Chell - - tests_Math :: Suite - tests_Math = suite \"math\" - [ test_Addition - , test_Subtraction - ] - - test_Addition :: Test - test_Addition = assertions \"addition\" $ do - $expect (equal (2 + 1) 3) - $expect (equal (1 + 2) 3) - - test_Subtraction :: Test - test_Subtraction = assertions \"subtraction\" $ do - $expect (equal (2 - 1) 1) - $expect (equal (1 - 2) (-1)) - - main :: IO () - main = defaultMain [tests_Math] - @ - - @ - $ ghc --make chell-example.hs - $ ./chell-example - PASS: 2 tests run, 2 tests passed - @ - -extra-source-files: - changelog.md - -source-repository head - type: git - location: https://github.com/typeclasses/chell.git +extra-source-files: *.md flag color-output - description: Enable colored output in test results - default: True + description: Enable colored output in test results + default: True library - default-language: Haskell2010 - ghc-options: -Wall + default-language: GHC2021 + ghc-options: -Wall - build-depends: - base >= 4.10 && < 4.17 - , bytestring >= 0.10.8.2 && < 0.12 - , options >= 1.2.1 && < 1.3 - , patience >= 0.2 && < 0.4 - , random >= 1.1 && < 1.3 - , template-haskell >= 2.12 && < 2.19 - , text >= 1.2.3 && < 1.2.6 - , transformers >= 0.5.2 && < 0.6 - - if flag(color-output) build-depends: - ansi-terminal >= 0.8 && < 0.12 - - exposed-modules: - Test.Chell - - other-modules: - Test.Chell.Main - Test.Chell.Output - Test.Chell.Types + , base ^>= 4.16 || ^>= 4.17 || ^>= 4.18 + , bytestring ^>= 0.11.4 || ^>= 0.12 + , options ^>= 1.2.1 + , patience ^>= 0.3 + , random ^>= 1.2.1 + , template-haskell ^>=2.18 || ^>= 2.19 || ^>= 2.20 + , text ^>= 1.2.5 || ^>= 2.0 + , transformers ^>= 0.5.6 || ^>= 0.6 + + if flag(color-output) + build-depends: + , ansi-terminal ^>= 1.0 + + exposed-modules: + Test.Chell + + other-modules: + Test.Chell.Main + Test.Chell.Output + Test.Chell.Types diff --git a/chell/license.txt b/chell/license.txt deleted file mode 120000 index 0194195..0000000 --- a/chell/license.txt +++ /dev/null @@ -1 +0,0 @@ -../license.txt \ No newline at end of file diff --git a/chell/license.txt b/chell/license.txt new file mode 100644 index 0000000..2cdd7ee --- /dev/null +++ b/chell/license.txt @@ -0,0 +1,22 @@ +Copyright (c) 2011 John Millikin + +Permission is hereby granted, free of charge, to any person +obtaining a copy of this software and associated documentation +files (the "Software"), to deal in the Software without +restriction, including without limitation the rights to use, +copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the +Software is furnished to do so, subject to the following +conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +OTHER DEALINGS IN THE SOFTWARE. diff --git a/chell/readme.md b/chell/readme.md new file mode 100644 index 0000000..4fa248f --- /dev/null +++ b/chell/readme.md @@ -0,0 +1,33 @@ +Chell is a simple and intuitive library for automated testing. +It natively supports assertion-based testing, and can use companion libraries +such as `chell-quickcheck` to support more complex testing strategies. + +An example test suite, which verifies the behavior of arithmetic operators. + +```haskell +{-# LANGUAGE TemplateHaskell #-} + +import Test.Chell + +tests_Math :: Suite +tests_Math = suite "math" [test_Addition, test_Subtraction] + +test_Addition :: Test +test_Addition = assertions "addition" $ do + $expect (equal (2 + 1) 3) + $expect (equal (1 + 2) 3) + +test_Subtraction :: Test +test_Subtraction = assertions "subtraction" $ do + $expect (equal (2 - 1) 1) + $expect (equal (1 - 2) (-1)) + +main :: IO () +main = defaultMain [tests_Math] +``` + +``` +$ ghc --make chell-example.hs +$ ./chell-example +PASS: 2 tests run, 2 tests passed +``` diff --git a/configurations/ghc-8.10.project b/configurations/ghc-8.10.project deleted file mode 100644 index 3eb862f..0000000 --- a/configurations/ghc-8.10.project +++ /dev/null @@ -1,13 +0,0 @@ -packages: chell, chell-hunit, chell-quickcheck - -package chell - flags: +color-output - -constraints: - ansi-terminal ^>= 0.10 - , base ^>= 4.14 - , bytestring == 0.11.0.0 - , patience == 0.2.1.1 - , QuickCheck ^>= 2.13 - , template-haskell ^>= 2.16 - , text == 1.2.4.* diff --git a/configurations/ghc-8.2.project b/configurations/ghc-8.2.project deleted file mode 100644 index 8638618..0000000 --- a/configurations/ghc-8.2.project +++ /dev/null @@ -1,15 +0,0 @@ -packages: chell, chell-hunit, chell-quickcheck - -package chell - flags: +color-output - -constraints: - ansi-terminal ^>= 0.8 - , base ^>= 4.10 - , bytestring == 0.10.8.2 - , HUnit ^>= 1.3 - , patience == 0.2.0.0 - , QuickCheck ^>= 2.7 - , random == 1.1 - , template-haskell ^>= 2.12 - , transformers == 0.5.2.* diff --git a/configurations/ghc-8.4.project b/configurations/ghc-8.4.project deleted file mode 100644 index 0148c97..0000000 --- a/configurations/ghc-8.4.project +++ /dev/null @@ -1,10 +0,0 @@ -packages: chell, chell-hunit, chell-quickcheck - -package chell - flags: +color-output - -constraints: - base ^>= 4.11 - , QuickCheck ^>= 2.8 - , template-haskell ^>= 2.13 - , text == 1.2.3.* diff --git a/configurations/ghc-8.6.project b/configurations/ghc-8.6.project deleted file mode 100644 index 8e724ba..0000000 --- a/configurations/ghc-8.6.project +++ /dev/null @@ -1,11 +0,0 @@ -packages: chell, chell-hunit, chell-quickcheck - -package chell - flags: +color-output - -constraints: - ansi-terminal ^>= 0.9 - , base ^>= 4.12 - , patience == 0.2.1.0 - , QuickCheck ^>= 2.9 - , template-haskell ^>= 2.14 diff --git a/configurations/ghc-8.8.project b/configurations/ghc-8.8.project deleted file mode 100644 index f48d918..0000000 --- a/configurations/ghc-8.8.project +++ /dev/null @@ -1,10 +0,0 @@ -packages: chell, chell-hunit, chell-quickcheck - -package chell - flags: +color-output - -constraints: - base ^>= 4.13 - , bytestring == 0.10.8.2 - , QuickCheck ^>= 2.13 - , template-haskell ^>= 2.15 diff --git a/configurations/ghc-9.0.project b/configurations/ghc-9.0.project deleted file mode 100644 index c3f6a63..0000000 --- a/configurations/ghc-9.0.project +++ /dev/null @@ -1,12 +0,0 @@ -packages: chell, chell-hunit, chell-quickcheck - -package chell - flags: +color-output - -constraints: - base ^>= 4.15 - , bytestring == 0.11.1.0 - , QuickCheck ^>= 2.14 - , random == 1.2.0 - , template-haskell ^>= 2.17 - , transformers == 0.5.6.* diff --git a/configurations/ghc-9.2.project b/configurations/ghc-9.2.project deleted file mode 100644 index da397fb..0000000 --- a/configurations/ghc-9.2.project +++ /dev/null @@ -1,15 +0,0 @@ -packages: chell, chell-hunit, chell-quickcheck - -package chell - flags: +color-output - -constraints: - ansi-terminal ^>= 0.11 - , base ^>= 4.16 - , bytestring == 0.11.2.0 - , HUnit ^>= 1.6 - , patience == 0.3 - , QuickCheck ^>= 2.14 - , random == 1.2.1 - , template-haskell ^>= 2.18 - , text == 1.2.5.* diff --git a/flake.lock b/flake.lock new file mode 100644 index 0000000..fc47d9d --- /dev/null +++ b/flake.lock @@ -0,0 +1,61 @@ +{ + "nodes": { + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1687709756, + "narHash": "sha256-Y5wKlQSkgEK2weWdOu4J3riRd+kV/VCgHsqLNTTWQ/0=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "dbabf0ca0c0c4bce6ea5eaf65af5cb694d2082c7", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1688868408, + "narHash": "sha256-RR9N5XTAxSBhK8MCvLq9uxfdkd7etC//seVXldy0k48=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "510d721ce097150ae3b80f84b04b13b039186571", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixos-23.05", + "repo": "nixpkgs", + "type": "github" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "nixpkgs": "nixpkgs" + } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..df8629e --- /dev/null +++ b/flake.nix @@ -0,0 +1,14 @@ +{ + inputs = { + nixpkgs.url = "github:NixOS/nixpkgs/nixos-23.05"; + flake-utils.url = "github:numtide/flake-utils"; + }; + + outputs = inputs: + inputs.flake-utils.lib.eachDefaultSystem (system: + let + pkgs = import inputs.nixpkgs { inherit system; }; + in + import ./nix { inherit pkgs; } + ); +} diff --git a/license.txt b/license.txt deleted file mode 100644 index 2cdd7ee..0000000 --- a/license.txt +++ /dev/null @@ -1,22 +0,0 @@ -Copyright (c) 2011 John Millikin - -Permission is hereby granted, free of charge, to any person -obtaining a copy of this software and associated documentation -files (the "Software"), to deal in the Software without -restriction, including without limitation the rights to use, -copy, modify, merge, publish, distribute, sublicense, and/or sell -copies of the Software, and to permit persons to whom the -Software is furnished to do so, subject to the following -conditions: - -The above copyright notice and this permission notice shall be -included in all copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, -EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES -OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND -NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT -HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, -WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR -OTHER DEALINGS IN THE SOFTWARE. diff --git a/nix/default.nix b/nix/default.nix new file mode 100644 index 0000000..6994076 --- /dev/null +++ b/nix/default.nix @@ -0,0 +1,88 @@ +{ pkgs }: + +let + inherit (pkgs.lib) fold composeExtensions concatMap attrValues; + + combineOverrides = old: + fold composeExtensions (old.overrides or (_: _: { })); + + makeTestConfiguration = { ghc ? pkgs.haskellPackages, overrides ? new: old: { } }: + let + inherit (pkgs.haskell.lib) dontCheck packageSourceOverrides; + in + rec { + haskellPackages = + ghc.override (old: { + overrides = + combineOverrides old [ + (packageSourceOverrides { + chell = ../chell; + chell-hunit = ../chell-hunit; + chell-quickcheck = ../chell-quickcheck; + }) + overrides + ]; + }); + + all = pkgs.symlinkJoin { + name = "chell-packages"; + paths = [ + haskellPackages.chell + haskellPackages.chell-hunit + haskellPackages.chell-quickcheck + ]; + }; + }; + + testConfigurations = + rec { + ghc-9-2 = makeTestConfiguration { + ghc = pkgs.haskell.packages.ghc92; + overrides = new: old: { + monads-tf = new.callPackage ./haskell/monads-tf.nix { }; + options = new.callPackage ./haskell/options.nix { }; + }; + }; + ghc-9-4 = makeTestConfiguration { + ghc = pkgs.haskell.packages.ghc94; + overrides = new: old: { + monads-tf = new.callPackage ./haskell/monads-tf.nix { }; + options = new.callPackage ./haskell/options.nix { }; + }; + }; + ghc-9-6 = makeTestConfiguration { + ghc = pkgs.haskell.packages.ghc96; + overrides = new: old: { + monads-tf = new.callPackage ./haskell/monads-tf.nix { }; + options = new.callPackage ./haskell/options.nix { }; + }; + }; + all = pkgs.symlinkJoin { + name = "chell-tests"; + paths = [ ghc-9-2.all ghc-9-4.all ghc-9-6.all ]; + }; + }; + +in +{ + + packages = { + inherit testConfigurations; + }; + + devShells.default = pkgs.mkShell { + inputsFrom = [ + (makeTestConfiguration { + overrides = new: old: { + monads-tf = new.callPackage ./haskell/monads-tf.nix { }; + options = new.callPackage ./haskell/options.nix { }; + }; + }).haskellPackages.chell.env + ]; + buildInputs = [ + pkgs.haskell-language-server + pkgs.cabal-install + ]; + }; + +} diff --git a/nix/haskell/monads-tf.nix b/nix/haskell/monads-tf.nix new file mode 100644 index 0000000..6e99dd2 --- /dev/null +++ b/nix/haskell/monads-tf.nix @@ -0,0 +1,10 @@ +{ mkDerivation, base, lib, transformers }: +mkDerivation { + pname = "monads-tf"; + version = "0.3.0.1"; + sha256 = "21bcd293bf663b6cf993600a3357da724e09c088bdb0ba792f7afc8b69fa5f02"; + libraryHaskellDepends = [ base transformers ]; + homepage = "https://github.com/typeclasses/monads-tf"; + description = "Monad classes, using type families"; + license = lib.licenses.bsd3; +} diff --git a/nix/haskell/options.nix b/nix/haskell/options.nix new file mode 100644 index 0000000..ad8a84e --- /dev/null +++ b/nix/haskell/options.nix @@ -0,0 +1,13 @@ +{ mkDerivation, base, containers, hspec, lib, monads-tf, patience +}: +mkDerivation { + pname = "options"; + version = "1.2.1.2"; + sha256 = "6e4d8fa177713d00f95cb43d21359a7d2908ce1e04f703be5b59679ccc3a5f4a"; + libraryHaskellDepends = [ base containers monads-tf ]; + testHaskellDepends = [ base containers hspec monads-tf patience ]; + doHaddock = false; + homepage = "https://github.com/typeclasses/options/"; + description = "Powerful and easy command-line option parser"; + license = lib.licenses.mit; +} diff --git a/readme.md b/readme.md index 32033d3..3fc7b0b 100644 --- a/readme.md +++ b/readme.md @@ -2,6 +2,12 @@ A quiet test runner for Haskell +## Building + +To build and test with all supported compiler versions: + + nix build .#testConfigurations.all --no-link + ## History Back in 2011 or so, the most popular Haskell test frameworks generated a lot of status output but relatively little info about why tests failed. John Millikin wrote Chell so that tests would be quiet if they passed, and give to-the-line error info on failure. From 73d53a1d8f3106e7237fb0b75f26307f631db645 Mon Sep 17 00:00:00 2001 From: Vekhir <134215107+Vekhir@users.noreply.github.com> Date: Wed, 31 Jan 2024 21:24:21 +0100 Subject: [PATCH 33/36] Support GHC 9.8 --- chell-quickcheck/chell-quickcheck.cabal | 2 +- chell/chell.cabal | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/chell-quickcheck/chell-quickcheck.cabal b/chell-quickcheck/chell-quickcheck.cabal index dbb922b..68150f4 100644 --- a/chell-quickcheck/chell-quickcheck.cabal +++ b/chell-quickcheck/chell-quickcheck.cabal @@ -23,7 +23,7 @@ library ghc-options: -Wall build-depends: - , base ^>= 4.16 || ^>= 4.17 || ^>= 4.18 + , base ^>= 4.16 || ^>= 4.17 || ^>= 4.18 || ^>= 4.19 , chell ^>= 0.5 , QuickCheck ^>= 2.14.2 , random ^>= 1.2.1 diff --git a/chell/chell.cabal b/chell/chell.cabal index d39bcf5..3082c89 100644 --- a/chell/chell.cabal +++ b/chell/chell.cabal @@ -29,13 +29,13 @@ library ghc-options: -Wall build-depends: - , base ^>= 4.16 || ^>= 4.17 || ^>= 4.18 + , base ^>= 4.16 || ^>= 4.17 || ^>= 4.18 || ^>= 4.19 , bytestring ^>= 0.11.4 || ^>= 0.12 , options ^>= 1.2.1 , patience ^>= 0.3 , random ^>= 1.2.1 - , template-haskell ^>=2.18 || ^>= 2.19 || ^>= 2.20 - , text ^>= 1.2.5 || ^>= 2.0 + , template-haskell ^>=2.18 || ^>= 2.19 || ^>= 2.20 || ^>= 2.21 + , text ^>= 1.2.5 || ^>= 2.0 || ^>= 2.1 , transformers ^>= 0.5.6 || ^>= 0.6 if flag(color-output) From 6d48ddff80f47494e255b7ccec70fd1a7636f4f2 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Wed, 13 Nov 2024 11:13:11 +0100 Subject: [PATCH 34/36] Allow base < 4.22, Haskell-CI for GHC 9.2 - 9.12.0 --- .github/workflows/haskell-ci.yml | 268 ++++++++++++++++++++++++ cabal.haskell-ci | 1 + chell-hunit/chell-hunit.cabal | 10 +- chell-quickcheck/chell-quickcheck.cabal | 10 +- chell/chell.cabal | 12 +- 5 files changed, 297 insertions(+), 4 deletions(-) create mode 100644 .github/workflows/haskell-ci.yml create mode 100644 cabal.haskell-ci diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml new file mode 100644 index 0000000..96a18c9 --- /dev/null +++ b/.github/workflows/haskell-ci.yml @@ -0,0 +1,268 @@ +# This GitHub workflow config has been generated by a script via +# +# haskell-ci 'github' 'cabal.project' +# +# To regenerate the script (for example after adjusting tested-with) run +# +# haskell-ci regenerate +# +# For more information, see https://github.com/andreasabel/haskell-ci +# +# version: 0.19.20241113 +# +# REGENDATA ("0.19.20241113",["github","cabal.project"]) +# +name: Haskell-CI +on: + push: + branches: + - master + pull_request: + branches: + - master +jobs: + linux: + name: Haskell-CI - Linux - ${{ matrix.compiler }} + runs-on: ubuntu-20.04 + timeout-minutes: + 60 + container: + image: buildpack-deps:jammy + continue-on-error: ${{ matrix.allow-failure }} + strategy: + matrix: + include: + - compiler: ghc-9.12.0.20241031 + compilerKind: ghc + compilerVersion: 9.12.0.20241031 + setup-method: ghcup-prerelease + allow-failure: false + - compiler: ghc-9.10.1 + compilerKind: ghc + compilerVersion: 9.10.1 + setup-method: ghcup + allow-failure: false + - compiler: ghc-9.8.2 + compilerKind: ghc + compilerVersion: 9.8.2 + setup-method: ghcup + allow-failure: false + - compiler: ghc-9.6.6 + compilerKind: ghc + compilerVersion: 9.6.6 + setup-method: ghcup + allow-failure: false + - compiler: ghc-9.4.8 + compilerKind: ghc + compilerVersion: 9.4.8 + setup-method: ghcup + allow-failure: false + - compiler: ghc-9.2.8 + compilerKind: ghc + compilerVersion: 9.2.8 + setup-method: ghcup + allow-failure: false + fail-fast: false + steps: + - name: apt-get install + run: | + apt-get update + apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 + - name: Install GHCup + run: | + mkdir -p "$HOME/.ghcup/bin" + curl -sL https://downloads.haskell.org/ghcup/0.1.30.0/x86_64-linux-ghcup-0.1.30.0 > "$HOME/.ghcup/bin/ghcup" + chmod a+x "$HOME/.ghcup/bin/ghcup" + - name: Install cabal-install + run: | + "$HOME/.ghcup/bin/ghcup" install cabal 3.12.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) + echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" + - name: Install GHC (GHCup) + if: matrix.setup-method == 'ghcup' + run: | + "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) + HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") + HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') + HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') + echo "HC=$HC" >> "$GITHUB_ENV" + echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" + echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" + env: + HCKIND: ${{ matrix.compilerKind }} + HCNAME: ${{ matrix.compiler }} + HCVER: ${{ matrix.compilerVersion }} + - name: Install GHC (GHCup prerelease) + if: matrix.setup-method == 'ghcup-prerelease' + run: | + "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.8.yaml; + "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) + HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") + HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') + HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') + echo "HC=$HC" >> "$GITHUB_ENV" + echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" + echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" + env: + HCKIND: ${{ matrix.compilerKind }} + HCNAME: ${{ matrix.compiler }} + HCVER: ${{ matrix.compilerVersion }} + - name: Set PATH and environment variables + run: | + echo "$HOME/.cabal/bin" >> $GITHUB_PATH + echo "LANG=C.UTF-8" >> "$GITHUB_ENV" + echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" + echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" + HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') + echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" + echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" + echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" + if [ $((HCNUMVER >= 91200)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi + echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" + env: + HCKIND: ${{ matrix.compilerKind }} + HCNAME: ${{ matrix.compiler }} + HCVER: ${{ matrix.compilerVersion }} + - name: env + run: | + env + - name: write cabal config + run: | + mkdir -p $CABAL_DIR + cat >> $CABAL_CONFIG <> $CABAL_CONFIG <> $CABAL_CONFIG < cabal-plan.xz + echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c - + xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan + rm -f cabal-plan.xz + chmod a+x $HOME/.cabal/bin/cabal-plan + cabal-plan --version + - name: checkout + uses: actions/checkout@v4 + with: + path: source + - name: initial cabal.project for sdist + run: | + touch cabal.project + echo "packages: $GITHUB_WORKSPACE/source/chell" >> cabal.project + echo "packages: $GITHUB_WORKSPACE/source/chell-hunit" >> cabal.project + echo "packages: $GITHUB_WORKSPACE/source/chell-quickcheck" >> cabal.project + cat cabal.project + - name: sdist + run: | + mkdir -p sdist + $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist + - name: unpack + run: | + mkdir -p unpacked + find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \; + - name: generate cabal.project + run: | + PKGDIR_chell="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/chell-[0-9.]*')" + echo "PKGDIR_chell=${PKGDIR_chell}" >> "$GITHUB_ENV" + PKGDIR_chell_hunit="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/chell-hunit-[0-9.]*')" + echo "PKGDIR_chell_hunit=${PKGDIR_chell_hunit}" >> "$GITHUB_ENV" + PKGDIR_chell_quickcheck="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/chell-quickcheck-[0-9.]*')" + echo "PKGDIR_chell_quickcheck=${PKGDIR_chell_quickcheck}" >> "$GITHUB_ENV" + rm -f cabal.project cabal.project.local + touch cabal.project + touch cabal.project.local + echo "packages: ${PKGDIR_chell}" >> cabal.project + echo "packages: ${PKGDIR_chell_hunit}" >> cabal.project + echo "packages: ${PKGDIR_chell_quickcheck}" >> cabal.project + echo "package chell" >> cabal.project + echo " ghc-options: -Werror=missing-methods" >> cabal.project + echo "package chell-hunit" >> cabal.project + echo " ghc-options: -Werror=missing-methods" >> cabal.project + echo "package chell-quickcheck" >> cabal.project + echo " ghc-options: -Werror=missing-methods" >> cabal.project + cat >> cabal.project <> cabal.project + fi + $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(chell|chell-hunit|chell-quickcheck)$/; }' >> cabal.project.local + cat cabal.project + cat cabal.project.local + - name: dump install plan + run: | + $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all + cabal-plan + - name: restore cache + uses: actions/cache/restore@v4 + with: + key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} + path: ~/.cabal/store + restore-keys: ${{ runner.os }}-${{ matrix.compiler }}- + - name: install dependencies + run: | + $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all + $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all + - name: build w/o tests + run: | + $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all + - name: build + run: | + $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always + - name: cabal check + run: | + cd ${PKGDIR_chell} || false + ${CABAL} -vnormal check + cd ${PKGDIR_chell_hunit} || false + ${CABAL} -vnormal check + cd ${PKGDIR_chell_quickcheck} || false + ${CABAL} -vnormal check + - name: haddock + run: | + $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all + - name: unconstrained build + run: | + rm -f cabal.project.local + $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all + - name: save cache + if: always() + uses: actions/cache/save@v4 + with: + key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} + path: ~/.cabal/store diff --git a/cabal.haskell-ci b/cabal.haskell-ci new file mode 100644 index 0000000..6863845 --- /dev/null +++ b/cabal.haskell-ci @@ -0,0 +1 @@ +branches: master \ No newline at end of file diff --git a/chell-hunit/chell-hunit.cabal b/chell-hunit/chell-hunit.cabal index 55703cf..ef07314 100644 --- a/chell-hunit/chell-hunit.cabal +++ b/chell-hunit/chell-hunit.cabal @@ -18,12 +18,20 @@ description: extra-source-files: *.md +tested-with: + GHC == 9.12.0 + GHC == 9.10.1 + GHC == 9.8.2 + GHC == 9.6.6 + GHC == 9.4.8 + GHC == 9.2.8 + library default-language: GHC2021 ghc-options: -Wall build-depends: - , base ^>= 4.16 || ^>= 4.17 || ^>= 4.18 + , base ^>= 4.16 || ^>= 4.17 || ^>= 4.18 || ^>= 4.19 || ^>= 4.20 || ^>= 4.21 , chell ^>= 0.5 , HUnit ^>= 1.6.2 diff --git a/chell-quickcheck/chell-quickcheck.cabal b/chell-quickcheck/chell-quickcheck.cabal index 68150f4..403d7ef 100644 --- a/chell-quickcheck/chell-quickcheck.cabal +++ b/chell-quickcheck/chell-quickcheck.cabal @@ -18,12 +18,20 @@ description: extra-source-files: *.md +tested-with: + GHC == 9.12.0 + GHC == 9.10.1 + GHC == 9.8.2 + GHC == 9.6.6 + GHC == 9.4.8 + GHC == 9.2.8 + library default-language: GHC2021 ghc-options: -Wall build-depends: - , base ^>= 4.16 || ^>= 4.17 || ^>= 4.18 || ^>= 4.19 + , base ^>= 4.16 || ^>= 4.17 || ^>= 4.18 || ^>= 4.19 || ^>= 4.20 || ^>= 4.21 , chell ^>= 0.5 , QuickCheck ^>= 2.14.2 , random ^>= 1.2.1 diff --git a/chell/chell.cabal b/chell/chell.cabal index 3082c89..5a1a242 100644 --- a/chell/chell.cabal +++ b/chell/chell.cabal @@ -20,6 +20,14 @@ description: extra-source-files: *.md +tested-with: + GHC == 9.12.0 + GHC == 9.10.1 + GHC == 9.8.2 + GHC == 9.6.6 + GHC == 9.4.8 + GHC == 9.2.8 + flag color-output description: Enable colored output in test results default: True @@ -29,12 +37,12 @@ library ghc-options: -Wall build-depends: - , base ^>= 4.16 || ^>= 4.17 || ^>= 4.18 || ^>= 4.19 + , base ^>= 4.16 || ^>= 4.17 || ^>= 4.18 || ^>= 4.19 || ^>= 4.20 || ^>= 4.21 , bytestring ^>= 0.11.4 || ^>= 0.12 , options ^>= 1.2.1 , patience ^>= 0.3 , random ^>= 1.2.1 - , template-haskell ^>=2.18 || ^>= 2.19 || ^>= 2.20 || ^>= 2.21 + , template-haskell ^>=2.18 || ^>= 2.19 || ^>= 2.20 || ^>= 2.21 || ^>= 2.22 , text ^>= 1.2.5 || ^>= 2.0 || ^>= 2.1 , transformers ^>= 0.5.6 || ^>= 0.6 From 9ffcae786267595b21077ed109aecf0433296acc Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Wed, 13 Nov 2024 17:37:46 +0100 Subject: [PATCH 35/36] Allow ansi-terminal-1.1 --- .gitignore | 2 ++ chell/chell.cabal | 3 ++- stack.yaml | 9 +++++++++ 3 files changed, 13 insertions(+), 1 deletion(-) create mode 100644 stack.yaml diff --git a/.gitignore b/.gitignore index fcc048c..81c772e 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,5 @@ dist-* .ghc.* result result-* +.stack-work/ +stack*.yaml.lock diff --git a/chell/chell.cabal b/chell/chell.cabal index 5a1a242..8e789d2 100644 --- a/chell/chell.cabal +++ b/chell/chell.cabal @@ -2,6 +2,7 @@ cabal-version: 3.0 name: chell version: 0.5.0.2 +x-revision: 2 synopsis: A simple and intuitive library for automated testing. category: Testing @@ -48,7 +49,7 @@ library if flag(color-output) build-depends: - , ansi-terminal ^>= 1.0 + , ansi-terminal ^>= 1.0 || ^>= 1.1 exposed-modules: Test.Chell diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..6c76f34 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,9 @@ +resolver: nightly-2024-10-21 + +packages: +- chell +- chell-hunit +- chell-quickcheck + +extra-deps: +- patience-0.3 From 5e26ea8b0e645468c87fcc488b2471a877770600 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Tue, 7 Jan 2025 09:25:12 +0100 Subject: [PATCH 36/36] Support GHC 9.12.1 --- .github/workflows/haskell-ci.yml | 48 +++++-------------------- chell-hunit/chell-hunit.cabal | 2 +- chell-quickcheck/chell-quickcheck.cabal | 5 +-- chell/chell.cabal | 8 ++--- 4 files changed, 17 insertions(+), 46 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 96a18c9..d56c819 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -6,11 +6,11 @@ # # haskell-ci regenerate # -# For more information, see https://github.com/andreasabel/haskell-ci +# For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.19.20241113 +# version: 0.19.20241223 # -# REGENDATA ("0.19.20241113",["github","cabal.project"]) +# REGENDATA ("0.19.20241223",["github","cabal.project"]) # name: Haskell-CI on: @@ -32,10 +32,10 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.12.0.20241031 + - compiler: ghc-9.12.1 compilerKind: ghc - compilerVersion: 9.12.0.20241031 - setup-method: ghcup-prerelease + compilerVersion: 9.12.1 + setup-method: ghcup allow-failure: false - compiler: ghc-9.10.1 compilerKind: ghc @@ -75,8 +75,8 @@ jobs: chmod a+x "$HOME/.ghcup/bin/ghcup" - name: Install cabal-install run: | - "$HOME/.ghcup/bin/ghcup" install cabal 3.12.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) - echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" + "$HOME/.ghcup/bin/ghcup" install cabal 3.14.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) + echo "CABAL=$HOME/.ghcup/bin/cabal-3.14.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" - name: Install GHC (GHCup) if: matrix.setup-method == 'ghcup' run: | @@ -91,21 +91,6 @@ jobs: HCKIND: ${{ matrix.compilerKind }} HCNAME: ${{ matrix.compiler }} HCVER: ${{ matrix.compilerVersion }} - - name: Install GHC (GHCup prerelease) - if: matrix.setup-method == 'ghcup-prerelease' - run: | - "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.8.yaml; - "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) - HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") - HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') - HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') - echo "HC=$HC" >> "$GITHUB_ENV" - echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" - echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" - env: - HCKIND: ${{ matrix.compilerKind }} - HCNAME: ${{ matrix.compiler }} - HCVER: ${{ matrix.compilerVersion }} - name: Set PATH and environment variables run: | echo "$HOME/.cabal/bin" >> $GITHUB_PATH @@ -116,7 +101,7 @@ jobs: echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" - if [ $((HCNUMVER >= 91200)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi + echo "HEADHACKAGE=false" >> "$GITHUB_ENV" echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" env: HCKIND: ${{ matrix.compilerKind }} @@ -144,18 +129,6 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF - if $HEADHACKAGE; then - cat >> $CABAL_CONFIG <> $CABAL_CONFIG <> cabal.project cat >> cabal.project <> cabal.project - fi $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(chell|chell-hunit|chell-quickcheck)$/; }' >> cabal.project.local cat cabal.project cat cabal.project.local diff --git a/chell-hunit/chell-hunit.cabal b/chell-hunit/chell-hunit.cabal index ef07314..2c20d95 100644 --- a/chell-hunit/chell-hunit.cabal +++ b/chell-hunit/chell-hunit.cabal @@ -19,7 +19,7 @@ description: extra-source-files: *.md tested-with: - GHC == 9.12.0 + GHC == 9.12.1 GHC == 9.10.1 GHC == 9.8.2 GHC == 9.6.6 diff --git a/chell-quickcheck/chell-quickcheck.cabal b/chell-quickcheck/chell-quickcheck.cabal index 403d7ef..e854412 100644 --- a/chell-quickcheck/chell-quickcheck.cabal +++ b/chell-quickcheck/chell-quickcheck.cabal @@ -2,6 +2,7 @@ cabal-version: 3.0 name: chell-quickcheck version: 0.2.5.4 +x-revision: 2 synopsis: QuickCheck support for Chell category: Testing @@ -19,7 +20,7 @@ description: extra-source-files: *.md tested-with: - GHC == 9.12.0 + GHC == 9.12.1 GHC == 9.10.1 GHC == 9.8.2 GHC == 9.6.6 @@ -34,7 +35,7 @@ library , base ^>= 4.16 || ^>= 4.17 || ^>= 4.18 || ^>= 4.19 || ^>= 4.20 || ^>= 4.21 , chell ^>= 0.5 , QuickCheck ^>= 2.14.2 - , random ^>= 1.2.1 + , random ^>= 1.2.1 || ^>= 1.3.0 exposed-modules: Test.Chell.QuickCheck diff --git a/chell/chell.cabal b/chell/chell.cabal index 8e789d2..4e6be34 100644 --- a/chell/chell.cabal +++ b/chell/chell.cabal @@ -2,7 +2,7 @@ cabal-version: 3.0 name: chell version: 0.5.0.2 -x-revision: 2 +x-revision: 4 synopsis: A simple and intuitive library for automated testing. category: Testing @@ -22,7 +22,7 @@ description: extra-source-files: *.md tested-with: - GHC == 9.12.0 + GHC == 9.12.1 GHC == 9.10.1 GHC == 9.8.2 GHC == 9.6.6 @@ -42,8 +42,8 @@ library , bytestring ^>= 0.11.4 || ^>= 0.12 , options ^>= 1.2.1 , patience ^>= 0.3 - , random ^>= 1.2.1 - , template-haskell ^>=2.18 || ^>= 2.19 || ^>= 2.20 || ^>= 2.21 || ^>= 2.22 + , random ^>= 1.2.1 || ^>= 1.3.0 + , template-haskell ^>=2.18 || ^>= 2.19 || ^>= 2.20 || ^>= 2.21 || ^>= 2.22 || ^>= 2.23 , text ^>= 1.2.5 || ^>= 2.0 || ^>= 2.1 , transformers ^>= 0.5.6 || ^>= 0.6