hspec-discover 2.8.2 → 2.8.3

raw patch · 10 files changed

+224/−125 lines, 10 filesdep +mockeryPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: mockery

API changes (from Hackage documentation)

Files

• hspec-discover.cabal +2/−5
• src/Test/Hspec/Discover/Run.hs +114/−40
• src/Test/Hspec/Discover/Sort.hs +6/−3
• test-data/empty-dir/Foo/Bar/Baz/.placeholder +0/−0
• test-data/nested-spec/Foo/Bar/BazSpec.hs +0/−0
• test-data/nested-spec/Foo/BarSpec.hs +0/−0
• test-data/nested-spec/FooSpec.hs +0/−0
• test/Test/Hspec/Discover/RunSpec.hs +97/−72
• test/Test/Hspec/Discover/SortSpec.hs +4/−4
• version.yaml +1/−1

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:             hspec-discover-version:          2.8.2+version:          2.8.3 license:          MIT license-file:     LICENSE copyright:        (c) 2012-2021 Simon Hengel@@ -22,10 +22,6 @@                   <http://hspec.github.io/hspec-discover.html> extra-source-files:     version.yaml-    test-data/nested-spec/Foo/Bar/BazSpec.hs-    test-data/nested-spec/Foo/BarSpec.hs-    test-data/nested-spec/FooSpec.hs-    test-data/empty-dir/Foo/Bar/Baz/.placeholder  source-repository head   type: git@@ -82,6 +78,7 @@     , filepath     , hspec-discover     , hspec-meta ==2.7.8+    , mockery   build-tool-depends:       hspec-meta:hspec-meta-discover   default-language: Haskell2010

@@ -10,12 +10,13 @@ -- exported for testing , Spec(..) , importList-, fileToSpec-, findSpecs-, getFilesRecursive , driverWithFormatter , moduleNameFromId , pathToModule+, Tree(..)+, Forest(..)+, Hook(..)+, discover ) where import           Control.Monad import           Control.Applicative@@ -35,9 +36,8 @@ instance IsString ShowS where   fromString = showString -data Spec = Spec {-  specModule :: String-} deriving (Eq, Show)+data Spec = Spec String | Hook String [Spec]+  deriving (Eq, Show)  run :: [String] -> IO () run args_ = do@@ -57,7 +57,7 @@       hPutStrLn stderr (usage name)       exitFailure -mkSpecModule :: FilePath -> Config -> [Spec] -> String+mkSpecModule :: FilePath -> Config -> Maybe [Spec] -> String mkSpecModule src conf nodes =   ( "{-# LINE 1 " . shows src . " #-}\n"   . showString "{-# LANGUAGE NoImplicitPrelude #-}\n"@@ -99,42 +99,58 @@ moduleNameFromId = reverse . dropWhile (== '.') . dropWhile (/= '.') . reverse  -- | Generate imports for a list of specs.-importList :: [Spec] -> ShowS-importList = foldr (.) "" . map f+importList :: Maybe [Spec] -> ShowS+importList = foldr (.) "" . map f . maybe [] moduleNames   where-    f :: Spec -> ShowS-    f spec = "import qualified " . showString (specModule spec) . "Spec\n"+    f :: String -> ShowS+    f spec = "import qualified " . showString spec . "\n" +moduleNames :: [Spec] -> [String]+moduleNames = fromForest+  where+    fromForest :: [Spec] -> [String]+    fromForest = concatMap fromTree++    fromTree :: Spec -> [String]+    fromTree tree = case tree of+      Spec name -> [name ++ "Spec"]+      Hook name forest -> name : fromForest forest+ -- | Combine a list of strings with (>>). sequenceS :: [ShowS] -> ShowS sequenceS = foldr (.) "" . intersperse " >> " --- | Convert a list of specs to code.-formatSpecs :: [Spec] -> ShowS-formatSpecs xs-  | null xs   = "return ()"-  | otherwise = sequenceS (map formatSpec xs)+formatSpecs :: Maybe [Spec] -> ShowS+formatSpecs specs = case specs of+  Nothing -> "return ()"+  Just xs -> fromForest xs+  where+    fromForest :: [Spec] -> ShowS+    fromForest = sequenceS . map fromTree --- | Convert a spec to code.-formatSpec :: Spec -> ShowS-formatSpec (Spec name) = "describe " . shows name . " " . showString name . "Spec.spec"+    fromTree :: Spec -> ShowS+    fromTree tree = case tree of+      Spec name -> "describe " . shows name . " " . showString name . "Spec.spec"+      Hook name forest -> "(" . showString name . ".hook $ " . fromForest forest . ")" -findSpecs :: FilePath -> IO [Spec]-findSpecs src = do-  let (dir, file) = splitFileName src-  mapMaybe fileToSpec . filter (/= file) <$> getFilesRecursive dir+findSpecs :: FilePath -> IO (Maybe [Spec])+findSpecs = fmap (fmap toSpecs) . discover -fileToSpec :: FilePath -> Maybe Spec-fileToSpec file = case reverse $ splitDirectories file of-  x:xs -> case stripSuffix "Spec.hs" x <|> stripSuffix "Spec.lhs" x of-    Just name | isValidModuleName name && all isValidModuleName xs ->-      Just . Spec $ (intercalate "." . reverse) (name : xs)-    _ -> Nothing-  _ -> Nothing+toSpecs :: Forest -> [Spec]+toSpecs = fromForest []   where-    stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]-    stripSuffix suffix str = reverse <$> stripPrefix (reverse suffix) (reverse str)+    fromForest :: [String] -> Forest -> [Spec]+    fromForest names (Forest WithHook xs) = [Hook (mkModule ("SpecHook" : names)) $ concatMap (fromTree names) xs]+    fromForest names (Forest WithoutHook xs) = concatMap (fromTree names) xs +    fromTree :: [String] -> Tree -> [Spec]+    fromTree names spec = case spec of+      Leaf name -> [Spec $ mkModule (name : names )]+      Node name forest -> fromForest (name : names) forest++    mkModule :: [String] -> String+    mkModule = intercalate "." . reverse+ -- See `Cabal.Distribution.ModuleName` (http://git.io/bj34) isValidModuleName :: String -> Bool isValidModuleName [] = False@@ -143,13 +159,71 @@ isValidModuleChar :: Char -> Bool isValidModuleChar c = isAlphaNum c || c == '_' || c == '\'' -getFilesRecursive :: FilePath -> IO [FilePath]-getFilesRecursive baseDir = sortNaturally <$> go []+data Tree = Leaf String | Node String Forest+  deriving (Eq, Show) +data Forest = Forest Hook [Tree]+  deriving (Eq, Show)++data Hook = WithHook | WithoutHook+  deriving (Eq, Show)++sortKey :: Tree -> (String, Int)+sortKey tree = case tree of+  Leaf name -> (name, 0)+  Node name _ -> (name, 1)++discover :: FilePath -> IO (Maybe Forest)+discover src = (>>= filterSrc) <$> specForest dir   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)+    filterSrc :: Forest -> Maybe Forest+    filterSrc (Forest hook xs) = ensureForest hook $ maybe id (filter . (/=)) (toSpec file) xs++    (dir, file) = splitFileName src++specForest :: FilePath -> IO (Maybe Forest)+specForest dir = do+  files <- listDirectory dir+  hook <- mkHook dir files+  ensureForest hook . sortNaturallyBy sortKey . catMaybes <$> mapM toSpecTree files+  where+    toSpecTree :: FilePath -> IO (Maybe Tree)+    toSpecTree name+      | isValidModuleName name = do+          doesDirectoryExist (dir </> name) `fallback` Nothing $ do+            xs <- specForest (dir </> name)+            return $ Node name <$> xs+      | otherwise = do+          doesFileExist (dir </> name) `fallback` Nothing $ do+            return $ toSpec name++mkHook :: FilePath -> [FilePath] -> IO Hook+mkHook dir files+  | "SpecHook.hs" `elem` files = do+    doesFileExist (dir </> "SpecHook.hs") `fallback` WithoutHook $ do+      return WithHook+  | otherwise = return WithoutHook++fallback :: IO Bool -> a -> IO a -> IO a+fallback p def action = do+  bool <- p+  if bool then action else return def++toSpec :: FilePath -> Maybe Tree+toSpec file = Leaf <$> (spec >>= ensure isValidModuleName)+  where+    spec :: Maybe String+    spec = stripSuffix "Spec.hs" file <|> stripSuffix "Spec.lhs" file++    stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]+    stripSuffix suffix str = reverse <$> stripPrefix (reverse suffix) (reverse str)++ensure :: (a -> Bool) -> a -> Maybe a+ensure p a = guard (p a) >> Just a++ensureForest :: Hook -> [Tree] -> Maybe Forest+ensureForest hook = fmap (Forest hook) . ensure (not . null)++listDirectory :: FilePath -> IO [FilePath]+listDirectory path = filter f <$> getDirectoryContents path+  where f filename = filename /= "." && filename /= ".."

@@ -1,5 +1,8 @@+-- |+-- /NOTE:/ This module is not meant for public consumption.  For user+-- documentation look at http://hspec.github.io/hspec-discover.html. module Test.Hspec.Discover.Sort (-  sortNaturally+  sortNaturallyBy , NaturalSortKey , naturalSortKey ) where@@ -9,8 +12,8 @@ import           Data.List import           Data.Ord -sortNaturally :: [String] -> [String]-sortNaturally = sortBy (comparing naturalSortKey)+sortNaturallyBy :: (a -> (String, Int)) -> [a] -> [a]+sortNaturallyBy f = sortBy (comparing ((\ (k, t) -> (naturalSortKey k, t)) . f))  data NaturalSortKey = NaturalSortKey [Chunk]   deriving (Eq, Ord)

@@ -1,61 +1,78 @@-module Test.Hspec.Discover.RunSpec (main, spec) where+module Test.Hspec.Discover.RunSpec (spec) where  import           Helper--import           System.IO-import           System.Directory-import           System.FilePath-import           Data.List (sort)+import           Test.Mockery.Directory  import           Test.Hspec.Discover.Run hiding (Spec) import qualified Test.Hspec.Discover.Run as Run -main :: IO ()-main = hspec spec--withTempFile :: (FilePath -> IO a) -> IO a-withTempFile action = do-  dir <- getTemporaryDirectory-  (file, h) <- openTempFile dir ""-  hClose h-  action file <* removeFile file-- spec :: Spec spec = do-  describe "run" $ do-    it "generates test driver" $ withTempFile $ \f -> do-      run ["test-data/nested-spec/Spec.hs", "", f]-      readFile f `shouldReturn` unlines [-          "{-# LINE 1 \"test-data/nested-spec/Spec.hs\" #-}"+  describe "run" $ around_ inTempDirectory $ do+    it "generates a test driver" $ do+      touch "test/FooSpec.hs"+      touch "test/Foo/Bar/BazSpec.hs"+      touch "test/Foo/BarSpec.hs"+      run ["test/Spec.hs", "", "out"]+      readFile "out" `shouldReturn` unlines [+          "{-# LINE 1 \"test/Spec.hs\" #-}"         , "{-# LANGUAGE NoImplicitPrelude #-}"         , "{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}"         , "module Main where"-        , "import qualified Foo.Bar.BazSpec"-        , "import qualified Foo.BarSpec"         , "import qualified FooSpec"+        , "import qualified Foo.BarSpec"+        , "import qualified Foo.Bar.BazSpec"         , "import Test.Hspec.Discover"         , "main :: IO ()"         , "main = hspec spec"         , "spec :: Spec"         , "spec = " ++ unwords [-               "describe \"Foo.Bar.Baz\" Foo.Bar.BazSpec.spec"+               "describe \"Foo\" FooSpec.spec"           , ">> describe \"Foo.Bar\" Foo.BarSpec.spec"-          , ">> describe \"Foo\" FooSpec.spec"+          , ">> describe \"Foo.Bar.Baz\" Foo.Bar.BazSpec.spec"           ]         ] -    it "generates test driver for an empty directory" $ withTempFile $ \f -> do-      run ["test-data/empty-dir/Spec.hs", "", f]-      readFile f `shouldReturn` unlines [-          "{-# LINE 1 \"test-data/empty-dir/Spec.hs\" #-}"+    it "generates a test driver with hooks" $ do+      touch "test/FooSpec.hs"+      touch "test/Foo/Bar/BazSpec.hs"+      touch "test/Foo/BarSpec.hs"+      touch "test/Foo/SpecHook.hs"+      touch "test/SpecHook.hs"+      run ["test/Spec.hs", "", "out"]+      readFile "out" `shouldReturn` unlines [+          "{-# LINE 1 \"test/Spec.hs\" #-}"         , "{-# LANGUAGE NoImplicitPrelude #-}"         , "{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}"         , "module Main where"+        , "import qualified SpecHook"+        , "import qualified FooSpec"+        , "import qualified Foo.SpecHook"+        , "import qualified Foo.BarSpec"+        , "import qualified Foo.Bar.BazSpec"         , "import Test.Hspec.Discover"         , "main :: IO ()"         , "main = hspec spec"         , "spec :: Spec"+        , "spec = " ++ unwords [+               "(SpecHook.hook $ describe \"Foo\" FooSpec.spec"+          , ">> (Foo.SpecHook.hook $ describe \"Foo.Bar\" Foo.BarSpec.spec"+          , ">> describe \"Foo.Bar.Baz\" Foo.Bar.BazSpec.spec))"+          ]+        ]++    it "generates a test driver for an empty directory" $ do+      touch "test/Foo/Bar/Baz/.placeholder"+      run ["test/Spec.hs", "", "out"]+      readFile "out" `shouldReturn` unlines [+          "{-# LINE 1 \"test/Spec.hs\" #-}"+        , "{-# LANGUAGE NoImplicitPrelude #-}"+        , "{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}"+        , "module Main where"+        , "import Test.Hspec.Discover"+        , "main :: IO ()"+        , "main = hspec spec"+        , "spec :: Spec"         , "spec = return ()"         ] @@ -63,47 +80,6 @@     it "derives module name from a given path" $ do       pathToModule "test/Spec.hs" `shouldBe` "Spec" -  describe "getFilesRecursive" $ do-    it "recursively returns all file entries of a given directory" $ do-      getFilesRecursive "test-data" `shouldReturn` sort [-          "empty-dir/Foo/Bar/Baz/.placeholder"-        , "nested-spec/Foo/Bar/BazSpec.hs"-        , "nested-spec/Foo/BarSpec.hs"-        , "nested-spec/FooSpec.hs"-        ]--  describe "fileToSpec" $ do-    it "converts path to spec name" $ do-      fileToSpec "FooSpec.hs" `shouldBe` Just (Run.Spec "Foo")--    it "rejects spec with empty name" $ do-      fileToSpec "Spec.hs" `shouldBe` Nothing--    it "works for lhs files" $ do-      fileToSpec "FooSpec.lhs" `shouldBe` Just (Run.Spec "Foo")--    it "returns Nothing for invalid spec name" $ do-      fileToSpec "foo" `shouldBe` Nothing--    context "when spec does not have a valid module name" $ do-      it "returns Nothing" $ do-        fileToSpec "flycheck_Spec.hs" `shouldBe` Nothing--    context "when any component of a hierarchical module name is not valid"$ do-      it "returns Nothing" $ do-        fileToSpec ("Valid" </> "invalid"  </>"MiddleNamesSpec.hs") `shouldBe` Nothing--    context "when path has directory component" $ do-      it "converts path to spec name" $ do-        fileToSpec ("Foo" </> "Bar" </> "BazSpec.hs") `shouldBe` Just (Run.Spec "Foo.Bar.Baz")--      it "rejects spec with empty name" $ do-        fileToSpec ("Foo" </> "Bar" </> "Spec.hs") `shouldBe` Nothing--  describe "findSpecs" $ do-    it "finds specs" $ do-      findSpecs ("test-data" </> "nested-spec" </> "Spec.hs") `shouldReturn` [Run.Spec "Foo.Bar.Baz", Run.Spec "Foo.Bar", Run.Spec "Foo"]-   describe "driverWithFormatter" $ do     it "generates a test driver that uses a custom formatter" $ do       driverWithFormatter "Some.Module.formatter" "" `shouldBe` unlines [@@ -118,7 +94,56 @@    describe "importList" $ do     it "generates imports for a list of specs" $ do-      importList [Run.Spec "Foo", Run.Spec "Bar"] "" `shouldBe` unlines [+      importList (Just [Run.Spec "Foo", Run.Spec "Bar"]) "" `shouldBe` unlines [           "import qualified FooSpec"         , "import qualified BarSpec"         ]++  describe "discover" $ do+    it "discovers spec files" $ do+      inTempDirectory $ do+        touch "test/Spec.hs"+        touch "test/FooSpec.hs"+        touch "test/BarSpec.hs"+        discover "test/Spec.hs" `shouldReturn` Just (Forest WithoutHook [Leaf "Bar", Leaf "Foo"])++    it "discovers nested spec files" $ do+      inTempDirectory $ do+        touch "test/Spec.hs"+        touch "test/Foo/BarSpec.hs"+        touch "test/Foo/BazSpec.hs"+        discover "test/Spec.hs" `shouldReturn` Just (Forest WithoutHook [Node "Foo" (Forest WithoutHook [Leaf "Bar", Leaf "Baz"])])++    it "discovers hooks" $ do+      inTempDirectory $ do+        touch "test/Spec.hs"+        touch "test/FooSpec.hs"+        touch "test/BarSpec.hs"+        touch "test/SpecHook.hs"+        discover "test/Spec.hs" `shouldReturn` Just (Forest WithHook [Leaf "Bar", Leaf "Foo"])++    it "discovers nested hooks" $ do+      inTempDirectory $ do+        touch "test/Spec.hs"+        touch "test/Foo/BarSpec.hs"+        touch "test/Foo/BazSpec.hs"+        touch "test/Foo/SpecHook.hs"+        discover "test/Spec.hs" `shouldReturn` Just (Forest WithoutHook [Node "Foo" (Forest WithHook [Leaf "Bar", Leaf "Baz"])])++    it "ignores invalid module names" $ do+      inTempDirectory $ do+        touch "test/Spec.hs"+        touch "test/barSpec.hs"+        discover "test/Spec.hs" `shouldReturn` Nothing++    it "ignores empty directories" $ do+      inTempDirectory $ do+        touch "test/Spec.hs"+        touch "test/Foo/.keep"+        discover "test/Spec.hs" `shouldReturn` Nothing++    it "ignores directories with extension" $ do+      inTempDirectory $ do+        touch "test/Spec.hs"+        touch "test/Foo.hs/BarSpec.hs"+        discover "test/Spec.hs" `shouldReturn` Nothing

@@ -1,15 +1,15 @@-module Test.Hspec.Discover.SortSpec (main, spec) where+module Test.Hspec.Discover.SortSpec (spec) where  import           Helper import           Test.QuickCheck  import           Test.Hspec.Discover.Sort -main :: IO ()-main = hspec spec- shuffleAndSort :: [String] -> IO [String] shuffleAndSort xs = sortNaturally <$> generate (shuffle xs)++sortNaturally :: [String] -> [String]+sortNaturally = sortNaturallyBy $ \ name -> (name, 0)  spec :: Spec spec = do

@@ -1,1 +1,1 @@-&version 2.8.2+&version 2.8.3