packages feed

hspec-discover 2.2.2 → 2.2.3

raw patch · 9 files changed

+241/−227 lines, 9 filesdep +hspec-discover

Dependencies added: hspec-discover

Files

+ driver/hspec-discover.hs view
@@ -0,0 +1,8 @@+module Main (main) where++import           System.Environment++import           Test.Hspec.Discover.Run (run)++main :: IO ()+main = getArgs >>= run
hspec-discover.cabal view
@@ -1,5 +1,9 @@+-- This file has been generated from package.yaml by hpack version 0.11.2.+--+-- see: https://github.com/sol/hpack+ name:             hspec-discover-version:          2.2.2+version:          2.2.3 license:          MIT license-file:     LICENSE copyright:        (c) 2012-2015 Simon Hengel@@ -17,10 +21,10 @@                   <http://hspec.github.io/hspec-discover.html>  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+    test-data/empty-dir/Foo/Bar/Baz/.placeholder+    test-data/nested-spec/Foo/Bar/BazSpec.hs+    test-data/nested-spec/Foo/BarSpec.hs+    test-data/nested-spec/FooSpec.hs  source-repository head   type: git@@ -28,41 +32,45 @@   subdir: hspec-discover  library+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      base == 4.*+    , filepath+    , directory+  exposed: False+  exposed-modules:+      Test.Hspec.Discover.Config+      Test.Hspec.Discover.Run   default-language: Haskell2010  executable hspec-discover-  ghc-options:-      -Wall+  ghc-options: -Wall   hs-source-dirs:-      src-  main-is:-      Main.hs-  other-modules:-      Run-      Config+      driver+  main-is: hspec-discover.hs   build-depends:       base == 4.*     , filepath     , directory+    , hspec-discover   default-language: Haskell2010  test-suite spec-  type:-      exitcode-stdio-1.0-  ghc-options:-      -Wall+  type: exitcode-stdio-1.0+  ghc-options: -Wall   hs-source-dirs:-      src-    , test-  main-is:-      Spec.hs+      test+  main-is: Spec.hs   other-modules:+      ConfigSpec       Helper       RunSpec-      ConfigSpec   build-depends:       base == 4.*     , filepath     , directory+    , hspec-discover     , hspec-meta >= 2.2.0   default-language: Haskell2010
− src/Config.hs 
@@ -1,45 +0,0 @@-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=<fmt>' 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)
− src/Main.hs 
@@ -1,8 +0,0 @@-module Main (main) where--import           System.Environment--import           Run (run)--main :: IO ()-main = getArgs >>= run
− src/Run.hs 
@@ -1,148 +0,0 @@-{-# 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)
+ src/Test/Hspec/Discover/Config.hs view
@@ -0,0 +1,48 @@+-- |+-- /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=<fmt>' 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)
+ src/Test/Hspec/Discover/Run.hs view
@@ -0,0 +1,151 @@+{-# 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++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)
test/ConfigSpec.hs view
@@ -2,7 +2,7 @@  import           Helper -import           Config+import           Test.Hspec.Discover.Config  main :: IO () main = hspec spec
test/RunSpec.hs view
@@ -7,8 +7,8 @@ import           System.FilePath import           Data.List (sort) -import           Run hiding (Spec)-import qualified Run+import           Test.Hspec.Discover.Run hiding (Spec)+import qualified Test.Hspec.Discover.Run  main :: IO () main = hspec spec@@ -123,4 +123,4 @@         , "import qualified BarSpec"         ]   where-    spec_ = Run.Spec+    spec_ = Test.Hspec.Discover.Run.Spec