hspec-discover-2.6.1/0000755000000000000000000000000013412542125012623 5ustar0000000000000000hspec-discover-2.6.1/LICENSE0000644000000000000000000000206713412542125013635 0ustar0000000000000000Copyright (c) 2012-2019 Simon Hengel 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. hspec-discover-2.6.1/hspec-discover.cabal0000644000000000000000000000430313412542125016525 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.31.0. -- -- see: https://github.com/sol/hpack -- -- hash: 8f20d8b51d95422ff37876690426d21d0dfcfe7c1ef51bd57c859252ea39c817 name: hspec-discover version: 2.6.1 license: MIT license-file: LICENSE copyright: (c) 2012-2019 Simon Hengel author: Simon Hengel maintainer: Simon Hengel build-type: Simple category: Testing stability: experimental bug-reports: https://github.com/hspec/hspec/issues homepage: http://hspec.github.io/ synopsis: Automatically discover and run Hspec tests description: Automatically discover and run Hspec tests . extra-source-files: 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 location: https://github.com/hspec/hspec subdir: hspec-discover library hs-source-dirs: src ghc-options: -Wall build-depends: base ==4.* , directory , filepath exposed: False exposed-modules: Test.Hspec.Discover.Config Test.Hspec.Discover.Run Test.Hspec.Discover.Sort other-modules: Paths_hspec_discover default-language: Haskell2010 executable hspec-discover ghc-options: -Wall hs-source-dirs: driver main-is: hspec-discover.hs build-depends: base ==4.* , directory , filepath , hspec-discover other-modules: Paths_hspec_discover default-language: Haskell2010 test-suite spec type: exitcode-stdio-1.0 ghc-options: -Wall hs-source-dirs: test main-is: Spec.hs other-modules: Helper Test.Hspec.Discover.ConfigSpec Test.Hspec.Discover.RunSpec Test.Hspec.Discover.SortSpec Paths_hspec_discover build-depends: QuickCheck >=2.7 , base ==4.* , directory , filepath , hspec-discover , hspec-meta >=2.3.2 build-tool-depends: hspec-meta:hspec-meta-discover default-language: Haskell2010 hspec-discover-2.6.1/Setup.lhs0000644000000000000000000000011413412542125014427 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain hspec-discover-2.6.1/test/0000755000000000000000000000000013412542125013602 5ustar0000000000000000hspec-discover-2.6.1/test/Spec.hs0000644000000000000000000000006113412542125015025 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-meta-discover #-} hspec-discover-2.6.1/test/Helper.hs0000644000000000000000000000022513412542125015354 0ustar0000000000000000module Helper ( module Test.Hspec.Meta , module Control.Applicative ) where import Test.Hspec.Meta import Control.Applicative hspec-discover-2.6.1/test/Test/0000755000000000000000000000000013412542125014521 5ustar0000000000000000hspec-discover-2.6.1/test/Test/Hspec/0000755000000000000000000000000013412542125015563 5ustar0000000000000000hspec-discover-2.6.1/test/Test/Hspec/Discover/0000755000000000000000000000000013412542125017341 5ustar0000000000000000hspec-discover-2.6.1/test/Test/Hspec/Discover/ConfigSpec.hs0000644000000000000000000000327413412542125021723 0ustar0000000000000000module Test.Hspec.Discover.ConfigSpec (main, spec) where import Helper import Test.Hspec.Discover.Config main :: IO () main = hspec spec spec :: Spec spec = do describe "parseConfig" $ do let parse = parseConfig "hspec-discover" it "recognizes --nested" $ do parse ["--nested"] `shouldBe` Right (defaultConfig {configNested = True}) it "recognizes --formatter" $ do parse ["--formatter", "someFormatter"] `shouldBe` Right (defaultConfig {configFormatter = Just "someFormatter"}) it "recognizes --no-main" $ do parse ["--no-main"] `shouldBe` Right (defaultConfig {configNoMain = True}) it "returns error message on unrecognized option" $ do parse ["--foo"] `shouldBe` (Left . unlines) [ "hspec-discover: unrecognized option `--foo'" , "" , "Usage: hspec-discover SRC CUR DST [--module-name=NAME]" ] it "returns error message on unexpected argument" $ do parse ["foo"] `shouldBe` (Left . unlines) [ "hspec-discover: unexpected argument `foo'" , "" , "Usage: hspec-discover SRC CUR DST [--module-name=NAME]" ] it "returns error message on --formatter= with --no-main" $ do parse ["--no-main", "--formatter=foo"] `shouldBe` (Left . unlines) [ "hspec-discover: option `--formatter=' does not make sense with `--no-main'" , "" , "Usage: hspec-discover SRC CUR DST [--module-name=NAME]" ] context "when option is given multiple times" $ do it "gives the last occurrence precedence" $ do parse ["--formatter", "foo", "--formatter", "bar"] `shouldBe` Right (defaultConfig {configFormatter = Just "bar"}) hspec-discover-2.6.1/test/Test/Hspec/Discover/SortSpec.hs0000644000000000000000000000420713412542125021442 0ustar0000000000000000module Test.Hspec.Discover.SortSpec (main, 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) spec :: Spec spec = do describe "naturalSortKey" $ do it "is injective" $ property $ \ a b -> do a /= b ==> naturalSortKey a /= naturalSortKey b describe "sortNaturally" $ do it "gives shorter strings precedence" $ do let expected = [ "" , "a" , "aa" ] shuffleAndSort expected `shouldReturn` expected it "gives numbers precedence" $ do let expected = [ "Hello2World" , "Hello World" ] shuffleAndSort expected `shouldReturn` expected it "sorts numbers in ascending order" $ do let expected = [ "Spec9.hs" , "Spec10.hs" ] shuffleAndSort expected `shouldReturn` expected it "breaks numeric ties by string length" $ do let expected = [ "Hello 2 World" , "Hello 02 World" ] shuffleAndSort expected `shouldReturn` expected it "given upper-case letters precedence over lower-case letters" $ do let expected = [ "AA.hs" , "Aa.hs" , "aA.hs" , "aa.hs" , "B.hs" , "b.hs" ] shuffleAndSort expected `shouldReturn` expected it "sorts number separated strings" $ do let expected = [ "Hello2World9" , "Hello2World!0" ] shuffleAndSort expected `shouldReturn` expected it "sorts string separated numbers" $ do let expected = [ "3.1.415" , "3.14.15" ] shuffleAndSort expected `shouldReturn` expected it "groups common string prefixes together" $ do let expected = [ "SpecFoo.hs" , "SpecFoo.lhs" , "Specfoo.hs" , "Specfoo.lhs" ] shuffleAndSort expected `shouldReturn` expected hspec-discover-2.6.1/test/Test/Hspec/Discover/RunSpec.hs0000644000000000000000000001113713412542125021257 0ustar0000000000000000module Test.Hspec.Discover.RunSpec (main, spec) where import Helper import System.IO import System.Directory import System.FilePath import Data.List (sort) import Test.Hspec.Discover.Run hiding (Spec) import qualified Test.Hspec.Discover.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\" #-}" , "{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}" , "module Main where" , "import qualified Foo.Bar.BazSpec" , "import qualified Foo.BarSpec" , "import qualified FooSpec" , "import Test.Hspec.Discover" , "main :: IO ()" , "main = hspec spec" , "spec :: Spec" , "spec = " ++ unwords [ "postProcessSpec \"test-data/nested-spec/Foo/Bar/BazSpec.hs\" (describe \"Foo.Bar.Baz\" Foo.Bar.BazSpec.spec)" , ">> postProcessSpec \"test-data/nested-spec/Foo/BarSpec.hs\" (describe \"Foo.Bar\" Foo.BarSpec.spec)" , ">> postProcessSpec \"test-data/nested-spec/FooSpec.hs\" (describe \"Foo\" FooSpec.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\" #-}" , "{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}" , "module Main where" , "import Test.Hspec.Discover" , "main :: IO ()" , "main = hspec spec" , "spec :: Spec" , "spec = return ()" ] describe "pathToModule" $ do 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 (spec_ "FooSpec.hs" "Foo") it "rejects spec with empty name" $ do fileToSpec "" "Spec.hs" `shouldBe` Nothing it "works for lhs files" $ do fileToSpec "" "FooSpec.lhs" `shouldBe` Just (spec_ "FooSpec.lhs" "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 let file = "Foo" "Bar" "BazSpec.hs" fileToSpec "" file `shouldBe` Just (spec_ file "Foo.Bar.Baz") it "rejects spec with empty name" $ do fileToSpec "" ("Foo" "Bar" "Spec.hs") `shouldBe` Nothing describe "findSpecs" $ do it "finds specs" $ do let dir = "test-data/nested-spec" findSpecs (dir "Spec.hs") `shouldReturn` [spec_ (dir "Foo/Bar/BazSpec.hs") "Foo.Bar.Baz", spec_ (dir "Foo/BarSpec.hs") "Foo.Bar", spec_ (dir "FooSpec.hs") "Foo"] describe "driverWithFormatter" $ do it "generates a test driver that uses a custom formatter" $ do driverWithFormatter "Some.Module.formatter" "" `shouldBe` unlines [ "import qualified Some.Module" , "main :: IO ()" , "main = hspecWithFormatter Some.Module.formatter spec" ] describe "moduleNameFromId" $ do it "returns the module name of a fully qualified identifier" $ do moduleNameFromId "Some.Module.someId" `shouldBe` "Some.Module" describe "importList" $ do it "generates imports for a list of specs" $ do importList [spec_ "FooSpec.hs" "Foo", spec_ "BarSpec.hs" "Bar"] "" `shouldBe` unlines [ "import qualified FooSpec" , "import qualified BarSpec" ] where spec_ = Test.Hspec.Discover.Run.Spec hspec-discover-2.6.1/test-data/0000755000000000000000000000000013412542125014511 5ustar0000000000000000hspec-discover-2.6.1/test-data/nested-spec/0000755000000000000000000000000013412542125016723 5ustar0000000000000000hspec-discover-2.6.1/test-data/nested-spec/FooSpec.hs0000644000000000000000000000000013412542125020603 0ustar0000000000000000hspec-discover-2.6.1/test-data/nested-spec/Foo/0000755000000000000000000000000013412542125017446 5ustar0000000000000000hspec-discover-2.6.1/test-data/nested-spec/Foo/BarSpec.hs0000644000000000000000000000000013412542125021307 0ustar0000000000000000hspec-discover-2.6.1/test-data/nested-spec/Foo/Bar/0000755000000000000000000000000013412542125020152 5ustar0000000000000000hspec-discover-2.6.1/test-data/nested-spec/Foo/Bar/BazSpec.hs0000644000000000000000000000000013412542125022023 0ustar0000000000000000hspec-discover-2.6.1/test-data/empty-dir/0000755000000000000000000000000013412542125016423 5ustar0000000000000000hspec-discover-2.6.1/test-data/empty-dir/Foo/0000755000000000000000000000000013412542125017146 5ustar0000000000000000hspec-discover-2.6.1/test-data/empty-dir/Foo/Bar/0000755000000000000000000000000013412542125017652 5ustar0000000000000000hspec-discover-2.6.1/test-data/empty-dir/Foo/Bar/Baz/0000755000000000000000000000000013412542125020366 5ustar0000000000000000hspec-discover-2.6.1/test-data/empty-dir/Foo/Bar/Baz/.placeholder0000644000000000000000000000000013412542125022637 0ustar0000000000000000hspec-discover-2.6.1/driver/0000755000000000000000000000000013412542125014116 5ustar0000000000000000hspec-discover-2.6.1/driver/hspec-discover.hs0000644000000000000000000000022413412542125017366 0ustar0000000000000000module Main (main) where import System.Environment import Test.Hspec.Discover.Run (run) main :: IO () main = getArgs >>= run hspec-discover-2.6.1/src/0000755000000000000000000000000013412542125013412 5ustar0000000000000000hspec-discover-2.6.1/src/Test/0000755000000000000000000000000013412542125014331 5ustar0000000000000000hspec-discover-2.6.1/src/Test/Hspec/0000755000000000000000000000000013412542125015373 5ustar0000000000000000hspec-discover-2.6.1/src/Test/Hspec/Discover/0000755000000000000000000000000013412542125017151 5ustar0000000000000000hspec-discover-2.6.1/src/Test/Hspec/Discover/Run.hs0000644000000000000000000001212413412542125020251 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | A preprocessor that finds and combines specs. -- -- /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.Run ( run -- exported for testing , Spec(..) , importList , fileToSpec , findSpecs , getFilesRecursive , driverWithFormatter , moduleNameFromId , pathToModule ) where import Control.Monad import Control.Applicative import Data.List import Data.Char import Data.Maybe import Data.String import System.Environment import System.Exit import System.IO import System.Directory (doesDirectoryExist, getDirectoryContents, doesFileExist) import System.FilePath hiding (combine) import Test.Hspec.Discover.Config import Test.Hspec.Discover.Sort instance IsString ShowS where fromString = showString data Spec = Spec { specFile :: FilePath , specModule :: String } deriving (Eq, Show) run :: [String] -> IO () run args_ = do name <- getProgName case args_ of src : _ : dst : args -> case parseConfig name args of Left err -> do hPutStrLn stderr err exitFailure Right conf -> do when (configNested conf) (hPutStrLn stderr "hspec-discover: WARNING - The `--nested' option is deprecated and will be removed in a future release!") specs <- findSpecs src writeFile dst (mkSpecModule src conf specs) _ -> do hPutStrLn stderr (usage name) exitFailure mkSpecModule :: FilePath -> Config -> [Spec] -> String mkSpecModule src conf nodes = ( "{-# LINE 1 " . shows src . " #-}\n" . showString "{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}\n" . showString ("module " ++ moduleName src conf ++" where\n") . importList nodes . showString "import Test.Hspec.Discover\n" . maybe driver driverWithFormatter (configFormatter conf) . showString "spec :: Spec\n" . showString "spec = " . formatSpecs nodes ) "\n" where driver = case configNoMain conf of False -> showString "main :: IO ()\n" . showString "main = hspec spec\n" True -> "" moduleName :: FilePath -> Config -> String moduleName src conf = fromMaybe (if configNoMain conf then pathToModule src else "Main") (configModuleName conf) -- | Derive module name from specified path. pathToModule :: FilePath -> String pathToModule f = toUpper m:ms where fileName = last $ splitDirectories f m:ms = takeWhile (/='.') fileName driverWithFormatter :: String -> ShowS driverWithFormatter f = showString "import qualified " . showString (moduleNameFromId f) . showString "\n" . showString "main :: IO ()\n" . showString "main = hspecWithFormatter " . showString f . showString " spec\n" -- | Return module name of a fully qualified identifier. moduleNameFromId :: String -> String moduleNameFromId = reverse . dropWhile (== '.') . dropWhile (/= '.') . reverse -- | Generate imports for a list of specs. importList :: [Spec] -> ShowS importList = foldr (.) "" . map f where f :: Spec -> ShowS f spec = "import qualified " . showString (specModule spec) . "Spec\n" -- | 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) -- | Convert a spec to code. formatSpec :: Spec -> ShowS formatSpec (Spec file name) = "postProcessSpec " . shows file . " (describe " . shows name . " " . showString name . "Spec.spec)" findSpecs :: FilePath -> IO [Spec] findSpecs src = do let (dir, file) = splitFileName src mapMaybe (fileToSpec dir) . filter (/= file) <$> getFilesRecursive dir fileToSpec :: FilePath -> FilePath -> Maybe Spec fileToSpec dir 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 (dir file) $ (intercalate "." . reverse) (name : xs) _ -> Nothing _ -> Nothing where stripSuffix :: Eq a => [a] -> [a] -> Maybe [a] stripSuffix suffix str = reverse <$> stripPrefix (reverse suffix) (reverse str) -- See `Cabal.Distribution.ModuleName` (http://git.io/bj34) isValidModuleName :: String -> Bool isValidModuleName [] = False isValidModuleName (c:cs) = isUpper c && all isValidModuleChar cs isValidModuleChar :: Char -> Bool isValidModuleChar c = isAlphaNum c || c == '_' || c == '\'' getFilesRecursive :: FilePath -> IO [FilePath] getFilesRecursive baseDir = sortNaturally <$> 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) hspec-discover-2.6.1/src/Test/Hspec/Discover/Sort.hs0000644000000000000000000000145213412542125020436 0ustar0000000000000000module Test.Hspec.Discover.Sort ( sortNaturally , NaturalSortKey , naturalSortKey ) where import Control.Arrow import Data.Char import Data.List import Data.Ord sortNaturally :: [String] -> [String] sortNaturally = sortBy (comparing naturalSortKey) data NaturalSortKey = NaturalSortKey [Chunk] deriving (Eq, Ord) data Chunk = Numeric Integer Int | Textual [(Char, Char)] deriving (Eq, Ord) naturalSortKey :: String -> NaturalSortKey naturalSortKey = NaturalSortKey . chunks where chunks [] = [] chunks s@(c:_) | isDigit c = Numeric (read num) (length num) : chunks afterNum | otherwise = Textual (map (toLower &&& id) str) : chunks afterStr where (num, afterNum) = span isDigit s (str, afterStr) = break isDigit s hspec-discover-2.6.1/src/Test/Hspec/Discover/Config.hs0000644000000000000000000000311713412542125020714 0ustar0000000000000000-- | -- /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.Config ( Config (..) , defaultConfig , parseConfig , usage ) where import Data.Maybe import System.Console.GetOpt data Config = Config { configNested :: Bool , configFormatter :: Maybe String , configNoMain :: Bool , configModuleName :: Maybe String } deriving (Eq, Show) defaultConfig :: Config defaultConfig = Config False Nothing False Nothing options :: [OptDescr (Config -> Config)] options = [ Option [] ["nested"] (NoArg $ \c -> c {configNested = True}) "" , Option [] ["formatter"] (ReqArg (\s c -> c {configFormatter = Just s}) "FORMATTER") "" , Option [] ["module-name"] (ReqArg (\s c -> c {configModuleName = Just s}) "NAME") "" , Option [] ["no-main"] (NoArg $ \c -> c {configNoMain = True}) "" ] usage :: String -> String usage prog = "\nUsage: " ++ prog ++ " SRC CUR DST [--module-name=NAME]\n" parseConfig :: String -> [String] -> Either String Config parseConfig prog args = case getOpt Permute options args of (opts, [], []) -> let c = (foldl (flip id) defaultConfig opts) in if (configNoMain c && isJust (configFormatter c)) then formatError "option `--formatter=' does not make sense with `--no-main'\n" else Right c (_, _, err:_) -> formatError err (_, arg:_, _) -> formatError ("unexpected argument `" ++ arg ++ "'\n") where formatError err = Left (prog ++ ": " ++ err ++ usage prog)