packages feed

tasty 0.3.1 → 0.4

raw patch · 12 files changed

+435/−263 lines, 12 files

Files

Test/Tasty.hs view
@@ -8,7 +8,7 @@   , testGroup   -- * Running tests   , defaultMain-  , defaultMainWithRunner+  , defaultMainWithIngredients   -- * Adjusting options   -- | Normally options are specified on the command line. But you can   -- also have different options for different subtrees in the same tree,@@ -20,13 +20,11 @@  import Test.Tasty.Core import Test.Tasty.Runners-import Test.Tasty.UI import Test.Tasty.Options --- | Parse the command line arguments and run the tests using the standard--- console runner+-- | Parse the command line arguments and run the tests defaultMain :: TestTree -> IO ()-defaultMain = defaultMainWithRunner runUI+defaultMain = defaultMainWithIngredients [listingTests, consoleTestReporter]  -- | Locally adjust the option value for the given test subtree adjustOption :: IsOption v => (v -> v) -> TestTree -> TestTree
Test/Tasty/CmdLine.hs view
@@ -1,45 +1,59 @@ -- | Parsing options supplied on the command line {-# LANGUAGE ScopedTypeVariables #-} module Test.Tasty.CmdLine-  ( treeOptionParser-  , optionParser-  , defaultMainWithRunner+  ( optionParser+  , suiteOptions+  , suiteOptionParser+  , defaultMainWithIngredients   ) where  import Options.Applicative import Data.Monoid import Data.Proxy-import Data.Tagged-import qualified Data.Map as Map-import Data.Typeable-import Control.Arrow import System.Exit + import Test.Tasty.Core import Test.Tasty.CoreOptions-import Test.Tasty.Run+import Test.Tasty.Ingredients import Test.Tasty.Options --- | Generate a command line parser for all the options relevant for this--- test tree. Also includes 'coreOptions'.-treeOptionParser :: TestTree -> Parser OptionSet-treeOptionParser = optionParser . (coreOptions ++) . getTreeOptions- -- | Generate a command line parser from a list of option descriptions optionParser :: [OptionDescription] -> Parser OptionSet optionParser = foldr addOption (pure mempty) where   addOption :: OptionDescription -> Parser OptionSet -> Parser OptionSet-  addOption (Option (px :: Proxy v)) p =+  addOption (Option (Proxy :: Proxy v)) p =     setOption <$> (optionCLParser :: Parser v) <*> p +-- suiteOptions doesn't really belong here (since it's not CmdLine+-- specific), but I didn't want to create a new module just for it.++-- | All the options relevant for this test suite. This includes the+-- options for the test tree and ingredients, and the core options.+suiteOptions :: [Ingredient] -> TestTree -> [OptionDescription]+suiteOptions ins tree =+  coreOptions +++  ingredientsOptions ins +++  treeOptions tree++-- | The command line parser for the test suite+suiteOptionParser :: [Ingredient] -> TestTree -> Parser OptionSet+suiteOptionParser ins tree = optionParser $ suiteOptions ins tree+ -- | Parse the command line arguments and run the tests using the provided--- runner-defaultMainWithRunner :: Runner -> TestTree -> IO ()-defaultMainWithRunner runner testTree = do+-- ingredient list+defaultMainWithIngredients :: [Ingredient] -> TestTree -> IO ()+defaultMainWithIngredients ins testTree = do   opts <- execParser $-    info (helper <*> treeOptionParser testTree)+    info (helper <*> suiteOptionParser ins testTree)     ( fullDesc <>       header "Mmm... tasty test suite"     )-  ok <- execRunner runner opts testTree-  if ok then exitSuccess else exitFailure++  case tryIngredients ins opts testTree of+    Nothing ->+      putStrLn+        "This doesn't taste right. Check your ingredients — did you forget a test reporter?"+    Just act -> do+      ok <- act+      if ok then exitSuccess else exitFailure
Test/Tasty/Core.hs view
@@ -127,8 +127,8 @@   AppMonoid f1 `mappend` AppMonoid f2 = AppMonoid $ f1 *> f2  -- | Get the list of options that are relevant for a given test tree-getTreeOptions :: TestTree -> [OptionDescription]-getTreeOptions =+treeOptions :: TestTree -> [OptionDescription]+treeOptions =    Prelude.concat .   Map.elems .
Test/Tasty/CoreOptions.hs view
@@ -1,4 +1,4 @@--- | Core options, i.e. the options used by Tasty itself+-- | Core options, i.e. the options used by tasty itself {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-} module Test.Tasty.CoreOptions   ( NumThreads(..)@@ -10,10 +10,15 @@ import Data.Proxy  import Test.Tasty.Options-import Test.Tasty.Options import Test.Tasty.Patterns --- | Number of parallel threads to use for running tests+-- | Number of parallel threads to use for running tests.+--+-- Note that this is /not/ included in 'coreOptions'.+-- Instead, it's automatically included in the options for any+-- 'TestReporter' ingredient by 'ingredientOptions', because the way test+-- reporters are handled already involves parallelism. Other ingredients+-- may also choose to include this option. newtype NumThreads = NumThreads { getNumThreads :: Int }   deriving (Eq, Ord, Num, Typeable) instance IsOption NumThreads where@@ -22,9 +27,9 @@   optionName = return "num-threads"   optionHelp = return "Number of threads to use for tests execution" --- | The list of all core options+-- | The list of all core options, i.e. the options not specific to any+-- provider or ingredient, but to tasty itself. Currently only contains 'TestPattern'. coreOptions :: [OptionDescription] coreOptions =-  [ Option (Proxy :: Proxy NumThreads)-  , Option (Proxy :: Proxy TestPattern)+  [ Option (Proxy :: Proxy TestPattern)   ]
+ Test/Tasty/Ingredients.hs view
@@ -0,0 +1,101 @@+module Test.Tasty.Ingredients+  ( Ingredient(..)+  , tryIngredients+  , ingredientOptions+  , ingredientsOptions+  ) where++import Control.Monad+import Data.Proxy+import qualified Data.Foldable as F++import Test.Tasty.Core+import Test.Tasty.Run+import Test.Tasty.Options+import Test.Tasty.CoreOptions++-- | 'Ingredient's make your test suite tasty.+--+-- Ingredients represent different actions that you can perform on your+-- test suite. One obvious ingredient that you want to include is+-- one that runs tests and reports the progress and results.+--+-- Another standard ingredient is one that simply prints the names of all+-- tests.+--+-- Similar to test providers (see 'IsTest'), every ingredient may specify+-- which options it cares about, so that those options are presented to+-- the user if the ingredient is included in the test suite.+--+-- An ingredient can choose, typically based on the 'OptionSet', whether to+-- run. That's what the 'Maybe' is for. The first ingredient that agreed to+-- run does its work, and the remaining ingredients are ignored. Thus, the+-- order in which you arrange the ingredients may matter.+--+-- Usually, the ingredient which runs the tests is unconditional and thus+-- should be placed last in the list. Other ingredients usually run only+-- if explicitly requested via an option. Their relative order thus doesn't+-- matter.+--+-- That's all you need to know from an (advanced) user perspective. Read+-- on if you want to create a new ingredient.+--+-- There are two kinds of ingredients. 'TestReporter', if it agrees to run,+-- automatically launches tests execution, and gets the 'StatusMap' which+-- it uses to report the progress and results to the user.+--+-- 'TestManager' is the second kind of ingredient. It is typically used for+-- test management purposes (such as listing the test names), although it+-- can also be used for running tests (but, unlike 'TestReporter', it has+-- to launch the tests manually).  It is therefore more general than+-- 'TestReporter'. 'TestReporter' is provided just for convenience.+--+-- The function's result should indicate whether all the tests passed.+--+-- In the 'TestManager' case, it's up to the ingredient author to decide+-- what the result should be. When no tests are run, the result should+-- probably be 'True'. Sometimes, even if some tests run and fail, it still+-- makes sense to return 'True'.+data Ingredient+  = TestReporter+      [OptionDescription]+      (OptionSet -> TestTree -> Maybe (StatusMap -> IO Bool))+  | TestManager+      [OptionDescription]+      (OptionSet -> TestTree -> Maybe (IO Bool))++-- | Try to run an 'Ingredient'.+--+-- If the ingredient refuses to run (usually based on the 'OptionSet'),+-- the function returns 'Nothing'.+--+-- For a 'TestReporter', this function automatically starts running the+-- tests in the background.+tryIngredient :: Ingredient -> OptionSet -> TestTree -> Maybe (IO Bool)+tryIngredient (TestReporter _ report) opts testTree = do -- Maybe monad+  reportFn <- report opts testTree+  return $ reportFn =<< launchTestTree opts testTree+tryIngredient (TestManager _ manage) opts testTree =+  manage opts testTree++-- | Run the first 'Ingredient' that agrees to be run.+--+-- If no one accepts the task, return 'Nothing'. This is usually a sign of+-- misconfiguration.+tryIngredients :: [Ingredient] -> OptionSet -> TestTree -> Maybe (IO Bool)+tryIngredients ins opts tree =+  msum $ map (\i -> tryIngredient i opts tree) ins++-- | Return the options which are relevant for the given ingredient.+--+-- Note that this isn't the same as simply pattern-matching on+-- 'Ingredient'. E.g. options for a 'TestReporter' automatically include+-- 'NumThreads'.+ingredientOptions :: Ingredient -> [OptionDescription]+ingredientOptions (TestReporter opts _) =+  Option (Proxy :: Proxy NumThreads) : opts+ingredientOptions (TestManager opts _) = opts++-- | Like 'ingredientOption', but folds over multiple ingredients.+ingredientsOptions :: [Ingredient] -> [OptionDescription]+ingredientsOptions = F.foldMap ingredientOptions
+ Test/Tasty/Ingredients/ConsoleReporter.hs view
@@ -0,0 +1,203 @@+{-# LANGUAGE TupleSections, CPP, ImplicitParams #-}+-- | Console reporter ingredient+module Test.Tasty.Ingredients.ConsoleReporter (consoleTestReporter) where++import Prelude hiding (fail)+import Control.Monad.State hiding (fail)+import Control.Concurrent.STM+import Control.Exception+import Test.Tasty.Core+import Test.Tasty.Run+import Test.Tasty.Ingredients+import Test.Tasty.Options+import Text.Printf+import qualified Data.IntMap as IntMap+import Data.Maybe+import Data.Monoid+import System.IO++#ifdef COLORS+import System.Console.ANSI+#endif++data RunnerState = RunnerState+  { ix :: !Int+  , nestedLevel :: !Int+  , failures :: !Int+  }++initialState :: RunnerState+initialState = RunnerState 0 0 0++type M = StateT RunnerState IO++indentSize :: Int+indentSize = 2++indent :: Int -> String+indent n = replicate (indentSize * n) ' '++-- handle multi-line result descriptions properly+formatDesc+  :: Int -- indent+  -> String+  -> String+formatDesc n desc =+  let+    -- remove all trailing linebreaks+    chomped = reverse . dropWhile (== '\n') . reverse $ desc++    multiline = '\n' `elem` chomped++    -- we add a leading linebreak to the description, to start it on a new+    -- line and add an indentation+    paddedDesc = flip concatMap chomped $ \c ->+      if c == '\n'+        then c : indent n+        else [c]+  in+    if multiline+      then paddedDesc+      else chomped++data Maximum a+  = Maximum a+  | MinusInfinity++instance Ord a => Monoid (Maximum a) where+  mempty = MinusInfinity++  Maximum a `mappend` Maximum b = Maximum (a `max` b)+  MinusInfinity `mappend` a = a+  a `mappend` MinusInfinity = a++-- | Compute the amount of space needed to align "OK"s and "FAIL"s+computeAlignment :: OptionSet -> TestTree -> Int+computeAlignment opts =+  fromMonoid .+  foldTestTree+    (\_ name _ level -> Maximum (length name + level))+    (\_ m -> m . (+ indentSize))+    opts+  where+    fromMonoid m =+      case m 0 of+        MinusInfinity -> 0+        Maximum x -> x++-- | A simple console UI+consoleTestReporter :: Ingredient+-- We fold the test tree using (AppMonoid m, Any) monoid.+--+-- The 'Any' part is needed to know whether a group is empty, in which case+-- we shouldn't display it.+consoleTestReporter = TestReporter [] $ \opts tree -> Just $ \smap -> do+  isTerm <- hIsTerminalDevice stdout++  let+    ?colors = isTerm++  let+    alignment = computeAlignment opts tree++    runSingleTest+      :: (IsTest t, ?colors :: Bool)+      => IntMap.IntMap (TVar Status)+      -> OptionSet -> TestName -> t -> (AppMonoid M, Any)+    runSingleTest smap _opts name _test = (, Any True) $ AppMonoid $ do+      st@RunnerState { ix = ix, nestedLevel = level } <- get+      let+        statusVar =+          fromMaybe (error "internal error: index out of bounds") $+          IntMap.lookup ix smap++      -- Print the test name before waiting for the test. This is useful+      -- for long-running tests.+      liftIO $ printf "%s%s: %s" (indent level) name+        (replicate (alignment - indentSize * level - length name) ' ')++      (rOk, rDesc) <-+        liftIO $ atomically $ do+          status <- readTVar statusVar+          case status of+            Done r -> return $ (resultSuccessful r, resultDescription r)+            Exception e -> return (False, "Exception: " ++ show e)+            _ -> retry++      liftIO $+        if rOk+          then ok "OK\n"+          else fail "FAIL\n"++      when (not $ null rDesc) $+        liftIO $ (if rOk then infoOk else infoFail) $+          printf "%s%s\n" (indent $ level + 1) (formatDesc (level+1) rDesc)+      let+        ix' = ix+1+        updateFailures = if rOk then id else (+1)+      put $! st { ix = ix', failures = updateFailures (failures st) }++    runGroup :: TestName -> (AppMonoid M, Any) -> (AppMonoid M, Any)+    runGroup _ (_, Any False) = mempty+    runGroup name (AppMonoid act, nonEmpty) = (, nonEmpty) $ AppMonoid $ do+      st@RunnerState { nestedLevel = level } <- get+      liftIO $ printf "%s%s\n" (indent level) name+      put $! st { nestedLevel = level + 1 }+      act+      modify $ \st -> st { nestedLevel = level }++  hSetBuffering stdout NoBuffering++  -- Do not retain the reference to the tree more than necessary+  _ <- evaluate alignment++  st <-+    flip execStateT initialState $ getApp $ fst $+      foldTestTree+        (runSingleTest smap)+        runGroup+        opts+        tree++  printf "\n"++  case failures st of+    0 -> do+      ok $ printf "All %d tests passed\n" (ix st)+      return True++    fs -> do+      fail $ printf "%d out of %d tests failed\n" fs (ix st)+      return False++-- (Potentially) colorful output+ok, fail, infoOk, infoFail :: (?colors :: Bool) => String -> IO ()+#ifdef COLORS+fail     = output BoldIntensity   Vivid Red+ok       = output NormalIntensity Dull  Green+infoOk   = output NormalIntensity Dull  White+infoFail = output NormalIntensity Dull  Black++output+  :: (?colors :: Bool)+  => ConsoleIntensity+  -> ColorIntensity+  -> Color+  -> String+  -> IO ()+output bold intensity color str+  | ?colors =+    (do+      setSGR+        [ SetColor Foreground intensity color+        , SetConsoleIntensity bold+        ]+      putStr str+    ) `finally` setSGR []+  | otherwise = putStr str+#else+ok       = putStr+fail     = putStr+infoOk   = putStr+infoFail = putStr+#endif
+ Test/Tasty/Ingredients/ListTests.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}+module Test.Tasty.Ingredients.ListTests+  ( ListTests(..)+  , testsNames+  , listingTests+  ) where++import Options.Applicative+import Data.Typeable+import Data.Proxy+import Data.Tagged++import Test.Tasty.Core+import Test.Tasty.Options+import Test.Tasty.Ingredients++-- | This option, when set to 'True', specifies that we should run in the+-- «list tests» mode+newtype ListTests = ListTests Bool+  deriving (Eq, Ord, Typeable)+instance IsOption ListTests where+  defaultValue = ListTests False+  parseValue = fmap ListTests . safeRead+  optionName = return "list-tests"+  optionHelp = return "Do not run the tests; just print their names"+  optionCLParser =+    fmap ListTests $+    switch+      (  short 'l'+      <> long (untag (optionName :: Tagged ListTests String))+      <> help (untag (optionHelp :: Tagged ListTests String))+      )++-- | Obtain the list of all tests in the suite+testsNames :: OptionSet -> TestTree -> [TestName]+testsNames {- opts -} {- tree -} =+  foldTestTree+    (\_opts name _test -> [name])+    (\groupName names -> map ((groupName ++ "/") ++) names)++-- | The ingredient that provides the test listing functionality+listingTests :: Ingredient+listingTests = TestManager [Option (Proxy :: Proxy ListTests)] $+  \opts tree ->+    case lookupOption opts of+      ListTests False -> Nothing+      ListTests True -> Just $ do+        mapM_ putStrLn $ testsNames opts tree+        return True
Test/Tasty/Options.hs view
@@ -3,8 +3,7 @@              OverlappingInstances, FlexibleInstances, UndecidableInstances,              TypeOperators #-} -- | Extensible options. They are used for provider-specific settings,--- runner-specific settings and core settings (number of threads, test--- pattern).+-- ingredient-specific settings and core settings (such as the test name pattern). module Test.Tasty.Options   (     -- * IsOption class
Test/Tasty/Run.hs view
@@ -2,14 +2,10 @@ module Test.Tasty.Run   ( Status(..)   , StatusMap-  , Runner-  , execRunner   , launchTestTree   ) where  import qualified Data.IntMap as IntMap-import Data.Maybe-import Data.Typeable import Control.Monad.State import Control.Concurrent.STM import Control.Exception@@ -43,19 +39,10 @@  -- | Mapping from test numbers (starting from 0) to their status variables. ----- This is what a runner uses to analyse and display progress, and to+-- This is what an ingredient uses to analyse and display progress, and to -- detect when tests finish. type StatusMap = IntMap.IntMap (TVar Status) --- | A 'Runner' is responsible for user interaction during the test run.------ It is provided with the 'StatusMap', so the tests are already launched--- and all it needs to do is notifying the user about the progress and--- then displaying the overall results in the end.------ The function's result should indicate whether all the tests passed.-type Runner = OptionSet -> TestTree -> StatusMap -> IO Bool- -- | Start executing a test executeTest   :: ((Progress -> IO ()) -> IO Result)@@ -126,10 +113,3 @@   let NumThreads numTheads = lookupOption opts   launchTests numTheads tmap   return $ fmap snd smap---- | Execute a 'Runner'.------ This is a shortcut which runs 'launchTestTree' behind the scenes.-execRunner :: Runner -> OptionSet -> TestTree -> IO Bool-execRunner runner opts testTree =-  runner opts testTree =<< launchTestTree opts testTree
Test/Tasty/Runners.hs view
@@ -4,13 +4,30 @@     -- * Working with the test tree     TestTree(..)   , foldTestTree+    -- * Ingredients+  , Ingredient(..)+  , tryIngredients+  , ingredientOptions+  , ingredientsOptions+    -- * Standard console ingredients+    -- ** Console test reporter+  , consoleTestReporter+    -- ** Tests list+  , listingTests+  , ListTests(..)+  , testsNames     -- * Command line handling-  , module Test.Tasty.CmdLine+  , optionParser+  , suiteOptionParser+  , defaultMainWithIngredients     -- * Running tests-  , module Test.Tasty.Run-  , module Test.Tasty.UI-    -- * Core options-  , module Test.Tasty.CoreOptions+  , Status(..)+  , StatusMap+  , launchTestTree+  , NumThreads(..)+    -- * Options+  , suiteOptions+  , coreOptions     -- ** Patterns   , module Test.Tasty.Patterns   )@@ -18,7 +35,9 @@  import Test.Tasty.Core import Test.Tasty.Run+import Test.Tasty.Ingredients import Test.Tasty.CoreOptions import Test.Tasty.Patterns import Test.Tasty.CmdLine-import Test.Tasty.UI+import Test.Tasty.Ingredients.ConsoleReporter+import Test.Tasty.Ingredients.ListTests
− Test/Tasty/UI.hs 
@@ -1,199 +0,0 @@-{-# LANGUAGE TupleSections, CPP, ImplicitParams #-}--- | Console runner-module Test.Tasty.UI (runUI) where--import Prelude hiding (fail)-import Control.Monad.State hiding (fail)-import Control.Concurrent.STM-import Control.Exception-import Test.Tasty.Core-import Test.Tasty.Run-import Test.Tasty.Options-import Text.Printf-import qualified Data.IntMap as IntMap-import Data.Maybe-import Data.Monoid-import System.IO--#ifdef COLORS-import System.Console.ANSI-#endif--data RunnerState = RunnerState-  { ix :: !Int-  , nestedLevel :: !Int-  , failures :: !Int-  }--initialState :: RunnerState-initialState = RunnerState 0 0 0--type M = StateT RunnerState IO--indentSize :: Int-indentSize = 2--indent :: Int -> String-indent n = replicate (indentSize * n) ' '---- handle multi-line result descriptions properly-formatDesc-  :: Int -- indent-  -> String-  -> String-formatDesc n desc =-  let-    -- remove all trailing linebreaks-    chomped = reverse . dropWhile (== '\n') . reverse $ desc--    multiline = '\n' `elem` chomped--    -- we add a leading linebreak to the description, to start it on a new-    -- line and add an indentation-    paddedDesc = flip concatMap chomped $ \c ->-      if c == '\n'-        then c : indent n-        else [c]-  in-    if multiline-      then paddedDesc-      else chomped--data Maximum a-  = Maximum a-  | MinusInfinity--instance Ord a => Monoid (Maximum a) where-  mempty = MinusInfinity--  Maximum a `mappend` Maximum b = Maximum (a `max` b)-  MinusInfinity `mappend` a = a-  a `mappend` MinusInfinity = a---- | Compute the amount of space needed to align "OK"s and "FAIL"s-computeAlignment :: OptionSet -> TestTree -> Int-computeAlignment opts =-  fromMonoid .-  foldTestTree-    (\_ name _ level -> Maximum (length name + level))-    (\_ m -> m . (+ indentSize))-    opts-  where-    fromMonoid m =-      case m 0 of-        MinusInfinity -> 0-        Maximum x -> x---- | A simple console UI-runUI :: Runner--- We fold the test tree using (AppMonoid m, Any) monoid.------ The 'Any' part is needed to know whether a group is empty, in which case--- we shouldn't display it.-runUI opts tree smap = do-  isTerm <- hIsTerminalDevice stdout--  let-    ?colors = isTerm--  hSetBuffering stdout NoBuffering--  -- Do not retain the reference to the tree more than necessary-  _ <- evaluate alignment--  st <--    flip execStateT initialState $ getApp $ fst $-      foldTestTree-        (runSingleTest smap)-        runGroup-        opts-        tree--  printf "\n"--  case failures st of-    0 -> do-      ok $ printf "All %d tests passed\n" (ix st)-      return True--    fs -> do-      fail $ printf "%d out of %d tests failed\n" fs (ix st)-      return False--  where-    alignment = computeAlignment opts tree--    runSingleTest-      :: (IsTest t, ?colors :: Bool)-      => IntMap.IntMap (TVar Status)-      -> OptionSet -> TestName -> t -> (AppMonoid M, Any)-    runSingleTest smap _opts name _test = (, Any True) $ AppMonoid $ do-      st@RunnerState { ix = ix, nestedLevel = level } <- get-      let-        statusVar =-          fromMaybe (error "internal error: index out of bounds") $-          IntMap.lookup ix smap--      (rOk, rDesc) <--        liftIO $ atomically $ do-          status <- readTVar statusVar-          case status of-            Done r -> return $ (resultSuccessful r, resultDescription r)-            Exception e -> return (False, "Exception: " ++ show e)-            _ -> retry--      liftIO $ printf "%s%s: %s" (indent level) name-        (replicate (alignment - indentSize * level - length name) ' ')-      liftIO $-        if rOk-          then ok "OK\n"-          else fail "FAIL\n"--      when (not $ null rDesc) $-        liftIO $ (if rOk then infoOk else infoFail) $-          printf "%s%s\n" (indent $ level + 1) (formatDesc (level+1) rDesc)-      let-        ix' = ix+1-        updateFailures = if rOk then id else (+1)-      put $! st { ix = ix', failures = updateFailures (failures st) }--    runGroup :: TestName -> (AppMonoid M, Any) -> (AppMonoid M, Any)-    runGroup _ (_, Any False) = mempty-    runGroup name (AppMonoid act, nonEmpty) = (, nonEmpty) $ AppMonoid $ do-      st@RunnerState { nestedLevel = level } <- get-      liftIO $ printf "%s%s\n" (indent level) name-      put $! st { nestedLevel = level + 1 }-      act-      modify $ \st -> st { nestedLevel = level }---- (Potentially) colorful output-ok, fail, infoOk, infoFail :: (?colors :: Bool) => String -> IO ()-#ifdef COLORS-fail     = output BoldIntensity   Vivid Red-ok       = output NormalIntensity Dull  Green-infoOk   = output NormalIntensity Dull  White-infoFail = output NormalIntensity Dull  Black--output-  :: (?colors :: Bool)-  => ConsoleIntensity-  -> ColorIntensity-  -> Color-  -> String-  -> IO ()-output bold intensity color str-  | ?colors =-    (do-      setSGR-        [ SetColor Foreground intensity color-        , SetConsoleIntensity bold-        ]-      putStr str-    ) `finally` setSGR []-  | otherwise = putStr str-#else-ok       = putStr-fail     = putStr-infoOk   = putStr-infoFail = putStr-#endif
tasty.cabal view
@@ -2,7 +2,7 @@ --  see http://haskell.org/cabal/users-guide/  name:                tasty-version:             0.3.1+version:             0.4 synopsis:            Modern and extensible testing framework description:         See <http://documentup.com/feuerbach/tasty> license:             MIT@@ -35,8 +35,10 @@     Test.Tasty.CoreOptions,     Test.Tasty.Patterns,     Test.Tasty.Run,+    Test.Tasty.Ingredients,     Test.Tasty.CmdLine,-    Test.Tasty.UI+    Test.Tasty.Ingredients.ConsoleReporter+    Test.Tasty.Ingredients.ListTests   build-depends:     base ==4.*,     stm >= 2.3,@@ -51,3 +53,4 @@     cpp-options: -DCOLORS   -- hs-source-dirs:         default-language:    Haskell2010+  ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing