hspec-discover-2.10.10/0000755000000000000000000000000007346545000012762 5ustar0000000000000000hspec-discover-2.10.10/LICENSE0000644000000000000000000000206707346545000013774 0ustar0000000000000000Copyright (c) 2012-2023 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.10.10/Setup.lhs0000644000000000000000000000011407346545000014566 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain hspec-discover-2.10.10/driver/0000755000000000000000000000000007346545000014255 5ustar0000000000000000hspec-discover-2.10.10/driver/hspec-discover.hs0000644000000000000000000000022407346545000017525 0ustar0000000000000000module Main (main) where import System.Environment import Test.Hspec.Discover.Run (run) main :: IO () main = getArgs >>= run hspec-discover-2.10.10/hspec-discover.cabal0000644000000000000000000000417207346545000016670 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack name: hspec-discover version: 2.10.10 license: MIT license-file: LICENSE copyright: (c) 2012-2023 Simon Hengel author: Simon Hengel maintainer: Simon Hengel build-type: Simple category: Testing stability: experimental bug-reports: https://github.com/hspec/hspec/issues homepage: https://hspec.github.io/ synopsis: Automatically discover and run Hspec tests description: Automatically discover and run Hspec tests . extra-source-files: version.yaml source-repository head type: git location: https://github.com/hspec/hspec subdir: hspec-discover library hs-source-dirs: src ghc-options: -Wall -fno-warn-incomplete-uni-patterns build-depends: base >=4.5.0.0 && <5 , 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 -fno-warn-incomplete-uni-patterns hs-source-dirs: driver main-is: hspec-discover.hs build-depends: base >=4.5.0.0 && <5 , directory , filepath , hspec-discover other-modules: Paths_hspec_discover default-language: Haskell2010 test-suite spec type: exitcode-stdio-1.0 ghc-options: -Wall -fno-warn-incomplete-uni-patterns 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.5.0.0 && <5 , directory , filepath , hspec-discover , hspec-meta ==2.10.5 , mockery >=0.3.5 build-tool-depends: hspec-meta:hspec-meta-discover default-language: Haskell2010 hspec-discover-2.10.10/src/Test/Hspec/Discover/0000755000000000000000000000000007346545000017310 5ustar0000000000000000hspec-discover-2.10.10/src/Test/Hspec/Discover/Config.hs0000644000000000000000000000311407346545000021050 0ustar0000000000000000-- | -- /NOTE:/ This module is not meant for public consumption. For user -- documentation look at https://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) hspec-discover-2.10.10/src/Test/Hspec/Discover/Run.hs0000644000000000000000000001700307346545000020411 0ustar0000000000000000{-# LANGUAGE 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 https://hspec.github.io/hspec-discover.html. module Test.Hspec.Discover.Run ( run -- exported for testing , Spec(..) , importList , driverWithFormatter , moduleNameFromId , pathToModule , Tree(..) , Forest(..) , Hook(..) , discover ) 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 String | Hook String [Spec] 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!") when (configNoMain conf) (hPutStrLn stderr "hspec-discover: WARNING - The `--no-main' option is deprecated and will be removed in a future release!") when (isJust $ configFormatter conf) (hPutStrLn stderr "hspec-discover: WARNING - The `--formatter' 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 -> Maybe [Spec] -> String mkSpecModule src conf nodes = ( "{-# LINE 1 " . shows src . " #-}\n" . showString "{-# LANGUAGE NoImplicitPrelude #-}\n" . showString "{-# OPTIONS_GHC -w -Wall -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 :: Maybe [Spec] -> ShowS importList = foldr (.) "" . map f . maybe [] moduleNames where f :: String -> ShowS f spec = "import qualified " . showString spec . "\n" moduleNames :: [Spec] -> [String] moduleNames = fromForest where fromForest :: [Spec] -> [String] fromForest = concatMap fromTree fromTree :: Spec -> [String] fromTree tree = case tree of Spec name -> [name ++ "Spec"] Hook name forest -> name : fromForest forest -- | Combine a list of strings with (>>). sequenceS :: [ShowS] -> ShowS sequenceS = foldr (.) "" . intersperse " >> " formatSpecs :: Maybe [Spec] -> ShowS formatSpecs = maybe "return ()" fromForest where fromForest :: [Spec] -> ShowS fromForest = sequenceS . map fromTree fromTree :: Spec -> ShowS fromTree tree = case tree of Spec name -> "describe " . shows name . " " . showString name . "Spec.spec" Hook name forest -> "(" . showString name . ".hook $ " . fromForest forest . ")" findSpecs :: FilePath -> IO (Maybe [Spec]) findSpecs = fmap (fmap toSpecs) . discover toSpecs :: Forest -> [Spec] toSpecs = fromForest [] where fromForest :: [String] -> Forest -> [Spec] fromForest names (Forest WithHook xs) = [Hook (mkModule ("SpecHook" : names)) $ concatMap (fromTree names) xs] fromForest names (Forest WithoutHook xs) = concatMap (fromTree names) xs fromTree :: [String] -> Tree -> [Spec] fromTree names spec = case spec of Leaf name -> [Spec $ mkModule (name : names )] Node name forest -> fromForest (name : names) forest mkModule :: [String] -> String mkModule = intercalate "." . reverse -- See `Cabal.Distribution.ModuleName` (https://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 == '\'' data Tree = Leaf String | Node String Forest deriving (Eq, Show) data Forest = Forest Hook [Tree] deriving (Eq, Show) data Hook = WithHook | WithoutHook deriving (Eq, Show) sortKey :: Tree -> (String, Int) sortKey tree = case tree of Leaf name -> (name, 0) Node name _ -> (name, 1) discover :: FilePath -> IO (Maybe Forest) discover src = (>>= filterSrc) <$> specForest dir where filterSrc :: Forest -> Maybe Forest filterSrc (Forest hook xs) = ensureForest hook $ maybe id (filter . (/=)) (toSpec file) xs (dir, file) = splitFileName src specForest :: FilePath -> IO (Maybe Forest) specForest dir = do files <- listDirectory dir hook <- mkHook dir files ensureForest hook . sortNaturallyBy sortKey . catMaybes <$> mapM toSpecTree files where toSpecTree :: FilePath -> IO (Maybe Tree) toSpecTree name | isValidModuleName name = do doesDirectoryExist (dir name) `fallback` Nothing $ do xs <- specForest (dir name) return $ Node name <$> xs | otherwise = do doesFileExist (dir name) `fallback` Nothing $ do return $ toSpec name mkHook :: FilePath -> [FilePath] -> IO Hook mkHook dir files | "SpecHook.hs" `elem` files = do doesFileExist (dir "SpecHook.hs") `fallback` WithoutHook $ do return WithHook | otherwise = return WithoutHook fallback :: IO Bool -> a -> IO a -> IO a fallback p def action = do bool <- p if bool then action else return def toSpec :: FilePath -> Maybe Tree toSpec file = Leaf <$> (spec >>= ensure isValidModuleName) where spec :: Maybe String spec = stripSuffix "Spec.hs" file <|> stripSuffix "Spec.lhs" file stripSuffix :: Eq a => [a] -> [a] -> Maybe [a] stripSuffix suffix str = reverse <$> stripPrefix (reverse suffix) (reverse str) ensure :: (a -> Bool) -> a -> Maybe a ensure p a = guard (p a) >> Just a ensureForest :: Hook -> [Tree] -> Maybe Forest ensureForest hook = fmap (Forest hook) . ensure (not . null) listDirectory :: FilePath -> IO [FilePath] listDirectory path = filter f <$> getDirectoryContents path where f filename = filename /= "." && filename /= ".." hspec-discover-2.10.10/src/Test/Hspec/Discover/Sort.hs0000644000000000000000000000175707346545000020605 0ustar0000000000000000-- | -- /NOTE:/ This module is not meant for public consumption. For user -- documentation look at https://hspec.github.io/hspec-discover.html. module Test.Hspec.Discover.Sort ( sortNaturallyBy , NaturalSortKey , naturalSortKey ) where import Control.Arrow import Data.Char import Data.List import Data.Ord sortNaturallyBy :: (a -> (String, Int)) -> [a] -> [a] sortNaturallyBy f = sortBy (comparing ((\ (k, t) -> (naturalSortKey k, t)) . f)) newtype 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.10.10/test/0000755000000000000000000000000007346545000013741 5ustar0000000000000000hspec-discover-2.10.10/test/Helper.hs0000644000000000000000000000022507346545000015513 0ustar0000000000000000module Helper ( module Test.Hspec.Meta , module Control.Applicative ) where import Test.Hspec.Meta import Control.Applicative hspec-discover-2.10.10/test/Spec.hs0000644000000000000000000000006107346545000015164 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-meta-discover #-} hspec-discover-2.10.10/test/Test/Hspec/Discover/0000755000000000000000000000000007346545000017500 5ustar0000000000000000hspec-discover-2.10.10/test/Test/Hspec/Discover/ConfigSpec.hs0000644000000000000000000000327407346545000022062 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.10.10/test/Test/Hspec/Discover/RunSpec.hs0000644000000000000000000001422607346545000021420 0ustar0000000000000000module Test.Hspec.Discover.RunSpec (spec) where import Helper import Test.Mockery.Directory import Test.Hspec.Discover.Run hiding (Spec) import qualified Test.Hspec.Discover.Run as Run spec :: Spec spec = do describe "run" $ around_ inTempDirectory $ do it "generates a test driver" $ do touch "test/FooSpec.hs" touch "test/Foo/Bar/BazSpec.hs" touch "test/Foo/BarSpec.hs" run ["test/Spec.hs", "", "out"] readFile "out" `shouldReturn` unlines [ "{-# LINE 1 \"test/Spec.hs\" #-}" , "{-# LANGUAGE NoImplicitPrelude #-}" , "{-# OPTIONS_GHC -w -Wall -fno-warn-warnings-deprecations #-}" , "module Main where" , "import qualified FooSpec" , "import qualified Foo.BarSpec" , "import qualified Foo.Bar.BazSpec" , "import Test.Hspec.Discover" , "main :: IO ()" , "main = hspec spec" , "spec :: Spec" , "spec = " ++ unwords [ "describe \"Foo\" FooSpec.spec" , ">> describe \"Foo.Bar\" Foo.BarSpec.spec" , ">> describe \"Foo.Bar.Baz\" Foo.Bar.BazSpec.spec" ] ] it "generates a test driver with no Main/main" $ do touch "test/FooSpec.hs" touch "test/Foo/Bar/BazSpec.hs" touch "test/Foo/BarSpec.hs" run ["test/Spec.hs", "", "out", "--no-main"] readFile "out" `shouldReturn` unlines [ "{-# LINE 1 \"test/Spec.hs\" #-}" , "{-# LANGUAGE NoImplicitPrelude #-}" , "{-# OPTIONS_GHC -w -Wall -fno-warn-warnings-deprecations #-}" , "module Spec where" , "import qualified FooSpec" , "import qualified Foo.BarSpec" , "import qualified Foo.Bar.BazSpec" , "import Test.Hspec.Discover" , "spec :: Spec" , "spec = " ++ unwords [ "describe \"Foo\" FooSpec.spec" , ">> describe \"Foo.Bar\" Foo.BarSpec.spec" , ">> describe \"Foo.Bar.Baz\" Foo.Bar.BazSpec.spec" ] ] it "generates a test driver with hooks" $ do touch "test/FooSpec.hs" touch "test/Foo/Bar/BazSpec.hs" touch "test/Foo/BarSpec.hs" touch "test/Foo/SpecHook.hs" touch "test/SpecHook.hs" run ["test/Spec.hs", "", "out"] readFile "out" `shouldReturn` unlines [ "{-# LINE 1 \"test/Spec.hs\" #-}" , "{-# LANGUAGE NoImplicitPrelude #-}" , "{-# OPTIONS_GHC -w -Wall -fno-warn-warnings-deprecations #-}" , "module Main where" , "import qualified SpecHook" , "import qualified FooSpec" , "import qualified Foo.SpecHook" , "import qualified Foo.BarSpec" , "import qualified Foo.Bar.BazSpec" , "import Test.Hspec.Discover" , "main :: IO ()" , "main = hspec spec" , "spec :: Spec" , "spec = " ++ unwords [ "(SpecHook.hook $ describe \"Foo\" FooSpec.spec" , ">> (Foo.SpecHook.hook $ describe \"Foo.Bar\" Foo.BarSpec.spec" , ">> describe \"Foo.Bar.Baz\" Foo.Bar.BazSpec.spec))" ] ] it "generates a test driver for an empty directory" $ do touch "test/Foo/Bar/Baz/.placeholder" run ["test/Spec.hs", "", "out"] readFile "out" `shouldReturn` unlines [ "{-# LINE 1 \"test/Spec.hs\" #-}" , "{-# LANGUAGE NoImplicitPrelude #-}" , "{-# OPTIONS_GHC -w -Wall -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 "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 (Just [Run.Spec "Foo", Run.Spec "Bar"]) "" `shouldBe` unlines [ "import qualified FooSpec" , "import qualified BarSpec" ] describe "discover" $ do it "discovers spec files" $ do inTempDirectory $ do touch "test/Spec.hs" touch "test/FooSpec.hs" touch "test/BarSpec.hs" discover "test/Spec.hs" `shouldReturn` Just (Forest WithoutHook [Leaf "Bar", Leaf "Foo"]) it "discovers nested spec files" $ do inTempDirectory $ do touch "test/Spec.hs" touch "test/Foo/BarSpec.hs" touch "test/Foo/BazSpec.hs" discover "test/Spec.hs" `shouldReturn` Just (Forest WithoutHook [Node "Foo" (Forest WithoutHook [Leaf "Bar", Leaf "Baz"])]) it "discovers hooks" $ do inTempDirectory $ do touch "test/Spec.hs" touch "test/FooSpec.hs" touch "test/BarSpec.hs" touch "test/SpecHook.hs" discover "test/Spec.hs" `shouldReturn` Just (Forest WithHook [Leaf "Bar", Leaf "Foo"]) it "discovers nested hooks" $ do inTempDirectory $ do touch "test/Spec.hs" touch "test/Foo/BarSpec.hs" touch "test/Foo/BazSpec.hs" touch "test/Foo/SpecHook.hs" discover "test/Spec.hs" `shouldReturn` Just (Forest WithoutHook [Node "Foo" (Forest WithHook [Leaf "Bar", Leaf "Baz"])]) it "ignores invalid module names" $ do inTempDirectory $ do touch "test/Spec.hs" touch "test/barSpec.hs" discover "test/Spec.hs" `shouldReturn` Nothing it "ignores empty directories" $ do inTempDirectory $ do touch "test/Spec.hs" touch "test/Foo/.keep" discover "test/Spec.hs" `shouldReturn` Nothing it "ignores directories with extension" $ do inTempDirectory $ do touch "test/Spec.hs" touch "test/Foo.hs/BarSpec.hs" discover "test/Spec.hs" `shouldReturn` Nothing hspec-discover-2.10.10/test/Test/Hspec/Discover/SortSpec.hs0000644000000000000000000000427507346545000021606 0ustar0000000000000000module Test.Hspec.Discover.SortSpec (spec) where import Helper import Test.QuickCheck import Test.Hspec.Discover.Sort shuffleAndSort :: [String] -> IO [String] shuffleAndSort xs = sortNaturally <$> generate (shuffle xs) sortNaturally :: [String] -> [String] sortNaturally = sortNaturallyBy $ \ name -> (name, 0) 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.10.10/version.yaml0000644000000000000000000000002107346545000015324 0ustar0000000000000000&version 2.10.10