hspec-discover-2.2.1/0000755000000000000000000000000012627366241012631 5ustar0000000000000000hspec-discover-2.2.1/LICENSE0000644000000000000000000000226112627366241013637 0ustar0000000000000000Copyright (c) 2011-2015 Simon Hengel Copyright (c) 2011-2012 Trystan Spangler Copyright (c) 2011-2011 Greg Weber 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.2.1/hspec-discover.cabal0000644000000000000000000000303012627366241016527 0ustar0000000000000000name: hspec-discover version: 2.2.1 license: MIT license-file: LICENSE copyright: (c) 2012-2015 Simon Hengel author: Simon Hengel maintainer: Simon Hengel build-type: Simple cabal-version: >= 1.10 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/FooSpec.hs test-data/nested-spec/Foo/Bar/BazSpec.hs test-data/nested-spec/Foo/BarSpec.hs test-data/empty-dir/Foo/Bar/Baz/.placeholder source-repository head type: git location: https://github.com/hspec/hspec subdir: hspec-discover library default-language: Haskell2010 executable hspec-discover ghc-options: -Wall hs-source-dirs: src main-is: Main.hs other-modules: Run Config build-depends: base == 4.* , filepath , directory default-language: Haskell2010 test-suite spec type: exitcode-stdio-1.0 ghc-options: -Wall hs-source-dirs: src , test main-is: Spec.hs other-modules: Helper RunSpec ConfigSpec build-depends: base == 4.* , filepath , directory , hspec-meta >= 2.2.0 default-language: Haskell2010 hspec-discover-2.2.1/Setup.lhs0000644000000000000000000000011412627366241014435 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain hspec-discover-2.2.1/test-data/0000755000000000000000000000000012627366241014517 5ustar0000000000000000hspec-discover-2.2.1/test-data/empty-dir/0000755000000000000000000000000012627366241016431 5ustar0000000000000000hspec-discover-2.2.1/test-data/empty-dir/Foo/0000755000000000000000000000000012627366241017154 5ustar0000000000000000hspec-discover-2.2.1/test-data/empty-dir/Foo/Bar/0000755000000000000000000000000012627366241017660 5ustar0000000000000000hspec-discover-2.2.1/test-data/empty-dir/Foo/Bar/Baz/0000755000000000000000000000000012627366241020374 5ustar0000000000000000hspec-discover-2.2.1/test-data/empty-dir/Foo/Bar/Baz/.placeholder0000644000000000000000000000000012627366241022645 0ustar0000000000000000hspec-discover-2.2.1/test-data/nested-spec/0000755000000000000000000000000012627366241016731 5ustar0000000000000000hspec-discover-2.2.1/test-data/nested-spec/FooSpec.hs0000644000000000000000000000000012627366241020611 0ustar0000000000000000hspec-discover-2.2.1/test-data/nested-spec/Foo/0000755000000000000000000000000012627366241017454 5ustar0000000000000000hspec-discover-2.2.1/test-data/nested-spec/Foo/BarSpec.hs0000644000000000000000000000000012627366241021315 0ustar0000000000000000hspec-discover-2.2.1/test-data/nested-spec/Foo/Bar/0000755000000000000000000000000012627366241020160 5ustar0000000000000000hspec-discover-2.2.1/test-data/nested-spec/Foo/Bar/BazSpec.hs0000644000000000000000000000000012627366241022031 0ustar0000000000000000hspec-discover-2.2.1/test/0000755000000000000000000000000012627366241013610 5ustar0000000000000000hspec-discover-2.2.1/test/Helper.hs0000644000000000000000000000022512627366241015362 0ustar0000000000000000module Helper ( module Test.Hspec.Meta , module Control.Applicative ) where import Test.Hspec.Meta import Control.Applicative hspec-discover-2.2.1/test/Spec.hs0000644000000000000000000000006112627366241015033 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-meta-discover #-} hspec-discover-2.2.1/test/ConfigSpec.hs0000644000000000000000000000322412627366241016165 0ustar0000000000000000module ConfigSpec (main, spec) where import Helper import 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.2.1/test/RunSpec.hs0000644000000000000000000001101712627366241015523 0ustar0000000000000000module RunSpec (main, spec) where import Helper import System.IO import System.Directory import System.FilePath import Data.List (sort) import Run hiding (Spec) import qualified 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_ = Run.Spec hspec-discover-2.2.1/src/0000755000000000000000000000000012627366241013420 5ustar0000000000000000hspec-discover-2.2.1/src/Run.hs0000644000000000000000000001155012627366241014522 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | A preprocessor that finds and combines specs. module 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 Config 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' flag 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 = 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) hspec-discover-2.2.1/src/Main.hs0000644000000000000000000000020012627366241014630 0ustar0000000000000000module Main (main) where import System.Environment import Run (run) main :: IO () main = getArgs >>= run hspec-discover-2.2.1/src/Config.hs0000644000000000000000000000265312627366241015167 0ustar0000000000000000module 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)