tasty-auto 0.0.0.0 → 0.1.0.0
raw patch · 3 files changed
+82/−44 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- README.md +43/−0
- src/Test/Tasty/Auto.hs +38/−43
- tasty-auto.cabal +1/−1
README.md view
@@ -84,3 +84,46 @@ inputs <- pure ["First input", "Second input"] pure $ map (\s -> testCase s $ pure ()) inputs ```++### Generated code++The generated code of the preprocessor looks like this:++``` haskell+{-# LINE 1 "test/test.hs" #-}+{-# LANGUAGE FlexibleInstances #-}+module Main where+import Prelude+import qualified Test.Tasty as T+import qualified Test.Tasty.HUnit as HU+import qualified Test.Tasty.QuickCheck as QC+import qualified Test.Tasty.SmallCheck as SC+import qualified Test.Tasty.Hspec as HS+import qualified CaseTest+import qualified SCPropTest+import qualified TreeTest+import qualified PropTest+import qualified TestSpec+import qualified SubMod.PropTest+class TestCase a where testCase :: String -> a -> IO T.TestTree+instance TestCase (IO ()) where testCase n = pure . HU.testCase n+instance TestCase (IO String) where testCase n = pure . HU.testCaseInfo n+instance TestCase ((String -> IO ()) -> IO ()) where testCase n = pure . HU.testCaseSteps n+class TestGroup a where testGroup :: String -> a -> IO T.TestTree+instance TestGroup T.TestTree where testGroup _ a = pure a+instance TestGroup [T.TestTree] where testGroup n a = pure $ T.testGroup n a+instance TestGroup (IO T.TestTree) where testGroup _ a = a+instance TestGroup (IO [T.TestTree]) where testGroup n a = T.testGroup n <$> a+main :: IO ()+main = do+ t0 <- testCase "List comparison with different length" CaseTest.case_List_comparison_with_different_length+ t1 <- pure $ SC.testProperty "sort reverse" SCPropTest.scprop_sort_reverse+ t2 <- testGroup "Addition" TreeTest.test_Addition+ t3 <- testGroup "Multiplication" TreeTest.test_Multiplication+ t4 <- testGroup "Generate Tree" TreeTest.test_Generate_Tree+ t5 <- testGroup "Generate Trees" TreeTest.test_Generate_Trees+ t6 <- pure $ QC.testProperty "Addition is commutative" PropTest.prop_Addition_is_commutative+ t7 <- HS.testSpec "Prelude" TestSpec.spec_Prelude+ t8 <- pure $ QC.testProperty "Addition is associative" SubMod.PropTest.prop_Addition_is_associative+ T.defaultMain $ T.testGroup "test/test.hs" [t0,t1,t2,t3,t4,t5,t6,t7,t8]+```
src/Test/Tasty/Auto.hs view
@@ -11,8 +11,7 @@ data Generator = Generator { genPrefix :: String- , genImport :: ShowS- , genInstance :: ShowS+ , genImport, genClass :: ShowS , genSetup :: Test -> ShowS } data Test = Test { testModule, testFunction :: String }@@ -27,42 +26,39 @@ tr :: Char -> Char -> String -> String tr a b = map $ \c -> if c == a then b else c -name, fn, var :: Test -> ShowS+name, fn :: Test -> ShowS name = shows . tr '_' ' ' . tail . dropWhile (/= '_') . testFunction fn t = str (testModule t) . ('.':) . str (testFunction t)-var t = str "setup_" . str (tr '.' '_' $ testModule t) . ('_':) . str (testFunction t) generators :: [Generator] generators = [ Generator { genPrefix = "prop_"- , genImport = str "import qualified Test.Tasty.QuickCheck\n"- , genInstance = id- , genSetup = \t -> str "pure $ Test.Tasty.QuickCheck.testProperty " . name t . sp . fn t }+ , genImport = str "import qualified Test.Tasty.QuickCheck as QC\n"+ , genClass = id+ , genSetup = \t -> str "pure $ QC.testProperty " . name t . sp . fn t } , Generator { genPrefix = "scprop_"- , genImport = str "import qualified Test.Tasty.SmallCheck\n"- , genInstance = id- , genSetup = \t -> str "pure $ Test.Tasty.SmallCheck.testProperty " . name t . sp . fn t }+ , genImport = str "import qualified Test.Tasty.SmallCheck as SC\n"+ , genClass = id+ , genSetup = \t -> str "pure $ SC.testProperty " . name t . sp . fn t } , Generator { genPrefix = "case_"- , genImport = str "import qualified Test.Tasty.HUnit\n"- , genInstance =- str "class TestCase a where testCase :: String -> a -> IO Test.Tasty.TestTree\n"- . str "instance TestCase (IO ()) where testCase n = pure . Test.Tasty.HUnit.testCase n\n"- . str "instance TestCase (IO String) where testCase n = pure . Test.Tasty.HUnit.testCaseInfo n\n"- . str "instance TestCase ((String -> IO ()) -> IO ()) where testCase n = pure . Test.Tasty.HUnit.testCaseSteps n\n"- , genSetup = \t -> str "testCase " . name t . sp . fn t }+ , genImport = str "import qualified Test.Tasty.HUnit as HU\n"+ , genClass = str "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"+ , genSetup = \t -> str "testCase " . name t . sp . fn t } , Generator { genPrefix = "spec_"- , genImport = str "import qualified Test.Tasty.Hspec\n"- , genInstance = id- , genSetup = \t -> str "Test.Tasty.Hspec.testSpec " . name t . sp . fn t }+ , genImport = str "import qualified Test.Tasty.Hspec as HS\n"+ , genClass = id+ , genSetup = \t -> str "HS.testSpec " . name t . sp . fn t } , Generator { genPrefix = "test_" , genImport = id- , genInstance =- str "class TestGroup a where testGroup :: String -> a -> IO Test.Tasty.TestTree\n"- . str "instance TestGroup Test.Tasty.TestTree where testGroup _ a = pure a\n"- . str "instance TestGroup [Test.Tasty.TestTree] where testGroup n a = pure $ Test.Tasty.testGroup n a\n"- . str "instance TestGroup (IO Test.Tasty.TestTree) where testGroup _ a = a\n"- . str "instance TestGroup (IO [Test.Tasty.TestTree]) where testGroup n a = Test.Tasty.testGroup n <$> a\n"- , genSetup = \t -> str "testGroup " . name t . sp . fn t } ]+ , genClass = str "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"+ , genSetup = \t -> str "testGroup " . name t . sp . fn t } ] testFileSuffixes :: [String] testFileSuffixes = (++) <$> ["Spec", "Test"] <*> [".lhs", ".hs"]@@ -76,29 +72,28 @@ showImports :: [Test] -> ShowS showImports = foldEndo . map (\m -> str "import qualified " . str m . nl) . nub . map testModule -showSetup :: Test -> ShowS-showSetup t = str " " . var t . str " <- " . genSetup (getGenerator t) t . nl+showSetup :: Test -> ShowS -> ShowS+showSetup t var = str " " . var . str " <- " . genSetup (getGenerator t) t . nl foldEndo :: (Functor f, Foldable f) => f (a -> a) -> (a -> a) foldEndo = appEndo . fold . fmap Endo showTestDriver :: FilePath -> [Test] -> ShowS-showTestDriver src ts = let gs = getGenerators ts in- str "{-# LINE 1 " . shows src . str " #-}\n"- . str "{-# LANGUAGE FlexibleInstances #-}\n"- . str "module Main where\n"- . str "import Prelude\n"- . str "import qualified Test.Tasty\n"+showTestDriver src ts = let gs = getGenerators ts; vars = map (str . ("t"++) . show) [(0::Int)..] in+ str "{-# LINE 1 " . shows src . str " #-}\n\+ \{-# LANGUAGE FlexibleInstances #-}\n\+ \module Main where\n\+ \import Prelude\n\+ \import qualified Test.Tasty as T\n" . foldEndo (map genImport gs) . showImports ts- . foldEndo (map genInstance gs)- . str "main :: IO ()\n"- . str "main = do\n"- . foldEndo (map showSetup ts)- . str " Test.Tasty.defaultMain $ Test.Tasty.testGroup " . shows src- . str "\n [ "- . foldEndo (intersperse (str "\n , ") $ map var ts)- . str " ]\n"+ . foldEndo (map genClass gs)+ . str "main :: IO ()\n\+ \main = do\n"+ . foldEndo (zipWith showSetup ts vars)+ . str " T.defaultMain $ T.testGroup " . shows src . str " ["+ . foldEndo (intersperse (',':) $ zipWith (curry snd) ts vars)+ . str "]\n" filesBySuffix :: FilePath -> [String] -> IO [FilePath] filesBySuffix dir suffixes = do
tasty-auto.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: tasty-auto-version: 0.0.0.0+version: 0.1.0.0 synopsis: Simple auto discovery for Tasty description: Simple auto discovery for Tasty category: Testing