Hello community, here is the log from the commit of package ghc-hspec-meta for openSUSE:Factory checked in at 2017-03-28 15:21:44 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-hspec-meta (Old) and /work/SRC/openSUSE:Factory/.ghc-hspec-meta.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-hspec-meta" Tue Mar 28 15:21:44 2017 rev:2 rq:479846 version:2.3.2 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-hspec-meta/ghc-hspec-meta.changes 2017-03-09 01:53:46.305011565 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-hspec-meta.new/ghc-hspec-meta.changes 2017-03-28 15:21:48.577072025 +0200 @@ -1,0 +2,5 @@ +Sun Feb 12 14:20:10 UTC 2017 - psimons@suse.com + +- Update to version 2.3.2 with cabal2obs. + +------------------------------------------------------------------- Old: ---- hspec-meta-2.2.1.tar.gz New: ---- hspec-meta-2.3.2.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-hspec-meta.spec ++++++ --- /var/tmp/diff_new_pack.h3XssA/_old 2017-03-28 15:21:50.316825628 +0200 +++ /var/tmp/diff_new_pack.h3XssA/_new 2017-03-28 15:21:50.316825628 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-hspec-meta # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -18,7 +18,7 @@ %global pkg_name hspec-meta Name: ghc-%{pkg_name} -Version: 2.2.1 +Version: 2.3.2 Release: 0 Summary: A version of Hspec which is used to test Hspec itself License: MIT @@ -30,6 +30,7 @@ BuildRequires: ghc-QuickCheck-devel BuildRequires: ghc-ansi-terminal-devel BuildRequires: ghc-async-devel +BuildRequires: ghc-call-stack-devel BuildRequires: ghc-deepseq-devel BuildRequires: ghc-directory-devel BuildRequires: ghc-filepath-devel ++++++ hspec-meta-2.2.1.tar.gz -> hspec-meta-2.3.2.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-meta-2.2.1/hspec-core/src/Test/Hspec/Compat.hs new/hspec-meta-2.3.2/hspec-core/src/Test/Hspec/Compat.hs --- old/hspec-meta-2.2.1/hspec-core/src/Test/Hspec/Compat.hs 2016-01-17 06:46:43.000000000 +0100 +++ new/hspec-meta-2.3.2/hspec-core/src/Test/Hspec/Compat.hs 2016-10-16 07:16:55.000000000 +0200 @@ -46,32 +46,17 @@ , sum ) -#if !MIN_VERSION_base(4,3,0) -import Control.Monad.Trans.Error () -- for Monad (Either e) -#endif - import Data.Typeable (Typeable, typeOf, typeRepTyCon) import Text.Read import Data.IORef import System.Environment -#if MIN_VERSION_base(4,4,0) import Data.Typeable.Internal (tyConModule, tyConName) import Control.Concurrent -#endif #if !MIN_VERSION_base(4,6,0) import qualified Text.ParserCombinators.ReadP as P -#endif - -getDefaultConcurrentJobs :: IO Int -#if MIN_VERSION_base(4,4,0) -getDefaultConcurrentJobs = getNumCapabilities -#else -getDefaultConcurrentJobs = return 1 -#endif -#if !MIN_VERSION_base(4,6,0) -- |Strict version of 'modifyIORef' modifyIORef' :: IORef a -> (a -> a) -> IO () modifyIORef' ref f = do @@ -111,17 +96,11 @@ showType :: Typeable a => a -> String showType a = let t = typeRepTyCon (typeOf a) in -#if MIN_VERSION_base(4,4,0) show t -#else - (reverse . takeWhile (/= '.') . reverse . show) t -#endif - showFullType :: Typeable a => a -> String showFullType a = let t = typeRepTyCon (typeOf a) in -#if MIN_VERSION_base(4,4,0) tyConModule t ++ "." ++ tyConName t -#else - show t -#endif + +getDefaultConcurrentJobs :: IO Int +getDefaultConcurrentJobs = getNumCapabilities diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-meta-2.2.1/hspec-core/src/Test/Hspec/Core/Example.hs new/hspec-meta-2.3.2/hspec-core/src/Test/Hspec/Core/Example.hs --- old/hspec-meta-2.2.1/hspec-core/src/Test/Hspec/Core/Example.hs 2016-01-17 06:46:43.000000000 +0100 +++ new/hspec-meta-2.3.2/hspec-core/src/Test/Hspec/Core/Example.hs 2016-10-16 07:16:55.000000000 +0200 @@ -14,6 +14,11 @@ import Data.Maybe (fromMaybe) import Data.List (isPrefixOf) import qualified Test.HUnit.Lang as HUnit + +#if MIN_VERSION_HUnit(1,4,0) +import Data.CallStack +#endif + import qualified Control.Exception as E import Data.Typeable (Typeable) import qualified Test.QuickCheck as QC @@ -85,11 +90,20 @@ hunitFailureToResult :: HUnit.HUnitFailure -> Result hunitFailureToResult e = case e of #if MIN_VERSION_HUnit(1,3,0) - HUnit.HUnitFailure loc err -> Fail location err + HUnit.HUnitFailure mLoc err -> +#if MIN_VERSION_HUnit(1,5,0) + Fail location (HUnit.formatFailureReason err) +#else + Fail location err +#endif where - location = case loc of + location = case mLoc of Nothing -> Nothing - Just (HUnit.Location f l c) -> Just $ Location f l c ExactLocation +#if MIN_VERSION_HUnit(1,4,0) + Just loc -> Just $ Location (srcLocFile loc) (srcLocStartLine loc) (srcLocStartCol loc) ExactLocation +#else + Just loc -> Just $ Location (HUnit.locationFile loc) (HUnit.locationLine loc) (HUnit.locationColumn loc) ExactLocation +#endif #else HUnit.HUnitFailure err -> Fail Nothing err #endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-meta-2.2.1/hspec-core/src/Test/Hspec/Core/Spec.hs new/hspec-meta-2.3.2/hspec-core/src/Test/Hspec/Core/Spec.hs --- old/hspec-meta-2.2.1/hspec-core/src/Test/Hspec/Core/Spec.hs 2016-01-17 06:46:43.000000000 +0100 +++ new/hspec-meta-2.3.2/hspec-core/src/Test/Hspec/Core/Spec.hs 2016-10-16 07:16:55.000000000 +0200 @@ -1,8 +1,5 @@ -{-# LANGUAGE CPP #-} -#if MIN_VERSION_base(4,8,1) -#define HAS_SOURCE_LOCATIONS -{-# LANGUAGE ImplicitParams #-} -#endif +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ConstraintKinds #-} -- | -- Stability: unstable -- @@ -27,11 +24,8 @@ , module Test.Hspec.Core.Tree ) where -#ifdef HAS_SOURCE_LOCATIONS -import GHC.Stack -#endif - import qualified Control.Exception as E +import Data.CallStack import Test.Hspec.Expectations (Expectation) @@ -54,11 +48,7 @@ -- > describe "absolute" $ do -- > it "returns a positive number when given a negative number" $ -- > absolute (-1) == 1 -#ifdef HAS_SOURCE_LOCATIONS -it :: (?loc :: CallStack, Example a) => String -> a -> SpecWith (Arg a) -#else -it :: Example a => String -> a -> SpecWith (Arg a) -#endif +it :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) it label action = fromSpecList [specItem label action] -- | `parallel` marks all spec items of the given spec to be safe for parallel diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-meta-2.2.1/hspec-core/src/Test/Hspec/Core/Tree.hs new/hspec-meta-2.3.2/hspec-core/src/Test/Hspec/Core/Tree.hs --- old/hspec-meta-2.2.1/hspec-core/src/Test/Hspec/Core/Tree.hs 2016-01-17 06:46:43.000000000 +0100 +++ new/hspec-meta-2.3.2/hspec-core/src/Test/Hspec/Core/Tree.hs 2016-10-16 07:16:55.000000000 +0200 @@ -1,10 +1,8 @@ {-# LANGUAGE DeriveFunctor #-} - -{-# LANGUAGE CPP #-} -#if MIN_VERSION_base(4,8,1) -#define HAS_SOURCE_LOCATIONS -{-# LANGUAGE ImplicitParams #-} -#endif +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ConstraintKinds #-} -- | -- Stability: unstable @@ -16,12 +14,7 @@ , specItem ) where -#ifdef HAS_SOURCE_LOCATIONS -# if !MIN_VERSION_base(4,9,0) -import GHC.SrcLoc -# endif -import GHC.Stack -#endif +import Data.CallStack import Prelude () import Test.Hspec.Compat @@ -33,25 +26,7 @@ Node String [Tree c a] | NodeWithCleanup c [Tree c a] | Leaf a - deriving Functor - -instance Foldable (Tree c) where -- Note: GHC 7.0.1 fails to derive this instance - foldMap = go - where - go :: Monoid m => (a -> m) -> Tree c a -> m - go f t = case t of - Node _ xs -> foldMap (foldMap f) xs - NodeWithCleanup _ xs -> foldMap (foldMap f) xs - Leaf x -> f x - -instance Traversable (Tree c) where -- Note: GHC 7.0.1 fails to derive this instance - sequenceA = go - where - go :: Applicative f => Tree c (f a) -> f (Tree c a) - go t = case t of - Node label xs -> Node label <$> sequenceA (map go xs) - NodeWithCleanup action xs -> NodeWithCleanup action <$> sequenceA (map go xs) - Leaf a -> Leaf <$> a + deriving (Functor, Foldable, Traversable) -- | A tree is used to represent a spec internally. The tree is parametrize -- over the type of cleanup actions and the type of the actual spec items. @@ -88,11 +63,7 @@ | otherwise = s -- | The @specItem@ function creates a spec item. -#ifdef HAS_SOURCE_LOCATIONS -specItem :: (?loc :: CallStack, Example a) => String -> a -> SpecTree (Arg a) -#else -specItem :: Example a => String -> a -> SpecTree (Arg a) -#endif +specItem :: (HasCallStack, Example a) => String -> a -> SpecTree (Arg a) specItem s e = Leaf $ Item requirement location False (evaluateExample e) where requirement @@ -100,10 +71,6 @@ | otherwise = s location :: Maybe Location -#ifdef HAS_SOURCE_LOCATIONS - location = case reverse (getCallStack ?loc) of + location = case reverse callStack of (_, loc) : _ -> Just (Location (srcLocFile loc) (srcLocStartLine loc) (srcLocStartCol loc) ExactLocation) _ -> Nothing -#else - location = Nothing -#endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-meta-2.2.1/hspec-discover/driver/hspec-discover.hs new/hspec-meta-2.3.2/hspec-discover/driver/hspec-discover.hs --- old/hspec-meta-2.2.1/hspec-discover/driver/hspec-discover.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/hspec-meta-2.3.2/hspec-discover/driver/hspec-discover.hs 2016-10-16 07:16:55.000000000 +0200 @@ -0,0 +1,8 @@ +module Main (main) where + +import System.Environment + +import Test.Hspec.Discover.Run (run) + +main :: IO () +main = getArgs >>= run diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-meta-2.2.1/hspec-discover/src/Config.hs new/hspec-meta-2.3.2/hspec-discover/src/Config.hs --- old/hspec-meta-2.2.1/hspec-discover/src/Config.hs 2016-01-17 06:46:43.000000000 +0100 +++ new/hspec-meta-2.3.2/hspec-discover/src/Config.hs 1970-01-01 01:00:00.000000000 +0100 @@ -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) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-meta-2.2.1/hspec-discover/src/Main.hs new/hspec-meta-2.3.2/hspec-discover/src/Main.hs --- old/hspec-meta-2.2.1/hspec-discover/src/Main.hs 2016-01-17 06:46:43.000000000 +0100 +++ new/hspec-meta-2.3.2/hspec-discover/src/Main.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,8 +0,0 @@ -module Main (main) where - -import System.Environment - -import Run (run) - -main :: IO () -main = getArgs >>= run diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-meta-2.2.1/hspec-discover/src/Run.hs new/hspec-meta-2.3.2/hspec-discover/src/Run.hs --- old/hspec-meta-2.2.1/hspec-discover/src/Run.hs 2016-01-17 06:46:43.000000000 +0100 +++ new/hspec-meta-2.3.2/hspec-discover/src/Run.hs 1970-01-01 01:00:00.000000000 +0100 @@ -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.Meta\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) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-meta-2.2.1/hspec-discover/src/Test/Hspec/Discover/Config.hs new/hspec-meta-2.3.2/hspec-discover/src/Test/Hspec/Discover/Config.hs --- old/hspec-meta-2.2.1/hspec-discover/src/Test/Hspec/Discover/Config.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/hspec-meta-2.3.2/hspec-discover/src/Test/Hspec/Discover/Config.hs 2016-10-16 07:16:55.000000000 +0200 @@ -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) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-meta-2.2.1/hspec-discover/src/Test/Hspec/Discover/Run.hs new/hspec-meta-2.3.2/hspec-discover/src/Test/Hspec/Discover/Run.hs --- old/hspec-meta-2.2.1/hspec-discover/src/Test/Hspec/Discover/Run.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/hspec-meta-2.3.2/hspec-discover/src/Test/Hspec/Discover/Run.hs 2016-10-16 07:16:55.000000000 +0200 @@ -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.Meta\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) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-meta-2.2.1/hspec-meta.cabal new/hspec-meta-2.3.2/hspec-meta.cabal --- old/hspec-meta-2.2.1/hspec-meta.cabal 2016-01-17 06:46:43.000000000 +0100 +++ new/hspec-meta-2.3.2/hspec-meta.cabal 2016-10-16 07:16:55.000000000 +0200 @@ -1,5 +1,9 @@ +-- This file has been generated from package.yaml by hpack version 0.15.0. +-- +-- see: https://github.com/sol/hpack + name: hspec-meta -version: 2.2.1 +version: 2.3.2 license: MIT license-file: LICENSE copyright: (c) 2011-2015 Simon Hengel, @@ -17,23 +21,22 @@ in-development version of Hspec. extra-source-files: - changelog + changelog source-repository head type: git location: https://github.com/hspec/hspec library - ghc-options: - -Wall + ghc-options: -Wall hs-source-dirs: - src, hspec-core/src/ + src + hspec-core/src build-depends: base == 4.* - , hspec-expectations , transformers >= 0.2.2.0 , QuickCheck >= 2.5.1 - + , hspec-expectations >= 0.8.0 , HUnit , setenv , deepseq @@ -42,48 +45,60 @@ , ansi-terminal , time , async + , call-stack exposed-modules: Test.Hspec.Meta other-modules: Test.Hspec - Test.Hspec.Runner - Test.Hspec.Formatters - Test.Hspec.QuickCheck - Test.Hspec.Discover Test.Hspec.Core + Test.Hspec.Discover + Test.Hspec.Formatters Test.Hspec.HUnit - - Test.Hspec.Core.Spec - Test.Hspec.Core.Hooks - Test.Hspec.Core.Runner - Test.Hspec.Core.Formatters - Test.Hspec.Core.QuickCheck - Test.Hspec.Core.Util + Test.Hspec.QuickCheck + Test.Hspec.Runner Test.Hspec.Compat + Test.Hspec.Config Test.Hspec.Core.Example - Test.Hspec.Core.Tree - Test.Hspec.Core.Spec.Monad + Test.Hspec.Core.Formatters + Test.Hspec.Core.Formatters.Internal + Test.Hspec.Core.Hooks + Test.Hspec.Core.QuickCheck Test.Hspec.Core.QuickCheckUtil - Test.Hspec.Config - Test.Hspec.Options - Test.Hspec.FailureReport + Test.Hspec.Core.Runner Test.Hspec.Core.Runner.Eval - Test.Hspec.Core.Formatters.Internal + Test.Hspec.Core.Spec + Test.Hspec.Core.Spec.Monad + Test.Hspec.Core.Tree + Test.Hspec.Core.Util + Test.Hspec.FailureReport + Test.Hspec.Options Test.Hspec.Timer + Paths_hspec_meta default-language: Haskell2010 executable hspec-meta-discover - ghc-options: - -Wall + main-is: hspec-discover.hs hs-source-dirs: hspec-discover/src - main-is: - Main.hs - other-modules: - Run - Config + hspec-discover/driver + ghc-options: -Wall build-depends: base == 4.* + , transformers >= 0.2.2.0 + , QuickCheck >= 2.5.1 + , hspec-expectations >= 0.8.0 + , HUnit + , setenv + , deepseq + , random + , quickcheck-io + , ansi-terminal + , time + , async + , call-stack , filepath , directory + other-modules: + Test.Hspec.Discover.Config + Test.Hspec.Discover.Run default-language: Haskell2010 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-meta-2.2.1/src/Test/Hspec/QuickCheck.hs new/hspec-meta-2.3.2/src/Test/Hspec/QuickCheck.hs --- old/hspec-meta-2.2.1/src/Test/Hspec/QuickCheck.hs 2016-01-17 06:46:43.000000000 +0100 +++ new/hspec-meta-2.3.2/src/Test/Hspec/QuickCheck.hs 2016-10-16 07:16:55.000000000 +0200 @@ -1,8 +1,5 @@ -{-# LANGUAGE CPP #-} -#if MIN_VERSION_base(4,8,1) -#define HAS_SOURCE_LOCATIONS -{-# LANGUAGE ImplicitParams #-} -#endif +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ConstraintKinds #-} module Test.Hspec.QuickCheck ( -- * Params modifyMaxSuccess @@ -13,10 +10,6 @@ , prop ) where -#ifdef HAS_SOURCE_LOCATIONS -import GHC.Stack -#endif - import Test.Hspec import Test.QuickCheck import Test.Hspec.Core.QuickCheck @@ -29,9 +22,5 @@ -- -- > it ".." $ property $ -- > .. -#ifdef HAS_SOURCE_LOCATIONS -prop :: (?loc :: CallStack, Testable prop) => String -> prop -> Spec -#else -prop :: (Testable prop) => String -> prop -> Spec -#endif +prop :: (HasCallStack, Testable prop) => String -> prop -> Spec prop s = it s . property