diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -64,6 +64,7 @@ ``` test-suite test + type: exitcode-stdio-1.0 main-is: Driver.hs hs-source-dirs: test build-depends: base diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,43 @@ +-- | Main executable module. + +module Main where + +import Control.Monad (when) +import Data.Maybe (fromMaybe) +import System.Environment (getArgs, getProgName) +import System.Exit (exitFailure) +import System.FilePath (takeDirectory) +import System.IO (IOMode(ReadMode), hGetContents, hPutStrLn, withFile, stderr) +import Test.Tasty.Discover.Internal.Config (Config (..), parseConfig) +import Test.Tasty.Discover.Internal.Driver (findTests, generateTestDriver) + +-- | Main function. +main :: IO () +main = do + args <- getArgs + name <- getProgName + case args of + src:_:dst:opts -> + case parseConfig (takeDirectory src) name opts of + Left err -> do + hPutStrLn stderr err + exitFailure + Right config -> do + tests <- findTests config + let ingredients = tastyIngredients config + moduleName = fromMaybe "Main" (generatedModuleName config) + header <- readHeader src + let output = generateTestDriver config moduleName ingredients src tests + when (debug config) $ hPutStrLn stderr output + when (inPlace config) $ writeFile src $ unlines $ header ++ [marker, output] + writeFile dst $ + "{-# LINE " ++ show (length header + 2) ++ " " ++ show src ++ " #-}\n" + ++ output + _ -> do + hPutStrLn stderr "Usage: tasty-discover src _ dst [OPTION...]" + exitFailure + where + marker = "-- GENERATED BY tasty-discover" + readHeader src = withFile src ReadMode $ \h -> do + header <- takeWhile (marker /=) . lines <$> hGetContents h + seq (length header) (return header) diff --git a/executable/Main.hs b/executable/Main.hs deleted file mode 100644 --- a/executable/Main.hs +++ /dev/null @@ -1,43 +0,0 @@ --- | Main executable module. - -module Main where - -import Control.Monad (when) -import Data.Maybe (fromMaybe) -import System.Environment (getArgs, getProgName) -import System.Exit (exitFailure) -import System.FilePath (takeDirectory) -import System.IO (IOMode(ReadMode), hGetContents, hPutStrLn, withFile, stderr) -import Test.Tasty.Discover.Internal.Config (Config (..), parseConfig) -import Test.Tasty.Discover.Internal.Driver (findTests, generateTestDriver) - --- | Main function. -main :: IO () -main = do - args <- getArgs - name <- getProgName - case args of - src:_:dst:opts -> - case parseConfig (takeDirectory src) name opts of - Left err -> do - hPutStrLn stderr err - exitFailure - Right config -> do - tests <- findTests config - let ingredients = tastyIngredients config - moduleName = fromMaybe "Main" (generatedModuleName config) - header <- readHeader src - let output = generateTestDriver config moduleName ingredients src tests - when (debug config) $ hPutStrLn stderr output - when (inPlace config) $ writeFile src $ unlines $ header ++ [marker, output] - writeFile dst $ - "{-# LINE " ++ show (length header + 2) ++ " " ++ show src ++ " #-}\n" - ++ output - _ -> do - hPutStrLn stderr "Usage: tasty-discover src _ dst [OPTION...]" - exitFailure - where - marker = "-- GENERATED BY tasty-discover" - readHeader src = withFile src ReadMode $ \h -> do - header <- takeWhile (marker /=) . lines <$> hGetContents h - seq (length header) (return header) diff --git a/src/Test/Tasty/Discover/Internal/Config.hs b/src/Test/Tasty/Discover/Internal/Config.hs --- a/src/Test/Tasty/Discover/Internal/Config.hs +++ b/src/Test/Tasty/Discover/Internal/Config.hs @@ -39,7 +39,7 @@ , noModuleSuffix :: Bool -- ^ <<>>: suffix and look in all modules. , debug :: Bool -- ^ Debug the generated module. , treeDisplay :: Bool -- ^ Tree display for the test results table. - } deriving (Show) + } deriving stock (Show) -- | The default configuration defaultConfig :: FilePath -> Config diff --git a/src/Test/Tasty/Discover/Internal/Driver.hs b/src/Test/Tasty/Discover/Internal/Driver.hs --- a/src/Test/Tasty/Discover/Internal/Driver.hs +++ b/src/Test/Tasty/Discover/Internal/Driver.hs @@ -106,9 +106,16 @@ -- | Extract the test names from discovered modules. extractTests :: FilePath -> String -> [Test] extractTests file = mkTestDeDuped . isKnownPrefix . parseTest - where mkTestDeDuped = map (mkTest file) . nub + where mkTestDeDuped :: [String] -> [Test] + mkTestDeDuped = map (mkTest file) . nub + + isKnownPrefix :: [String] -> [String] isKnownPrefix = filter (\g -> any (checkPrefix g) generators) + + checkPrefix :: String -> Generator -> Bool checkPrefix g = (`isPrefixOf` g) . generatorPrefix + + parseTest :: String -> [String] parseTest = map fst . concatMap lex . lines -- | Show the imports. @@ -130,7 +137,7 @@ else zipWith const testNumVars tests newtype ModuleTree = ModuleTree (M.Map String (ModuleTree, [String])) - deriving (Eq, Show) + deriving stock (Eq, Show) showModuleTree :: ModuleTree -> [String] showModuleTree (ModuleTree mdls) = map showModule $ M.assocs mdls diff --git a/src/Test/Tasty/Discover/Internal/Generator.hs b/src/Test/Tasty/Discover/Internal/Generator.hs --- a/src/Test/Tasty/Discover/Internal/Generator.hs +++ b/src/Test/Tasty/Discover/Internal/Generator.hs @@ -31,7 +31,7 @@ data Test = Test { testModule :: String -- ^ Module name. , testFunction :: String -- ^ Function name. - } deriving (Eq, Show, Ord) + } deriving stock (Eq, Show, Ord) -- | 'Test' constructor. mkTest :: FilePath -> String -> Test diff --git a/src/Test/Tasty/Discover/TastyInfo.hs b/src/Test/Tasty/Discover/TastyInfo.hs --- a/src/Test/Tasty/Discover/TastyInfo.hs +++ b/src/Test/Tasty/Discover/TastyInfo.hs @@ -7,7 +7,7 @@ data TastyInfo = TastyInfo { name :: Last String , description :: Last String - } deriving (Eq, Show) + } deriving stock (Eq, Show) instance Semigroup TastyInfo where a <> b = TastyInfo diff --git a/tasty-discover.cabal b/tasty-discover.cabal --- a/tasty-discover.cabal +++ b/tasty-discover.cabal @@ -1,7 +1,7 @@ cabal-version: 2.2 name: tasty-discover -version: 5.0.0 +version: 5.0.1 synopsis: Test discovery for the tasty framework. description: Automatic test discovery and runner for the tasty framework. @@ -33,6 +33,11 @@ type: git location: https://github.com/haskell-works/tasty-discover +flag dev + description: Enable development mode + manual: True + default: False + common base { build-depends: base >= 4.11 && < 5 } common bytestring { build-depends: bytestring >= 0.9 && < 1.0 } @@ -41,10 +46,9 @@ common filepath { build-depends: filepath >= 1.3 && < 2.0 } common Glob { build-depends: Glob >= 0.8 && < 1.0 } common hedgehog { build-depends: hedgehog >= 1.0 && < 2.0 } -common hspec { build-depends: hspec >= 2.7 && < 2.10 } -common hspec-core { build-depends: hspec-core >= 2.7.10 && < 2.11 } +common hspec { build-depends: hspec >= 2.7 && < 2.12 } +common hspec-core { build-depends: hspec-core >= 2.7.10 && < 2.12 } common tasty { build-depends: tasty >= 1.3 && < 2.0 } -common tasty-discover { build-depends: tasty-discover >= 4.0 && < 5.0 } common tasty-golden { build-depends: tasty-golden >= 2.0 && < 3.0 } common tasty-hedgehog { build-depends: tasty-hedgehog >= 1.2 && < 2.0 } common tasty-hspec { build-depends: tasty-hspec >= 1.1 && < 1.3 } @@ -52,7 +56,29 @@ common tasty-quickcheck { build-depends: tasty-quickcheck >= 0.10 && < 0.11 } common tasty-smallcheck { build-depends: tasty-smallcheck >= 0.8 && < 1.0 } +common project-config + default-extensions: DerivingStrategies + if (impl(ghc >= 9.2.1)) + default-extensions: OverloadedRecordDot + ghc-options: -Wall + -Widentities + -Wincomplete-uni-patterns + -Wmissing-deriving-strategies + -Wredundant-constraints + -Wunused-packages + default-language: GHC2021 + if (flag(dev)) + ghc-options: -Werror + +common tasty-discover + build-depends: tasty-discover + library + import: base, project-config + , Glob + , containers + , filepath + , tasty exposed-modules: Test.Tasty.Discover Test.Tasty.Discover.Internal.Config Test.Tasty.Discover.Internal.Driver @@ -63,21 +89,12 @@ autogen-modules: Paths_tasty_discover hs-source-dirs: src ghc-options: -Wall - build-depends: base >= 4.8 && < 5.0 - , Glob >= 0.8 && < 1.0 - , containers >= 0.4 && < 1.0 - , directory >= 1.1 && < 2.0 - , filepath >= 1.3 && < 2.0 - , tasty >= 1.3 && < 2.0 default-language: Haskell2010 -executable tasty-discover - import: base - , Glob - , containers - , directory +executable tasty-discover + import: base, project-config , filepath - main-is: executable/Main.hs + main-is: app/Main.hs autogen-modules: Paths_tasty_discover other-modules: Paths_tasty_discover ghc-options: -Wall @@ -85,12 +102,9 @@ default-language: Haskell2010 test-suite tasty-discover-test - import: base - , Glob + import: base, project-config , bytestring , containers - , directory - , filepath , hedgehog , hspec , hspec-core