diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,6 @@ -Copyright (c) 2012 Simon Hengel +Copyright (c) 2011-2014 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 diff --git a/hspec-discover.cabal b/hspec-discover.cabal --- a/hspec-discover.cabal +++ b/hspec-discover.cabal @@ -1,16 +1,67 @@ name: hspec-discover -version: 0.2.0 +version: 2.0.0 license: MIT license-file: LICENSE -copyright: (c) 2012-2013 Simon Hengel +copyright: (c) 2012-2014 Simon Hengel author: Simon Hengel maintainer: Simon Hengel build-type: Simple -cabal-version: >= 1.8 +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: This has been integrated into hspec. There is no need to use - this package anymore! +description: Automatically discover and run Hspec tests + . + +-- find test-data/ -type f + 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 - build-depends: hspec >= 1.3 + 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: + RunSpec + ConfigSpec + build-depends: + base == 4.* + , filepath + , directory + , hspec-meta >= 1.12 + default-language: Haskell2010 diff --git a/src/Config.hs b/src/Config.hs new file mode 100644 --- /dev/null +++ b/src/Config.hs @@ -0,0 +1,45 @@ +module 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) diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,8 @@ +module Main (main) where + +import System.Environment + +import Run (run) + +main :: IO () +main = getArgs >>= run diff --git a/src/Run.hs b/src/Run.hs new file mode 100644 --- /dev/null +++ b/src/Run.hs @@ -0,0 +1,139 @@ +{-# 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 | (not . null) name -> 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) + +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) diff --git a/test/ConfigSpec.hs b/test/ConfigSpec.hs new file mode 100644 --- /dev/null +++ b/test/ConfigSpec.hs @@ -0,0 +1,47 @@ +module ConfigSpec (main, spec) where + +import Test.Hspec.Meta + +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"}) diff --git a/test/RunSpec.hs b/test/RunSpec.hs new file mode 100644 --- /dev/null +++ b/test/RunSpec.hs @@ -0,0 +1,119 @@ +module RunSpec (main, spec) where + +import Test.Hspec.Meta + +import Control.Applicative +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 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 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-meta-discover #-}