tasty-auto (empty) → 0.0.0.0

raw patch · 13 files changed

+446/−0 lines, 13 filesdep +basedep +directorydep +filepathsetup-changed

Dependencies added: base, directory, filepath, tasty, tasty-auto, tasty-hspec, tasty-hunit, tasty-quickcheck, tasty-smallcheck

Files

• LICENSE +21/−0
• README.md +86/−0
• Setup.hs +69/−0
• src/Test/Tasty/Auto.hs +125/−0
• tasty-auto.cabal +75/−0
• tasty-auto.hs +15/−0
• test/CaseTest.hs +6/−0
• test/PropTest.hs +4/−0
• test/SCPropTest.hs +6/−0
• test/SubMod/PropTest.hs +4/−0
• test/TestSpec.hs +9/−0
• test/TreeTest.hs +25/−0
• test/test.hs +1/−0

@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2017 Daniel Mendler++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:++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,86 @@+# tasty-auto: Simple auto discovery for Tasty++[![Hackage](https://img.shields.io/hackage/v/tasty-auto.svg)](https://hackage.haskell.org/package/tasty-auto)+[![Build Status](https://secure.travis-ci.org/minad/tasty-auto.png?branch=master)](http://travis-ci.org/minad/tasty-auto)++This package provides auto discovery for the tasty test framework.++* Install tasty-auto (using cabal or stack)++* Create a file test/test.hs++``` haskell+-- test/test.hs+{-# OPTIONS_GHC -F -pgmF tasty-auto #-}+```++* Put your tests in files with the suffix `*Test.hs` or `*Spec.hs`. Functions+with the following prefixes are automatically discovered:++* `prop_` for QuickCheck properties+* `scprop_` for SmallCheck properties+* `case_` for HUnit test cases (overloaded for `IO ()`, `IO String` and `(String -> IO ()) -> IO`)+* `spec_` for Hspec specifications+* `test_` for Tasty TestTrees (overloaded for `TestTree`, `[TestTree]`, `IO TestTree` and `IO [TestTree]`)++## Examples++``` haskell+-- test/PropTest.hs+module PropTest where++prop_Addition_is_commutative :: Int -> Int -> Bool+prop_Addition_is_commutative a b = a + b == b + a+```++``` haskell+-- test/CaseTest.hs+module CaseTest where++import Test.Tasty.HUnit++case_List_comparison_with_different_length :: IO ()+case_List_comparison_with_different_length = [1, 2, 3] `compare` [1,2] @?= GT+```++``` haskell+-- test/TestSpec.hs+module TestSpec where++import Test.Tasty.Hspec++spec_Prelude :: Spec+spec_Prelude = do+  describe "Prelude.head" $ do+    it "returns the first element of a list" $ do+      head [23 ..] `shouldBe` (23 :: Int)+```++``` haskell+-- test/TreeTest.hs+{-# LANGUAGE ScopedTypeVariables #-}+module TreeTest where++import Test.Tasty+import Test.Tasty.QuickCheck+import Test.Tasty.HUnit++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 * 1 == 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+```

@@ -0,0 +1,69 @@+{-# OPTIONS_GHC -Wall #-}+module Main where++import Data.Char (isSpace)+import Data.List (dropWhileEnd)+import Data.Version (showVersion)+import Distribution.PackageDescription (PackageDescription(..), defaultExtensions, libBuildInfo)+import Distribution.Simple (defaultMainWithHooks, UserHooks(..), simpleUserHooks)+import Distribution.Simple (packageVersion)+import Distribution.Simple.BuildPaths (autogenModulesDir)+import Distribution.Simple.LocalBuildInfo (LocalBuildInfo())+import Distribution.Simple.Setup (BuildFlags(buildVerbosity), fromFlag)+import Distribution.Simple.Utils (createDirectoryIfMissingVerbose)+import Distribution.Text (display)+import Distribution.Verbosity (Verbosity)+import System.Exit (ExitCode(..))+import System.FilePath ((</>))+import System.Process (readProcessWithExitCode)++main :: IO ()+main = defaultMainWithHooks simpleUserHooks+  { buildHook = \pkg lbi hooks flags -> do+      generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi+      buildHook simpleUserHooks pkg lbi hooks flags+  }++git :: [String] -> IO String+git args = do+  (code, out, _) <- readProcessWithExitCode "git" args ""+  pure $ case code of+    ExitSuccess -> dropWhileEnd isSpace out+    ExitFailure{} -> "Unknown"++generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()+generateBuildModule verbosity pkg lbi = do+  let dir = autogenModulesDir lbi+  createDirectoryIfMissingVerbose verbosity True dir++  gitTag <- git ["describe", "--dirty", "--tags", "--all"]+  gitCommit <- git ["rev-parse", "HEAD"]+  gitDate <- git ["log", "HEAD", "-1", "--format=%cd"]+  --buildTime <- readProcess "date" ["-R"] ""++  let exts = maybe [] (map display . defaultExtensions . libBuildInfo) (library pkg)++  writeFile (dir </> "Build_chili.hs") $ unlines $+    [ "module Build_chili where"+    , ""+    , "import Chili.Intro"+    , ""+    , "gitCommit :: String"+    , "gitCommit = " ++ show gitCommit+    , ""+    , "gitTag :: String"+    , "gitTag = " ++ show gitTag+    , ""+    , "gitDate :: String"+    , "gitDate = " ++ show gitDate+    , ""+    -- Think about this because of reproducible builds+--    , "buildTime :: String"+--    , "buildTime = " ++ show buildTime+--    , ""+    , "chiliVersion :: String"+    , "chiliVersion = " ++ show (showVersion $ packageVersion pkg)+    , ""+    , "languageExtensions :: [String]"+    , "languageExtensions = " ++ show exts+    ]

@@ -0,0 +1,125 @@+module Test.Tasty.Auto (findTests, showTestDriver) where++import Data.Function (on)+import Data.List (find, isPrefixOf, isSuffixOf, nub, intersperse, groupBy, sortOn)+import Data.Maybe (fromJust)+import System.Directory (getDirectoryContents, doesDirectoryExist)+import Data.Traversable (for)+import System.FilePath ((</>), takeDirectory, pathSeparator, dropExtension)+import Data.Monoid (Endo(..))+import Data.Foldable (fold)++data Generator = Generator+  { genPrefix :: String+  , genImport :: ShowS+  , genInstance :: ShowS+  , genSetup :: Test -> ShowS }++data Test = Test { testModule, testFunction :: String }++str :: String -> ShowS+str = (++)++sp, nl :: ShowS+sp = (' ':)+nl = ('\n':)++tr :: Char -> Char -> String -> String+tr a b = map $ \c -> if c == a then b else c++name, fn, var :: 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 }+  , 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 }+  , 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 }+  , 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 }+  , 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 } ]++testFileSuffixes :: [String]+testFileSuffixes = (++) <$> ["Spec", "Test"] <*> [".lhs", ".hs"]++getGenerator :: Test -> Generator+getGenerator t = fromJust $ find ((`isPrefixOf` testFunction t) . genPrefix) generators++getGenerators :: [Test] -> [Generator]+getGenerators = map head . groupBy  ((==) `on` genPrefix) . sortOn genPrefix . map getGenerator++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++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"+  . 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"++filesBySuffix :: FilePath -> [String] -> IO [FilePath]+filesBySuffix dir suffixes = do+  entries <- filter (\s -> head s /= '.') <$> getDirectoryContents dir+  found <- for entries $ \entry -> do+    let dir' = dir </> entry+    exists <- doesDirectoryExist dir'+    if exists then map (entry </>) <$> filesBySuffix dir' suffixes else pure []+  pure $ filter (\x -> any (`isSuffixOf` x) suffixes) entries ++ concat found++findTests :: FilePath -> IO [Test]+findTests src = do+  let dir = takeDirectory src+  files <- filesBySuffix dir testFileSuffixes+  concat <$> traverse (\f -> extractTests f <$> readFile (dir </> f)) files++mkTest :: FilePath -> String -> Test+mkTest = Test . tr pathSeparator '.' . dropExtension++extractTests :: FilePath -> String -> [Test]+extractTests file =+    map (mkTest file) . nub+  . filter (\n -> any ((`isPrefixOf` n) . genPrefix) generators)+  . map fst . concatMap lex . lines

@@ -0,0 +1,75 @@+-- This file has been generated from package.yaml by hpack version 0.15.0.+--+-- see: https://github.com/sol/hpack++name:           tasty-auto+version:        0.0.0.0+synopsis:       Simple auto discovery for Tasty+description:    Simple auto discovery for Tasty+category:       Testing+stability:      experimental+homepage:       https://github.com/minad/tasty-auto#readme+bug-reports:    https://github.com/minad/tasty-auto/issues+author:         Daniel Mendler <mail@daniel-mendler.de>+maintainer:     Daniel Mendler <mail@daniel-mendler.de>+copyright:      2017 Daniel Mendler+license:        MIT+license-file:   LICENSE+tested-with:    GHC == 7.10.3, GHC == 8.0.1+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/minad/tasty-auto++library+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      base       >= 4.8 && < 5+    , directory  >= 1.1 && < 1.3+    , filepath   >= 1.3 && < 1.5+  exposed-modules:+      Test.Tasty.Auto+  default-language: Haskell2010++executable tasty-auto+  main-is: tasty-auto.hs+  ghc-options: -Wall+  build-depends:+      base       >= 4.8 && < 5+    , directory  >= 1.1 && < 1.3+    , filepath   >= 1.3 && < 1.5+    , tasty-auto+  default-language: Haskell2010++test-suite test+  type: exitcode-stdio-1.0+  main-is: test.hs+  hs-source-dirs:+      test+  ghc-options: -Wall+  build-depends:+      base       >= 4.8 && < 5+    , directory  >= 1.1 && < 1.3+    , filepath   >= 1.3 && < 1.5+    , base+    , tasty+    , tasty-auto+    , tasty-hspec+    , tasty-hunit+    , tasty-quickcheck+    , tasty-smallcheck+  other-modules:+      CaseTest+      PropTest+      SCPropTest+      SubMod.PropTest+      TestSpec+      TreeTest+  default-language: Haskell2010

@@ -0,0 +1,15 @@+import System.Exit (exitFailure)+import System.Environment (getArgs)+import System.IO (hPutStrLn, stderr)+import Test.Tasty.Auto++main :: IO ()+main = do+  args <- getArgs+  case args of+    src : _ : dst : _ -> do+      tests <- findTests src+      writeFile dst $ showTestDriver src tests ""+    _ -> do+      hPutStrLn stderr "tasty-auto: Expected source and destination arguments"+      exitFailure

@@ -0,0 +1,6 @@+module CaseTest where++import Test.Tasty.HUnit++case_List_comparison_with_different_length :: IO ()+case_List_comparison_with_different_length = [(1 :: Int), 2, 3] `compare` [1,2] @?= GT

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

@@ -0,0 +1,6 @@+module SCPropTest where++import Data.List (sort)++scprop_sort_reverse :: [Int] -> Bool+scprop_sort_reverse list = sort list == sort (reverse list)

@@ -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)

@@ -0,0 +1,9 @@+module TestSpec where++import Test.Tasty.Hspec++spec_Prelude :: Spec+spec_Prelude = do+  describe "Prelude.head" $ do+    it "returns the first element of a list" $ do+      head [23 ..] `shouldBe` (23 :: Int)

@@ -0,0 +1,25 @@+{-# LANGUAGE ScopedTypeVariables #-}+module TreeTest where++import Test.Tasty+import Test.Tasty.QuickCheck+import Test.Tasty.HUnit++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 * 1 == 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

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