lame-tester 1.2.1 → 1.4.0

raw patch · 6 files changed

+79/−51 lines, 6 filesdep +base-nopreludedep +bizzleludedep −basedep −bifunctorsdep ~containersdep ~lame-testerdep ~semigroupssetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: base-noprelude, bizzlelude

Dependencies removed: base, bifunctors

Dependency ranges changed: containers, lame-tester, semigroups, tasty, tasty-hunit, validation

API changes (from Hackage documentation)

Files

• Setup.hs +0/−4
• lame-tester.cabal +21/−12
• src/Tester/Dialect.hs +1/−1
• src/Tester/RunSettings.hs +2/−6
• src/Tester/Suite.hs +16/−28
• test/UnitTests.hs +39/−0

@@ -1,4 +0,0 @@-import Distribution.Simple--main :: IO ()-main = defaultMainWithHooks simpleUserHooks

@@ -1,6 +1,6 @@ Name:                lame-tester-Version:             1.2.1-Cabal-version:       >=1.16.0+Version:             1.4.0+Cabal-version:       >=1.22.0 License:             BSD3 License-File:        LICENSE.txt Author:              Jason Bertsche@@ -18,25 +18,34 @@ library   hs-source-dirs:   src   exposed-modules:  Tester.Dialect, Tester.RunSettings, Tester.Suite+  default-extensions: OverloadedStrings   default-language: Haskell2010   build-depends:-    base       >= 4.6 && < 5,-    bifunctors >= 4.1,-    containers >= 0.5,-    semigroups >= 0.9,-    validation >= 0.3+    base-noprelude >= 4.8    && < 5,+    bizzlelude     >= 1.2.0  && < 1.3.0,+    containers     >= 0.5.11 && < 0.6.0,+    semigroups     >= 0.18.4 && < 0.19.0,+    validation     >= 1      && < 1.1.0   GHC-Options:     -Wall+    -Wcompat+    -Wincomplete-record-updates+    -Wincomplete-uni-patterns+    -Wmissing-import-lists+    -Wredundant-constraints     -fno-warn-name-shadowing+    -funbox-strict-fields  test-suite tests   type:             exitcode-stdio-1.0   main-is:          Main.hs   hs-source-dirs:   test+  default-extensions: OverloadedStrings   default-language: Haskell2010+  other-modules: UnitTests   build-depends:-    base        >= 4.6 && < 5,-    containers  >= 0.5,-    lame-tester >= 1.2,-    tasty       >= 0.10,-    tasty-hunit >= 0.9+    bizzlelude,+    containers,+    lame-tester,+    tasty       >= 1.0.1  && < 1.1.0,+    tasty-hunit >= 0.10.0 && < 0.11.0

@@ -20,7 +20,7 @@ excludingTo x y = FlagCells $ fmap DontRun [x..y]  andAlso, butAlso :: (CellBox a, CellBox b) => a -> b -> FlagCells-andAlso x y = FlagCells $ (unbox x) ++ (unbox y)+andAlso x y = FlagCells $ (unbox x) <> (unbox y) butAlso = andAlso  class CellBox x where

@@ -1,9 +1,7 @@ module Tester.RunSettings(Settings(..), cellsToSettings) where -import Control.Arrow((>>>))- import Data.List(sort)-import Data.Set(empty, insert, Set)+import Data.Set(empty, insert)  import Tester.Dialect(CellBox, FlagCell(DontRun, Run, ToggleCell), ToggleFlag(StackTrace), unbox) @@ -13,8 +11,6 @@     isStackTracing :: Bool   } deriving (Eq, Show) -a |> f = f a- cellsToSettings :: (CellBox x) => x -> Settings cellsToSettings cellBox = foldr constructSettings baseSettings optimizedCells   where@@ -38,4 +34,4 @@  data OptCell   = OStackTrace-  | ORun { num :: Int }+  | ORun Int

@@ -1,57 +1,45 @@-module Tester.Suite(Result, runTests, Suite(..), TestResult(..), unsafeRunTests) where--import Control.Arrow((>>>))+module Tester.Suite(Result, runTests, Suite(..), TestResult(..)) where  import Data.Bifoldable(bifoldMap) import Data.List.NonEmpty(NonEmpty)-import Data.Map((!), Map)-import Data.Monoid(Monoid(mappend, mempty))+import Data.Map((!)) import Data.Validation(Validation) -import Data.Set as Set--import System.IO.Unsafe(unsafePerformIO)+import qualified Data.Set as Set  import Tester.Dialect(FlagCells) import Tester.RunSettings(cellsToSettings, testNums) -a |> f = f a- type Result f s = Validation (NonEmpty f) s  data TestResult   = TestSuccess-  | TestFailure { msg :: String } deriving (Eq, Show)+  | TestFailure { msg :: Text } deriving (Eq, Show)  data Suite a b c   = Suite {     testMap    :: Map Int a,     runTest    :: a -> Result b c,-    failsToStr :: NonEmpty b -> String,-    succToStr  :: c -> String+    failsToStr :: NonEmpty b -> Text,+    succToStr  :: c -> Text   } +instance Semigroup TestResult where+  (  TestFailure m1) <>   (TestFailure m2) = TestFailure $ m1 <> m2+  x@(TestFailure _)  <> _                  = x+  _                  <> x@(TestFailure _)  = x+  _                  <> _                  = TestSuccess+ instance Monoid TestResult where-  mempty = TestSuccess-  mappend   (TestFailure m1)   (TestFailure m2) = TestFailure $ m1 `mappend` m2-  mappend x@(TestFailure _)  _                  = x-  mappend _                  x@(TestFailure _)  = x-  mappend _                  _                  = mempty+  mempty  = TestSuccess+  mappend = (<>)  runTests :: FlagCells -> (Suite a b c) -> [TestResult] runTests c s@(Suite _ _ failsToStr _) = fmap (resultToTR failsToStr) $ generateResults c s -unsafeRunTests :: FlagCells -> (Suite a b c) -> [TestResult]-unsafeRunTests c s@(Suite _ _ failsToStr succToStr) = seq (unsafePerformIO evilIO) testResults-  where-    results     = generateResults c s-    testResults = fmap (resultToTR failsToStr) results-    strs        = fmap (bifoldMap failsToStr succToStr) results-    evilIO      = mapM_ putStrLn strs- generateResults :: FlagCells -> (Suite a b c) -> [Result b c] generateResults cells (Suite testMap runTest _ _) =-  cells |> (cellsToSettings >>> testNums >>> Set.toList >>> (fmap $ (testMap!) >>> runTest))+  cells |> (cellsToSettings >>> testNums >>> Set.toList >>> (fmap $ (testMap !) >>> runTest)) -resultToTR :: (NonEmpty a -> String)-> Result a b -> TestResult+resultToTR :: (NonEmpty a -> Text)-> Result a b -> TestResult resultToTR fToStr = bifoldMap (fToStr >>> TestFailure) $ const TestSuccess

@@ -0,0 +1,39 @@+module UnitTests(tests) where++import Data.Set(empty, fromList, insert, singleton)++import Test.Tasty(testGroup, TestTree)+import Test.Tasty.HUnit((@?=), testCase)++import Tester.Dialect(andAlso, butAlso, CellBox, excludingTo, FlagCell(DontRun, Run), FlagCells(FlagCells), runningTo, ToggleFlag(StackTrace), unbox)+import Tester.RunSettings(cellsToSettings, Settings(Settings))++tests = testGroup "Test settings DSL" [+   testCells "Simple run"                 (Run 2)                                                          (singleton 2)                                      False+ , testCells "Simple range"               (5 `runningTo` 20)                                               (fromList [5..20])                                 False+ , testCells "Simple flag"                (StackTrace)                                                     empty                                              True+ , testCells "Simples combined"           (Run 2 `andAlso` 5 `runningTo` 20 `butAlso` StackTrace)          ((fromList >>> (insert 2)) [5..20])                True+ , testCells "Unnecessary exemption 1"    (DontRun 2)                                                      empty                                              False+ , testCells "Unnecessary exemption 2"    (Run 6 `andAlso` DontRun 2)                                      (singleton 6)                                      False+ , testCells "Unnecessary exempt range 1" (5 `excludingTo` 10)                                             empty                                              False+ , testCells "Unnecessary exempt range 2" (15 `runningTo` 25 `andAlso` 5 `excludingTo` 10)                 (fromList [15..25])                                False+ , testCells "Exemption from single 1"    (Run 2 `andAlso` DontRun 2)                                      empty                                              False+ , testCells "Exemption from single 2"    (Run 101 `andAlso` Run 9 `andAlso` DontRun 9 `andAlso` Run 10)   (fromList [10, 101])                               False+ , testCells "Exemption from range 1"     (1 `runningTo` 10 `butAlso` DontRun 10)                          (fromList [1..9])                                  False+ , testCells "Exemption from range 2"     (1 `runningTo` 10 `butAlso` DontRun 9)                           ((fromList >>> (insert 10)) [1..8])                False+ , testCells "Exempt range from single 1" (Run 6 `butAlso` 1 `excludingTo` 10)                             empty                                              False+ , testCells "Exempt range from single 2" (Run 6 `butAlso` 1 `excludingTo` 10 `andAlso` Run 12)            (singleton 12)                                     False+ , testCells "Exempt range from range 1"  (1 `runningTo` 20 `butAlso` 5 `excludingTo` 10)                  (fromList [1,2,3,4,11,12,13,14,15,16,17,18,19,20]) False+ , testCells "Exempt range from range 2"  (10 `runningTo` 20 `butAlso` 5 `excludingTo` 12)                 (fromList [13..20])                                False+ , testCells "Exempt range from range 3"  (10 `runningTo` 20 `butAlso` 17 `excludingTo` 25)                (fromList [10..16])                                False+ , testCells "Exempt range from mix 1"    (1 `runningTo` 20 `butAlso` 3 `excludingTo` 18 `andAlso` Run 25) (fromList [1,2,19,20,25])                          False+ , testCells "Exempt range from mix 2"    (5 `runningTo` 20 `butAlso` 3 `excludingTo` 18 `andAlso` Run 1)  (fromList [1, 19, 20])                             False+ , testCells "Bringing it all back home"  (Run 22 `andAlso` 10 `runningTo` 15 `butAlso` 11 `excludingTo` 14 `butAlso` Run 20 `andAlso` StackTrace `andAlso` Run 5 `andAlso` DontRun 6 `butAlso` Run 6) (fromList [5, 10, 15, 20, 22]) True+ ]++testCells :: (CellBox b) => Text -> b -> Set Int -> Bool -> TestTree+testCells desc box numSet isStackTracing = testCase (asString desc) assertion+  where+    cells     = FlagCells $ unbox box+    settings  = Settings numSet isStackTracing+    assertion = cellsToSettings cells @?= settings