diff --git a/LICENSE.md b/LICENSE.md --- a/LICENSE.md +++ b/LICENSE.md @@ -1,12 +1,19 @@ -tasty-discover - Test discovery for the tasty framework. -Copyright (C) 2017 Luke Murphy +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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Setup.lhs b/Setup.lhs deleted file mode 100644 --- a/Setup.lhs +++ /dev/null @@ -1,3 +0,0 @@ -#!/usr/bin/env runhaskell -> import Distribution.Simple -> main = defaultMain diff --git a/example/test/AllTheFolders/AnotherNestTest.hs b/example/test/AllTheFolders/AnotherNestTest.hs deleted file mode 100644 --- a/example/test/AllTheFolders/AnotherNestTest.hs +++ /dev/null @@ -1,4 +0,0 @@ -module AllTheFolders.AnotherNestTest where - -prop_nineIsNine :: Bool -prop_nineIsNine = 9 == (9 :: Integer) diff --git a/example/test/BarTest.hs b/example/test/BarTest.hs deleted file mode 100644 --- a/example/test/BarTest.hs +++ /dev/null @@ -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) diff --git a/example/test/FooTest.hs b/example/test/FooTest.hs deleted file mode 100644 --- a/example/test/FooTest.hs +++ /dev/null @@ -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) diff --git a/example/test/Tasty.hs b/example/test/Tasty.hs deleted file mode 100644 --- a/example/test/Tasty.hs +++ /dev/null @@ -1,1 +0,0 @@ -{-# OPTIONS_GHC -F -pgmF tasty-discover #-} diff --git a/example/test/Thing/AnotherThing/NestedTest.hs b/example/test/Thing/AnotherThing/NestedTest.hs deleted file mode 100644 --- a/example/test/Thing/AnotherThing/NestedTest.hs +++ /dev/null @@ -1,4 +0,0 @@ -module Thing.AnotherThing.NestedTest where - -prop_twoIsTwo :: Bool -prop_twoIsTwo = 2 == (2 :: Integer) diff --git a/executable/Main.hs b/executable/Main.hs new file mode 100644 --- /dev/null +++ b/executable/Main.hs @@ -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 diff --git a/integration-test/test-configurable-module/FooMySuffix.hs b/integration-test/test-configurable-module/FooMySuffix.hs deleted file mode 100644 --- a/integration-test/test-configurable-module/FooMySuffix.hs +++ /dev/null @@ -1,4 +0,0 @@ -module FooMySuffix where - -prop_theNumberOfTheBeast :: Bool -prop_theNumberOfTheBeast = 666 == (666 :: Integer) diff --git a/integration-test/test-configurable-module/Nested/BarMySuffix.hs b/integration-test/test-configurable-module/Nested/BarMySuffix.hs deleted file mode 100644 --- a/integration-test/test-configurable-module/Nested/BarMySuffix.hs +++ /dev/null @@ -1,4 +0,0 @@ -module Nested.BarMySuffix where - -prop_theMeaningOfLife :: Bool -prop_theMeaningOfLife = 42 == (42 :: Integer) diff --git a/integration-test/test-configurable-module/Tasty.hs b/integration-test/test-configurable-module/Tasty.hs deleted file mode 100644 --- a/integration-test/test-configurable-module/Tasty.hs +++ /dev/null @@ -1,1 +0,0 @@ -{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --module-suffix=MySuffix #-} diff --git a/integration-test/test-no-module-suffix/Nested/AnotherBar.hs b/integration-test/test-no-module-suffix/Nested/AnotherBar.hs deleted file mode 100644 --- a/integration-test/test-no-module-suffix/Nested/AnotherBar.hs +++ /dev/null @@ -1,4 +0,0 @@ -module Nested.AnotherBar where - -prop_someOtherTest :: Bool -prop_someOtherTest = 12 == (12 :: Integer) diff --git a/integration-test/test-no-module-suffix/SomeFoo.hs b/integration-test/test-no-module-suffix/SomeFoo.hs deleted file mode 100644 --- a/integration-test/test-no-module-suffix/SomeFoo.hs +++ /dev/null @@ -1,6 +0,0 @@ -module SomeFoo where - -import Data.Maybe (isNothing) - -prop_whatIsHapeningHere :: Bool -prop_whatIsHapeningHere = isNothing Nothing diff --git a/integration-test/test-no-module-suffix/Tasty.hs b/integration-test/test-no-module-suffix/Tasty.hs deleted file mode 100644 --- a/integration-test/test-no-module-suffix/Tasty.hs +++ /dev/null @@ -1,1 +0,0 @@ -{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --no-module-suffix #-} diff --git a/library/Test/Tasty/Config.hs b/library/Test/Tasty/Config.hs new file mode 100644 --- /dev/null +++ b/library/Test/Tasty/Config.hs @@ -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" + ] diff --git a/library/Test/Tasty/Discover.hs b/library/Test/Tasty/Discover.hs new file mode 100644 --- /dev/null +++ b/library/Test/Tasty/Discover.hs @@ -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"] diff --git a/library/Test/Tasty/Generator.hs b/library/Test/Tasty/Generator.hs new file mode 100644 --- /dev/null +++ b/library/Test/Tasty/Generator.hs @@ -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 + } diff --git a/library/Test/Tasty/Type.hs b/library/Test/Tasty/Type.hs new file mode 100644 --- /dev/null +++ b/library/Test/Tasty/Type.hs @@ -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 + , " String>" + ] + +type Ingredient = String + +data Config = Config + { moduleSuffix :: Maybe String + , generatedModuleName :: Maybe String + , ignoredModules :: [FilePath] + , tastyIngredients :: [Ingredient] + , noModuleSuffix :: Bool + , debug :: Bool + } deriving (Show) diff --git a/src/Main.hs b/src/Main.hs deleted file mode 100644 --- a/src/Main.hs +++ /dev/null @@ -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 diff --git a/src/Test/Tasty/Config.hs b/src/Test/Tasty/Config.hs deleted file mode 100644 --- a/src/Test/Tasty/Config.hs +++ /dev/null @@ -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") "" - ] diff --git a/src/Test/Tasty/Discover.hs b/src/Test/Tasty/Discover.hs deleted file mode 100644 --- a/src/Test/Tasty/Discover.hs +++ /dev/null @@ -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 diff --git a/src/Test/Tasty/Parse.hs b/src/Test/Tasty/Parse.hs deleted file mode 100644 --- a/src/Test/Tasty/Parse.hs +++ /dev/null @@ -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) diff --git a/src/Test/Tasty/Run.hs b/src/Test/Tasty/Run.hs deleted file mode 100644 --- a/src/Test/Tasty/Run.hs +++ /dev/null @@ -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" diff --git a/src/Test/Tasty/Type.hs b/src/Test/Tasty/Type.hs deleted file mode 100644 --- a/src/Test/Tasty/Type.hs +++ /dev/null @@ -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) - diff --git a/src/Test/Tasty/Util.hs b/src/Test/Tasty/Util.hs deleted file mode 100644 --- a/src/Test/Tasty/Util.hs +++ /dev/null @@ -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 diff --git a/tasty-discover.cabal b/tasty-discover.cabal --- a/tasty-discover.cabal +++ b/tasty-discover.cabal @@ -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 -maintainer: Luke Murphy -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 +maintainer: Luke Murphy +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 diff --git a/test/ConfigTest.hs b/test/ConfigTest.hs new file mode 100644 --- /dev/null +++ b/test/ConfigTest.hs @@ -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 diff --git a/test/DiscoverTest.hs b/test/DiscoverTest.hs new file mode 100644 --- /dev/null +++ b/test/DiscoverTest.hs @@ -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 diff --git a/test/ParseTest.hs b/test/ParseTest.hs deleted file mode 100644 --- a/test/ParseTest.hs +++ /dev/null @@ -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" diff --git a/test/RunnerTest.hs b/test/RunnerTest.hs deleted file mode 100644 --- a/test/RunnerTest.hs +++ /dev/null @@ -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." diff --git a/test/SubMod/FooBaz.hs b/test/SubMod/FooBaz.hs new file mode 100644 --- /dev/null +++ b/test/SubMod/FooBaz.hs @@ -0,0 +1,4 @@ +module FooBaz where + +prop_addition_is_commutative :: Int -> Int -> Bool +prop_addition_is_commutative a b = a + b == b + a diff --git a/test/SubMod/PropTest.hs b/test/SubMod/PropTest.hs new file mode 100644 --- /dev/null +++ b/test/SubMod/PropTest.hs @@ -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) diff --git a/test/UtilTest.hs b/test/UtilTest.hs deleted file mode 100644 --- a/test/UtilTest.hs +++ /dev/null @@ -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 diff --git a/test/tmpdir/FooTest.hs b/test/tmpdir/FooTest.hs deleted file mode 100644 --- a/test/tmpdir/FooTest.hs +++ /dev/null @@ -1,3 +0,0 @@ -module FooTest where - -case_foo = undefined diff --git a/test/tmpdir/README.md b/test/tmpdir/README.md deleted file mode 100644 --- a/test/tmpdir/README.md +++ /dev/null @@ -1,3 +0,0 @@ -# tmpdir - -This folder is used for various unit tests in the parent folder.