tasty-discover 1.1.0 → 2.0.0

raw patch · 36 files changed

+470/−537 lines, 36 filesdep +tasty-smallcheckdep −tasty-thdep ~basedep ~directorydep ~filepathsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: tasty-smallcheck

Dependencies removed: tasty-th

Dependency ranges changed: base, directory, filepath

API changes (from Hackage documentation)

Files

• LICENSE.md +17/−10
• Setup.hs +2/−0
• Setup.lhs +0/−3
• example/test/AllTheFolders/AnotherNestTest.hs +0/−4
• example/test/BarTest.hs +0/−8
• example/test/FooTest.hs +0/−15
• example/test/Tasty.hs +0/−1
• example/test/Thing/AnotherThing/NestedTest.hs +0/−4
• executable/Main.hs +33/−0
• integration-test/test-configurable-module/FooMySuffix.hs +0/−4
• integration-test/test-configurable-module/Nested/BarMySuffix.hs +0/−4
• integration-test/test-configurable-module/Tasty.hs +0/−1
• integration-test/test-no-module-suffix/Nested/AnotherBar.hs +0/−4
• integration-test/test-no-module-suffix/SomeFoo.hs +0/−6
• integration-test/test-no-module-suffix/Tasty.hs +0/−1
• library/Test/Tasty/Config.hs +49/−0
• library/Test/Tasty/Discover.hs +97/−0
• library/Test/Tasty/Generator.hs +78/−0
• library/Test/Tasty/Type.hs +46/−0
• src/Main.hs +0/−11
• src/Test/Tasty/Config.hs +0/−26
• src/Test/Tasty/Discover.hs +0/−17
• src/Test/Tasty/Parse.hs +0/−25
• src/Test/Tasty/Run.hs +0/−54
• src/Test/Tasty/Type.hs +0/−18
• src/Test/Tasty/Util.hs +0/−135
• tasty-discover.cabal +60/−75
• test/ConfigTest.hs +37/−0
• test/DiscoverTest.hs +43/−0
• test/ParseTest.hs +0/−45
• test/RunnerTest.hs +0/−20
• test/SubMod/FooBaz.hs +4/−0
• test/SubMod/PropTest.hs +4/−0
• test/UtilTest.hs +0/−40
• test/tmpdir/FooTest.hs +0/−3
• test/tmpdir/README.md +0/−3

@@ -1,12 +1,19 @@-tasty-discover - Test discovery for the tasty framework.-Copyright (C) 2017 Luke Murphy <lukewm@riseup.net>+Copyright (c) 2016 Luke Murphy -This program is free software: you can redistribute it and/or modify-it under the terms of the GNU General Public License as published by-the Free Software Foundation, either version 3 of the License, or-(at your option) any later version.+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: -This program is distributed in the hope that it will be useful,-but WITHOUT ANY WARRANTY; without even the implied warranty of-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the-GNU General Public License for more details.+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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -1,3 +0,0 @@-#!/usr/bin/env runhaskell-> import Distribution.Simple-> main = defaultMain

@@ -1,4 +0,0 @@-module AllTheFolders.AnotherNestTest where--prop_nineIsNine :: Bool-prop_nineIsNine = 9 == (9 :: Integer)

@@ -1,8 +0,0 @@-module BarTest where--import Test.Tasty.Discover (hspec, describe, it, shouldBe)--case_headIsWorking = hspec $-  describe "Check if Prelude.head 'still has it'" $-    it "returns the first element of a list" $-      head [23 ..] `shouldBe` (23 :: Int)

@@ -1,15 +0,0 @@-module FooTest where--import Test.Tasty.Discover (Assertion, (@?=), TestTree, testCase)--test_allMyTestsGrouped :: [TestTree]-test_allMyTestsGrouped =-    [ testCase "Testing the meaning of life." case_theAnswer-    , testCase "Testing the number of the beast." case_theNumberOfTheBeast-    ]--case_theAnswer :: Assertion-case_theAnswer = 42 @?= (42 :: Integer)--case_theNumberOfTheBeast :: Assertion-case_theNumberOfTheBeast = 666 @?= (666 :: Integer)

@@ -1,1 +0,0 @@-{-# OPTIONS_GHC -F -pgmF tasty-discover #-}

@@ -1,4 +0,0 @@-module Thing.AnotherThing.NestedTest where--prop_twoIsTwo :: Bool-prop_twoIsTwo = 2 == (2 :: Integer)

@@ -0,0 +1,33 @@+-- | Main executable module.+module Main where++import Control.Monad (when)+import Data.Maybe (fromMaybe)+import Test.Tasty.Config (parseConfig)+import Test.Tasty.Discover (findTests, generateTestDriver)+import Test.Tasty.Type (Config(..))+import System.Environment (getArgs, getProgName)+import System.Exit (exitFailure)+import System.IO (hPutStrLn, stderr)++-- | Main function.+main :: IO ()+main = do+  args <- getArgs+  name <- getProgName+  case args of+    src : _ : dst : opts ->+      case parseConfig name opts of+        Left err -> do+          hPutStrLn stderr err+          exitFailure+        Right config -> do+          tests <- findTests src config+          let ingredients = tastyIngredients config+              moduleName  = fromMaybe "Main" (generatedModuleName config)+              output      = generateTestDriver moduleName ingredients src tests+          when (debug config) $ hPutStrLn stderr output+          writeFile dst output+    _ -> do+      hPutStrLn stderr "Usage: tasty-discover src _ dst [OPTION...]"+      exitFailure

@@ -1,4 +0,0 @@-module FooMySuffix where--prop_theNumberOfTheBeast :: Bool-prop_theNumberOfTheBeast = 666 == (666 :: Integer)

@@ -1,4 +0,0 @@-module Nested.BarMySuffix where--prop_theMeaningOfLife :: Bool-prop_theMeaningOfLife = 42 == (42 :: Integer)

@@ -1,1 +0,0 @@-{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --module-suffix=MySuffix #-}

@@ -1,4 +0,0 @@-module Nested.AnotherBar where--prop_someOtherTest :: Bool-prop_someOtherTest = 12 == (12 :: Integer)

@@ -1,6 +0,0 @@-module SomeFoo where--import Data.Maybe (isNothing)--prop_whatIsHapeningHere :: Bool-prop_whatIsHapeningHere = isNothing Nothing

@@ -1,1 +0,0 @@-{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --no-module-suffix #-}

@@ -0,0 +1,49 @@+-- Configuration options module.+module Test.Tasty.Config (parseConfig, defaultConfig) where++import System.Console.GetOpt (ArgDescr(ReqArg, NoArg) , OptDescr(Option),+                              ArgOrder(Permute), getOpt)+import Data.Maybe (isJust)+import Test.Tasty.Type (Config(..))++-- | The default configuration+defaultConfig :: Config+defaultConfig = Config Nothing Nothing [] [] False False++-- | Configuration options parser.+parseConfig :: String -> [String] -> Either String Config+parseConfig prog args = case getOpt Permute options args of+    (opts, [], []) ->+      let config   = foldl (flip id) defaultConfig opts+          errorMsg = "You cannot combine '--no-module-suffix' and '--module-suffix'\n"+      in+        if noModuleSuffix config && isJust (moduleSuffix config)+        then formatError errorMsg+        else Right config+    (_, _, err:_)  -> formatError err+    (_, arg:_, _)  -> formatError ("unexpected argument `" ++ arg ++ "`\n")+  where+    formatError err = Left (prog ++ ": " ++ err)++-- | All configuration options.+options :: [OptDescr (Config -> Config)]+options = [+    Option [] ["module-suffix"]+      (ReqArg (\s c -> c {moduleSuffix = Just s}) "SUFFIX")+      "Specify desired test module suffix"+  , Option [] ["generated-module"]+      (ReqArg (\s c -> c {generatedModuleName = Just s}) "MODULE")+      "Qualified generated module name"+  , Option [] ["ignore-module"]+      (ReqArg (\s c -> c {ignoredModules = s : ignoredModules c}) "FILE")+      "Ignore a test module"+  , Option [] ["ingredient"]+      (ReqArg (\s c -> c {tastyIngredients = s : tastyIngredients c}) "INGREDIENT")+      "Qualified tasty ingredient name"+  , Option [] ["no-module-suffix"]+      (NoArg $ \c -> c {noModuleSuffix = True})+      "Ignore test module suffix and import them all"+  , Option [] ["debug"]+      (NoArg $ \c -> c {debug = True})+      "Debug output of generated test module"+  ]

@@ -0,0 +1,97 @@+-- | Automatic test discovery and runner for the tasty framework.+module Test.Tasty.Discover where++import Data.List (isPrefixOf, isSuffixOf, nub, intercalate, dropWhileEnd)+import System.Directory (getDirectoryContents, doesDirectoryExist)+import Data.Traversable (for)+import System.FilePath ((</>), takeDirectory)+import Test.Tasty.Generator (generators, showSetup, getGenerators)+import Test.Tasty.Type (Config(..), Generator(..), Test(..), mkTest)++generateTestDriver :: String -> [String] -> FilePath -> [Test] -> String+generateTestDriver modname is src tests =+  let generators' = getGenerators tests+      testNumVars = map (("t"++) . show) [(0 :: Int)..]+  in+    concat+      [ "{-# LINE 1 \"" ++ src ++ "\" #-}\n"+      , "{-# LANGUAGE FlexibleInstances #-}\n"+      , "module " ++ modname ++ " (main, ingredients, tests) where\n"+      , "import Prelude\n"+      , "import qualified Test.Tasty as T\n"+      , "import qualified Test.Tasty.Ingredients as T\n"+      , unlines $ map generatorImport generators'+      , showImports (map ingredientImport is ++ map testModule tests)+      , unlines $ map generatorClass generators'+      , "tests :: IO T.TestTree\n"+      , "tests = do\n"+      , unlines $ zipWith showSetup tests testNumVars+      , "  pure $ T.testGroup \"" ++ src ++ "\" ["+      , intercalate "," $ zipWith (curry snd) tests testNumVars+      , "]\n"+      , concat+        [ "ingredients :: [T.Ingredient]\n"+        , "ingredients = " ++ ingredients is ++ "\n"+        , "main :: IO ()\n"+        , "main = tests >>= T.defaultMainWithIngredients ingredients\n"+        ]+      ]++addSuffixes :: [String] -> [String]+addSuffixes modules = (++) <$> modules <*> [".lhs", ".hs"]++isHidden :: FilePath -> Bool+isHidden filename = head filename /= '.'++filesBySuffix :: FilePath -> [String] -> IO [FilePath]+filesBySuffix dir suffixes = do+  entries <- filter isHidden <$> getDirectoryContents dir+  found <- for entries $ \entry -> do+    let dir' = dir </> entry+    dirExists <- doesDirectoryExist dir'+    if dirExists then+      map (entry </>) <$> filesBySuffix dir' suffixes+    else+      pure []+  pure $ filter (\x -> any (`isSuffixOf` x) suffixes) entries ++ concat found++isIgnored :: [FilePath] -> String -> Bool+isIgnored ignores filename = filename `notElem` addSuffixes ignores++findTests :: FilePath -> Config -> IO [Test]+findTests src config = do+  let dir      = takeDirectory src+      suffixes = testFileSuffixes (moduleSuffix config)+      ignores  = ignoredModules config+  files <-+    if noModuleSuffix config+    then filter isHidden <$> getDirectoryContents dir+    else filesBySuffix dir suffixes+  let files' = filter (isIgnored ignores) files+  concat <$> traverse (extract dir) files'+  where+    extract dir file = extractTests file <$> readFile (dir </> file)++extractTests :: FilePath -> String -> [Test]+extractTests file = mkTestDeDuped . isKnownPrefix . parseTest+  where+    mkTestDeDuped = map (mkTest file) . nub+    isKnownPrefix = filter (\g -> any (checkPrefix g) generators)+    checkPrefix g = (`isPrefixOf` g) . generatorPrefix+    parseTest     = map fst . concatMap lex . lines++testFileSuffixes :: Maybe String -> [String]+testFileSuffixes suffix = addSuffixes suffixes+  where+    suffixes = case suffix of+      Just suffix' -> [suffix']+      Nothing -> ["Spec", "Test"]++showImports :: [String] -> String+showImports mods = unlines $ nub $ map (\m -> "import qualified " ++ m ++ "\n") mods++ingredientImport :: String -> String+ingredientImport = init . dropWhileEnd (/= '.')++ingredients :: [String] -> String+ingredients is = concat $ map (++":") is ++ ["T.defaultIngredients"]

@@ -0,0 +1,78 @@+module Test.Tasty.Generator+  ( generators+  , showSetup+  , getGenerator+  , getGenerators+  ) where++import Test.Tasty.Type (Test(..), Generator(..))+import Data.List (find, isPrefixOf, groupBy, sortOn)+import Data.Function (on)+import Data.Maybe (fromJust)++qualifyFunction :: Test -> String+qualifyFunction t = testModule t ++ "." ++ testFunction t++name :: Test -> String+name = chooser '_' ' ' . tail . dropWhile (/= '_') . testFunction+  where chooser c1 c2 = map $ \c3 -> if c3 == c1 then c2 else c3++getGenerator :: Test -> Generator+getGenerator t = fromJust $ find ((`isPrefixOf` testFunction t) . generatorPrefix) generators++getGenerators :: [Test] -> [Generator]+getGenerators = map head . groupBy  ((==) `on` generatorPrefix) . sortOn generatorPrefix . map getGenerator++showSetup :: Test -> String -> String+showSetup t var = "  " ++ var ++ " <- " ++ generatorSetup (getGenerator t) t ++ "\n"++generators :: [Generator]+generators =+  [ quickCheckPropertyGenerator+  , hunitTestCaseGenerator+  , hspecTestCaseGenerator+  , tastyTestGroupGenerator+  ]++quickCheckPropertyGenerator :: Generator+quickCheckPropertyGenerator = Generator+  { generatorPrefix = "prop_"+  , generatorImport = "import qualified Test.Tasty.QuickCheck as QC\n"+  , generatorClass  = ""+  , generatorSetup  = \t -> "pure $ QC.testProperty \"" ++ name t ++ "\" " ++ qualifyFunction t+  }++hunitTestCaseGenerator :: Generator+hunitTestCaseGenerator = Generator+  { generatorPrefix = "case_"+  , generatorImport = "import qualified Test.Tasty.HUnit as HU\n"+  , generatorClass  = concat+    [ "class TestCase a where testCase :: String -> a -> IO T.TestTree\n"+    , "instance TestCase (IO ())                      where testCase n = pure . HU.testCase      n\n"+    , "instance TestCase (IO String)                  where testCase n = pure . HU.testCaseInfo  n\n"+    , "instance TestCase ((String -> IO ()) -> IO ()) where testCase n = pure . HU.testCaseSteps n\n"+    ]+  , generatorSetup  = \t -> "testCase \"" ++ name t ++ "\" " ++ qualifyFunction t+  }++hspecTestCaseGenerator :: Generator+hspecTestCaseGenerator = Generator+  { generatorPrefix = "spec_"+  , generatorImport = "import qualified Test.Tasty.Hspec as HS\n"+  , generatorClass  = ""+  , generatorSetup  = \t -> "HS.testSpec \"" ++ name t ++ "\" " ++ qualifyFunction t+  }++tastyTestGroupGenerator :: Generator+tastyTestGroupGenerator = Generator+  { generatorPrefix = "test_"+  , generatorImport = ""+  , generatorClass  = concat+    [ "class TestGroup a where testGroup :: String -> a -> IO T.TestTree\n"+    , "instance TestGroup T.TestTree        where testGroup _ a = pure a\n"+    , "instance TestGroup [T.TestTree]      where testGroup n a = pure $ T.testGroup n a\n"+    , "instance TestGroup (IO T.TestTree)   where testGroup _ a = a\n"+    , "instance TestGroup (IO [T.TestTree]) where testGroup n a = T.testGroup n <$> a\n"+    ]+  , generatorSetup  = \t -> "testGroup \"" ++ name t ++ "\" " ++ qualifyFunction t+  }

@@ -0,0 +1,46 @@+module Test.Tasty.Type+  ( Test(..)+  , mkTest+  , Generator(..)+  , Config(..)+  ) where++import System.FilePath (pathSeparator, dropExtension)++data Test = Test+  { testModule   :: String+  , testFunction :: String+  } deriving Show++instance Eq Test where+  t1 == t2 = testModule t1 == testModule t2 && testFunction t1 == testFunction t2++mkTest :: FilePath -> String -> Test+mkTest = Test . chooser pathSeparator '.' . dropExtension+  where chooser c1 c2 = map $ \c3 -> if c3 == c1 then c2 else c3++data Generator = Generator+  { generatorPrefix  :: String+  , generatorImport  :: String+  , generatorClass   :: String+  , generatorSetup   :: Test -> String+  }++instance Show Generator where+  show generator = concat+    [ generatorPrefix generator+    , generatorImport generator+    , generatorClass  generator+    , "<function:generatorSetup :: Test -> String>"+    ]++type Ingredient = String++data Config = Config+  { moduleSuffix        :: Maybe String+  , generatedModuleName :: Maybe String+  , ignoredModules      :: [FilePath]+  , tastyIngredients    :: [Ingredient]+  , noModuleSuffix      :: Bool+  , debug               :: Bool+  } deriving (Show)

@@ -1,11 +0,0 @@--- | Main module and entry point.--module Main where--import System.Environment (getArgs)--import Test.Tasty.Run (run)---- | Pass pre processor arguments.-main :: IO ()-main = getArgs >>= run

@@ -1,26 +0,0 @@--- | Preprocessor configuration.--module Test.Tasty.Config (-  Config(..)-, defaultConfig-, options-) where--import System.Console.GetOpt (ArgDescr (ReqArg, NoArg) , OptDescr (Option))--import Test.Tasty.Type (Config(..))---- | The empty configuration.-defaultConfig :: Config-defaultConfig = Config Nothing False []---- | All configuration options.-options :: [OptDescr (Config -> Config)]-options = [-    Option [] ["module-suffix"]-      (ReqArg (\s c -> c {configModuleSuffix = Just s}) "SUFFIX") ""-  , Option [] ["no-module-suffix"]-      (NoArg $ \c -> c {noModuleSuffix = True}) ""-  , Option [] ["ignore-module"]-      (ReqArg (\s c -> c {ignoredModules = s : ignoredModules c}) "FILE") ""-  ]

@@ -1,17 +0,0 @@--- | Automatic test discovery and runner for the tasty framework.--module Test.Tasty.Discover (module Discover) where---- 3rd party-import Test.Tasty as Discover-import Test.Tasty.HUnit as Discover-import Test.Tasty.QuickCheck as Discover-import Test.Tasty.TH as Discover-import Test.Tasty.Hspec as Discover---- `tasty-discover` modules-import Test.Tasty.Run as Discover-import Test.Tasty.Parse as Discover-import Test.Tasty.Type as Discover-import Test.Tasty.Config as Discover-import Test.Tasty.Util as Discover

@@ -1,25 +0,0 @@--- | Parser for the GHC preprocessor definition.--module Test.Tasty.Parse (-  parseConfig-) where--import Data.Maybe (isJust)-import System.Console.GetOpt (ArgOrder (Permute), getOpt)--import Test.Tasty.Config  (Config(..), defaultConfig, options)---- | Preprocessor configuration parser.-parseConfig :: String -> [String] -> Either String Config-parseConfig prog args = case getOpt Permute options args of-    (opts, [], []) ->-      let config   = foldl (flip id) defaultConfig opts-          errorMsg = "You cannot combine '--no-module-suffix' and '--module-suffix'\n"-      in-        if noModuleSuffix config && isJust (configModuleSuffix config)-        then formatError errorMsg-        else Right config-    (_, _, err:_)  -> formatError err-    (_, arg:_, _)  -> formatError ("unexpected argument `" ++ arg ++ "`\n")-  where-    formatError err = Left (prog ++ ": " ++ err)

@@ -1,54 +0,0 @@--- | Test discovery and runner boilerplate generator.--{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE OverloadedStrings    #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Test.Tasty.Run (-  run-, tmpModule-) where--import System.Environment (getProgName)-import System.IO (hPutStrLn, stderr)-import System.Exit (exitFailure)--import Test.Tasty.Parse (parseConfig)-import Test.Tasty.Util (importList, findTests, getListOfTests)-import Test.Tasty.Type (Config, Test)---- | Parse preprocessor arguments and write the test runner module.-run :: [String] -> IO ()-run processor_args = do-  name <- getProgName-  case processor_args of-    src : _ : dst : opts -> case parseConfig name opts of--      Left err -> do-        hPutStrLn stderr err-        exitFailure--      Right conf -> do-        stringed <- show <$> getListOfTests src conf-        tests    <- findTests src conf-        writeFile dst (tmpModule src conf tests stringed)--    _ -> do-      hPutStrLn stderr name-      exitFailure----- | Generate the test runner module.-tmpModule :: FilePath -> Config -> [Test] -> String -> String-tmpModule src conf tests ts =-  (-    "{-# LINE 1 " . shows src . " #-}\n"-  . showString "{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}\n"-  . showString "{-# LANGUAGE TemplateHaskell #-}\n"-  . showString "module Main where\n"-  . showString "import Test.Tasty.Discover\n"-  . importList tests conf-  . showString "main :: IO ()\n"-  . showString ("main = do $(defaultMainGeneratorFor \"tasty-discover\" " ++ ts ++ ")")-  ) "\n"

@@ -1,18 +0,0 @@--- | Types.--module Test.Tasty.Type where---- | A test type. Corresponds to a test file path and module name.-data Test = Test {-  testFile   :: FilePath-, testModule :: String-} deriving (Eq, Show)---- | A configuration type.---   Constructor values are parsed from the preprocessor file.-data Config = Config {-  configModuleSuffix :: Maybe String-, noModuleSuffix     :: Bool-, ignoredModules     :: [FilePath]-} deriving (Eq, Show)-

@@ -1,135 +0,0 @@--- | Utility functions.--{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE OverloadedStrings    #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Test.Tasty.Util (-  importList-, findTests-, getListOfTests---- Testing purposes-, fileToTest-, getFilesRecursive-, isValidModuleChar-, isValidModuleName-) where--import Control.Applicative ((<|>))-import Control.Monad (filterM)-import Data.Char (isAlphaNum, isUpper)-import Data.List (intercalate, sort, stripPrefix)-import Data.Maybe (mapMaybe)-import Data.String (IsString, fromString)-import System.Directory (doesDirectoryExist, doesFileExist, getDirectoryContents)-import System.FilePath (splitDirectories, splitFileName, (</>))-import System.FilePath.Posix (splitExtension)--import Test.Tasty.TH (extractTestFunctions)--import Test.Tasty.Config (Config(..))-import Test.Tasty.Type--instance IsString ShowS where-  fromString = showString---- | Import statements for a list of tests.-importList :: [Test] -> Config -> ShowS-importList ts config =-    foldr ((.) . f) "" ts-  where-    f :: Test -> ShowS-    f test = if noModuleSuffix config then-      "import " . showString (testModule test) . "\n"-    else-      case configModuleSuffix config of-        Just suffix' -> "import " . showString (testModule test) . showString (suffix' ++ "\n")-        _            -> "import " . showString (testModule test) . "Test\n"----- | Is 'c' a valid character in a Haskell module name?-isValidModuleChar :: Char -> Bool-isValidModuleChar c = isAlphaNum c || c == '_' || c == '\''---- | Is 'cs' a valid Haskell module name?-isValidModuleName :: String -> Bool-isValidModuleName [] = False-isValidModuleName (c:cs) = isUpper c && all isValidModuleChar cs---- | All files under 'baseDir'.-getFilesRecursive :: FilePath -> IO [FilePath]-getFilesRecursive baseDir = sort <$> go []-  where-    go :: FilePath -> IO [FilePath]-    go dir = do-      c <- map (dir </>) . filter (`notElem` [".", ".."]) <$> getDirectoryContents (baseDir </> dir)-      dirs <- filterM (doesDirectoryExist . (baseDir </>)) c >>= mapM go-      files <- filterM (doesFileExist . (baseDir </>)) c-      return (files ++ concat dirs)---- | Convert a file to a File type.-fileToTest :: FilePath -> Config -> FilePath -> Maybe Test-fileToTest dir conf file =-    let-        suffix :: Maybe String-        suffix   = configModuleSuffix conf--        noModule :: Bool-        noModule = noModuleSuffix conf--        files :: [FilePath]-        files    = reverse $ splitDirectories file-    in-      if noModule then catchAll files else case suffix of-          Just suffix' -> filterBySuffix suffix' files-          Nothing      -> filterBySuffix "Test" files-    where-      filterBySuffix :: String -> [FilePath] -> Maybe Test-      filterBySuffix suffix files =-        case files of-          x:xs ->  case-            stripSuffix (suffix ++ ".hs") x <|> stripSuffix (suffix ++ ".lhs") x of-              Just name | isValidModuleName name && all isValidModuleName xs ->-                let pathComponents = reverse (name : xs)-                    moduleName = intercalate "." pathComponents-                in if isIgnoredModule pathComponents-                     then Nothing-                     else Just . Test (dir </> file) $ moduleName-              _ -> Nothing-          _    -> Nothing--      isIgnoredModule :: [FilePath] -> Bool-      isIgnoredModule pathComponents =-        let moduleName = intercalate "." pathComponents-        in moduleName `elem` ignoredModules conf--      stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]-      stripSuffix suff str = reverse <$> stripPrefix (reverse suff) (reverse str)--      catchAll :: [FilePath] -> Maybe Test-      catchAll (x:xs) =-        let name = fst $ splitExtension x-            pathComponents = reverse (name : xs)-        in-          if isValidModuleName name-             && all isValidModuleName xs-             && not (isIgnoredModule pathComponents) then-            Just . Test (dir </> file) $ (intercalate "." . reverse) (name : xs)-          else Nothing-      catchAll _ = Nothing---- | All test modules under 'dir'.-findTests :: FilePath -> Config -> IO [Test]-findTests path config =-  let (dir, file) = splitFileName path-      tests       = mapMaybe $ fileToTest dir config-  in-    tests . filter (/= file) <$> getFilesRecursive dir---- | All test function names in 'src'.-getListOfTests :: FilePath -> Config -> IO [String]-getListOfTests src conf = do-    allFiles <- fmap testFile <$> findTests src conf-    allTests <- mapM extractTestFunctions allFiles-    return $ concat allTests

@@ -1,87 +1,72 @@-name:             tasty-discover-version:          1.1.0-license:          GPL-3-license-file:     LICENSE.md-copyright:        (c) 2016 Luke Murphy-author:           Luke Murphy <lukewm@riseup.net>-maintainer:       Luke Murphy <lukewm@riseup.net>-build-type:       Simple-cabal-version:    >= 1.22-category:         Testing-stability:        Stable-bug-reports:      https://github.com/lwm/tasty-discover/issues-homepage:         https://github.com/lwm/tasty-discover/-synopsis:         Test discovery for the tasty framework.-description:      Test discovery for the tasty framework.-extra-source-files:-    integration-test/test-configurable-module/*.hs-    integration-test/test-configurable-module/Nested/*.hs-    integration-test/test-no-module-suffix/*.hs-    integration-test/test-no-module-suffix/Nested/*.hs-    example/test/*.hs-    example/test/AllTheFolders/*.hs-    example/test/Thing/AnotherThing/*.hs-    test/tmpdir/*.hs-    test/tmpdir/*.md+-- This file has been generated from package.yaml by hpack version 0.17.0.+--+-- see: https://github.com/sol/hpack -library-  ghc-options:-      -Wall-  exposed-modules:-    Test.Tasty.Discover-  other-modules:-    Test.Tasty.Config-    Test.Tasty.Parse-    Test.Tasty.Run-    Test.Tasty.Util-    Test.Tasty.Type-  build-depends:-      base == 4.*-    , filepath-    , directory-    , tasty-    , tasty-th-    , tasty-hunit-    , tasty-quickcheck-    , tasty-hspec-  hs-source-dirs: src-  default-language: Haskell2010+name:           tasty-discover+version:        2.0.0+synopsis:       Test discovery for the tasty framework.+description:    Test discovery for the tasty framework.+category:       Testing+stability:      Experimental+homepage:       https://github.com/lwm/tasty-discover#readme+bug-reports:    https://github.com/lwm/tasty-discover/issues+author:         Luke Murphy <lukewm@riseup.net>+maintainer:     Luke Murphy <lukewm@riseup.net>+copyright:      2016 Luke Murphy+license:        MIT+license-file:   LICENSE.md+build-type:     Simple+cabal-version:  >= 1.10 -executable tasty-discover-  ghc-options:-      -Wall+source-repository head+  type: git+  location: https://github.com/lwm/tasty-discover++library   hs-source-dirs:-      src-  main-is:-      Main.hs-  other-modules:+      library+  ghc-options: -Wall+  build-depends:+      base       >= 4.8 && < 5+    , directory  >= 1.1 && < 1.4+    , filepath   >= 1.3 && < 1.5+  exposed-modules:       Test.Tasty.Config       Test.Tasty.Discover-      Test.Tasty.Parse-      Test.Tasty.Run-      Test.Tasty.Util+      Test.Tasty.Generator       Test.Tasty.Type+  default-language: Haskell2010++executable tasty-discover+  main-is: executable/Main.hs+  ghc-options: -Wall   build-depends:-      base == 4.*-    , filepath-    , directory+      base       >= 4.8 && < 5+    , directory  >= 1.1 && < 1.4+    , filepath   >= 1.3 && < 1.5     , tasty-discover-    , tasty-th   default-language: Haskell2010 -test-suite unit-tests-  type:                exitcode-stdio-1.0-  hs-source-dirs:      test-  main-is:             Tasty.hs-  other-modules:-    ParseTest-    RunnerTest-    UtilTest+test-suite test+  type: exitcode-stdio-1.0+  main-is: Tasty.hs+  hs-source-dirs:+      test+  ghc-options: -Wall   build-depends:-      base == 4.*+      base       >= 4.8 && < 5+    , directory  >= 1.1 && < 1.4+    , filepath   >= 1.3 && < 1.5+    , base+    , tasty     , tasty-discover-  default-language:    Haskell2010--Source-repository head-  type:     git-  location: git://github.com/lwm/tasty-discover.git+    , tasty-hspec+    , tasty-hunit+    , tasty-quickcheck+    , tasty-smallcheck+  other-modules:+      ConfigTest+      DiscoverTest+      SubMod.FooBaz+      SubMod.PropTest+  default-language: Haskell2010

@@ -0,0 +1,37 @@+module ConfigTest where++import Data.List (isInfixOf)+import Test.Tasty.Discover (findTests, generateTestDriver)+import Test.Tasty.HUnit+import Test.Tasty.Type++case_noModuleSuffixEmptyList :: IO ()+case_noModuleSuffixEmptyList = do+  actual <- findTests "test/SubMod/" config+  actual @?= []+  where+    config = Config (Just "DoesntExist") Nothing [] [] False False++case_differentGeneratedModule :: Assertion+case_differentGeneratedModule = assertBool "Specified module is used" test+  where test = "FunkyModuleName" `isInfixOf` generatedModule+        generatedModule = generateTestDriver "FunkyModuleName" [] "test/" []++case_ignoreAModule :: IO ()+case_ignoreAModule = do+  actual <- findTests "test/SubMod/" config+  actual @?= []+  where+    config = Config Nothing Nothing ["PropTest"] [] False False++case_noModuleSuffix :: IO ()+case_noModuleSuffix  = do+  actual1 <- findTests "test/SubMod/" config1+  actual1 @?= [mkTest "PropTest" "prop_addition_is_associative"]++  actual2 <- findTests "test/SubMod/" config2+  actual2 @?= [ mkTest "FooBaz" "prop_addition_is_commutative"+             , mkTest "PropTest" "prop_addition_is_associative" ]+  where+    config1 = Config Nothing Nothing [] [] False False+    config2 = Config Nothing Nothing [] [] True False

@@ -0,0 +1,43 @@+{-# LANGUAGE ScopedTypeVariables #-}++module DiscoverTest where++import Data.List+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.Hspec+import Test.Tasty.QuickCheck++case_list_comparison_with_different_length :: IO ()+case_list_comparison_with_different_length = [1 :: Int, 2, 3] `compare` [1,2] @?= GT++prop_addition_is_commutative :: Int -> Int -> Bool+prop_addition_is_commutative a b = a + b == b + a++scprop_sortReverse :: [Int] -> Bool+scprop_sortReverse list = sort list == sort (reverse list)++spec_prelude :: Spec+spec_prelude =+  describe "Prelude.head" $+  it "returns the first element of a list" $+  head [23 ..] `shouldBe` (23 :: Int)++test_addition :: TestTree+test_addition = testProperty "Addition commutes" $ \(a :: Int) (b :: Int) -> a + b == b + a++test_multiplication :: [TestTree]+test_multiplication =+  [ testProperty "Multiplication commutes" $ \(a :: Int) (b :: Int) -> a * b == b * a+  , testProperty "One is identity" $ \(a :: Int) -> a == a+  ]++test_generate_tree :: IO TestTree+test_generate_tree = do+  input <- pure "Some input"+  pure $ testCase input $ pure ()++test_generate_Trees :: IO [TestTree]+test_generate_Trees = do+  inputs <- pure ["First input", "Second input"]+  pure $ map (\s -> testCase s $ pure ()) inputs

@@ -1,45 +0,0 @@--- Unit tests for Test.Tasty.Parse module.--module ParseTest where--import Test.Tasty.Discover (parseConfig, Config(..),-                            Assertion, (@?=))--case_parseConfig :: Assertion-case_parseConfig =-    parseConfig "foo" ["--module-suffix=MySuffix"]-    @?=-    Right Config { configModuleSuffix=Just "MySuffix"-                 , noModuleSuffix=False-                 , ignoredModules=[]-                 }--case_parseConfigMissingArg :: Assertion-case_parseConfigMissingArg =-    parseConfig "foo" ["--module-suffix"]-    @?=-    Left "foo: option `--module-suffix' requires an argument SUFFIX\n"--case_parseConfigEmptyArg :: Assertion-case_parseConfigEmptyArg =-    parseConfig "foo" []-    @?=-    Right (Config Nothing False [])--case_parseConfigInvalidArg :: Assertion-case_parseConfigInvalidArg =-    parseConfig "foo" ["a"]-    @?=-    Left "foo: unexpected argument `a`\n"--case_parseConfigBooleanArg :: Assertion-case_parseConfigBooleanArg  =-    parseConfig "foo" ["--no-module-suffix"]-    @?=-    Right Config {configModuleSuffix=Nothing, noModuleSuffix=True, ignoredModules= []}--case_parseConfigInvalidArgCombination :: Assertion-case_parseConfigInvalidArgCombination =-    parseConfig "foo" ["--module-suffix=MySuffix", "--no-module-suffix"]-    @?=-    Left "foo: You cannot combine '--no-module-suffix' and '--module-suffix'\n"

@@ -1,20 +0,0 @@--- Unit tests to assure `tasty-discover` is discovering tests.--module RunnerTest where--import Test.Tasty.Discover (Assertion, (@?), defaultConfig, getListOfTests)--case_unitTestsDiscovered :: Assertion-case_unitTestsDiscovered = do-  unitTests <- getListOfTests "test" defaultConfig-  (return $ null unitTests :: IO Bool) @? "Couldn't find any unit tests."--case_integrationTestsDiscovered :: Assertion-case_integrationTestsDiscovered = do-  integrationTests <- getListOfTests "integration-test/" defaultConfig-  (return $ null integrationTests :: IO Bool) @? "Couldn't find any integration tests."--case_exampleTestsDiscovered :: Assertion-case_exampleTestsDiscovered = do-  exampleTests <- getListOfTests "example/" defaultConfig-  (return $ null exampleTests :: IO Bool) @? "Couldn't find any example tests."

@@ -0,0 +1,4 @@+module FooBaz where++prop_addition_is_commutative :: Int -> Int -> Bool+prop_addition_is_commutative a b = a + b == b + a

@@ -0,0 +1,4 @@+module SubMod.PropTest where++prop_addition_is_associative :: Int -> Int -> Int -> Bool+prop_addition_is_associative a b c = (a + b) + c == a + (b + c)

@@ -1,40 +0,0 @@--- Unit tests for Test.Tasty.Util module.--module UtilTest where--import Test.Tasty.Discover (Assertion, (@?=), defaultConfig, getListOfTests,-                            findTests, fileToTest, getFilesRecursive,-                            isValidModuleChar, isValidModuleName,-                            Config(..), Test(..))--case_getListOfTests :: Assertion-case_getListOfTests = do-  result <- getListOfTests "test/tmpdir/" defaultConfig-  result @?= ["case_foo"]--case_getListOfTestsWithSuffix :: Assertion-case_getListOfTestsWithSuffix = do-  let config = Config (Just "DoesntExist") False []-  result <- getListOfTests "test/tmpdir/" config-  result @?= []--case_findTests :: Assertion-case_findTests = do-  result <- findTests "test/tmpdir/" defaultConfig-  result @?= [Test {testFile="test/tmpdir/FooTest.hs", testModule="Foo"}]--case_fileToTest :: Assertion-case_fileToTest = do-  let result = fileToTest "test/tmpdir/" defaultConfig "FooTest.hs"-  result @?= Just Test {testFile="test/tmpdir/FooTest.hs", testModule="Foo"}--case_getFilesRecursive :: Assertion-case_getFilesRecursive = do-  result <- getFilesRecursive "test/tmpdir/"-  result @?= ["FooTest.hs", "README.md"]--case_isValidModuleChar :: Assertion-case_isValidModuleChar = isValidModuleChar 'C' @?= True--case_isValidModuleName :: Assertion-case_isValidModuleName = isValidModuleName "Jim" @?= True

@@ -1,3 +0,0 @@-module FooTest where--case_foo = undefined

@@ -1,3 +0,0 @@-# tmpdir--This folder is used for various unit tests in the parent folder.