module TestLib (Config(..), mainWith, mainWithOpts, main, Options(..)) where

import SimpleGetOpt
import Control.Monad (foldM,when)
import System.Directory ( getDirectoryContents,doesDirectoryExist
                        , doesFileExist
                        , createDirectoryIfMissing,canonicalizePath )
import System.Environment (withArgs)
import System.Info(os)
import System.FilePath((</>),(<.>),splitFileName,splitDirectories,takeFileName
                      , isRelative, pathSeparator, takeExtension )
import System.Process ( createProcess,CreateProcess(..), StdStream(..)
                      , proc, waitForProcess, readProcessWithExitCode
                       )
import System.IO(IOMode(..),withFile,Handle,hSetBuffering,BufferMode(..))
import System.Exit(exitSuccess)
import Paths_test_lib (version)
import Data.Version (showVersion)
import Test.Framework (defaultMain,Test,testGroup)
import Test.Framework.Providers.HUnit (testCase)
import Test.HUnit (assertFailure)
import qualified Control.Exception as X
import           Data.Map (Map)
import qualified Data.Map as Map
import           Data.Set (Set)
import qualified Data.Set as Set


-- | Specifies how the test runner should behave.
data Config = Config
  { Config -> String
cfgDefaultBinary :: String
    -- ^ Use this binary unless one is explicitly provided.

  , Config -> String -> [String]
cfgBinOpts       :: String -> [String]
    -- ^ Given a test, produce a set of parameters for the binary.

  , Config -> String -> Bool
cfgIsTestCase    :: String -> Bool
    -- ^ Examine a file name to determine if it is a test.
  }

main :: IO ()
main :: IO ()
main =
  do Options
opts <- OptSpec Options -> IO Options
forall a. OptSpec a -> IO a
getOpts OptSpec Options
options
     Options -> IO ()
mainWithOpts Options
opts

-- | Define a @main@ function for an executable.
mainWith :: Config -> IO ()
mainWith :: Config -> IO ()
mainWith Config
cfg =
  do Options
opts0 <- OptSpec Options -> IO Options
forall a. OptSpec a -> IO a
getOpts OptSpec Options
options
     let opts :: Options
opts = Options
opts0 { optCfg :: Maybe Config
optCfg = Config -> Maybe Config
forall a. a -> Maybe a
Just Config
cfg }
     Options -> IO ()
mainWithOpts (Options -> IO ()) -> Options -> IO ()
forall a b. (a -> b) -> a -> b
$ case Options -> String
optBinary Options
opts of
                      String
"" -> Options
opts { optBinary :: String
optBinary = Config -> String
cfgDefaultBinary Config
cfg }
                      String
_  -> Options
opts

-- | Run with the given options
mainWithOpts :: Options -> IO ()
mainWithOpts :: Options -> IO ()
mainWithOpts Options
opts =
  do Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
optHelp Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        do OptSpec Options -> IO ()
forall a. OptSpec a -> IO ()
dumpUsage OptSpec Options
options
           IO ()
forall a. IO a
exitSuccess

     Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
optVersion Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        do String -> IO ()
putStrLn (Version -> String
showVersion Version
version)
           IO ()
forall a. IO a
exitSuccess

     -- Normalize paths
     String
bin' <- if Char
pathSeparator Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Options -> String
optBinary Options
opts
                     Bool -> Bool -> Bool
&& String -> Bool
isRelative (Options -> String
optBinary Options
opts)
                then String -> IO String
canonicalizePath (Options -> String
optBinary Options
opts)
                else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> String
optBinary Options
opts)
     String
resultsDir <- String -> IO String
canonicalizePath (Options -> String
optResultDir Options
opts)
     let opts' :: Options
opts' = Options
opts { optResultDir :: String
optResultDir = String
resultsDir, optBinary :: String
optBinary = String
bin' }

     Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
resultsDir
     TestFiles
testFiles  <- Options -> IO TestFiles
findTests Options
opts'
     [String] -> IO () -> IO ()
forall a. [String] -> IO a -> IO a
withArgs (Options -> [String]
optOther Options
opts') ([Test] -> IO ()
defaultMain (Options -> TestFiles -> [Test]
generateTests Options
opts' TestFiles
testFiles))





-- Command Line Options --------------------------------------------------------

data Options = Options
  { Options -> String
optBinary         :: String
  , Options -> [String]
optOther          :: [String]
  , Options -> Bool
optHelp           :: Bool
  , Options -> Bool
optVersion        :: Bool
  , Options -> String
optResultDir      :: FilePath
  , Options -> [String]
optTests          :: [FilePath]
  , Options -> Maybe String
optDiffTool       :: Maybe String
  , Options -> Bool
optIgnoreExpected :: Bool
  , Options -> [String]
optTestFileExts   :: [String]
  , Options -> [String]
optBinFlags       :: [String]
    -- ^ Add this flags to the binary, followed by the test file
  , Options -> Maybe Config
optCfg            :: Maybe Config
  }


options :: OptSpec Options
options :: OptSpec Options
options = OptSpec :: forall a.
a
-> [OptDescr a]
-> [(String, String)]
-> (String -> OptSetter a)
-> OptSpec a
OptSpec
  { progDefaults :: Options
progDefaults = Options :: String
-> [String]
-> Bool
-> Bool
-> String
-> [String]
-> Maybe String
-> Bool
-> [String]
-> [String]
-> Maybe Config
-> Options
Options { optBinary :: String
optBinary         = String
""
                           , optOther :: [String]
optOther          = []
                           , optHelp :: Bool
optHelp           = Bool
False
                           , optVersion :: Bool
optVersion        = Bool
False
                           , optResultDir :: String
optResultDir      = String
"output"
                           , optTests :: [String]
optTests          = []
                           , optDiffTool :: Maybe String
optDiffTool       = Maybe String
forall a. Maybe a
Nothing
                           , optBinFlags :: [String]
optBinFlags       = []
                           , optTestFileExts :: [String]
optTestFileExts   = []
                           , optIgnoreExpected :: Bool
optIgnoreExpected = Bool
False
                           , optCfg :: Maybe Config
optCfg            = Maybe Config
forall a. Maybe a
Nothing
                           }

  , progOptions :: [OptDescr Options]
progOptions =
      [ String
-> [String] -> String -> ArgDescr Options -> OptDescr Options
forall a. String -> [String] -> String -> ArgDescr a -> OptDescr a
Option String
"c" [String
"exe"]
        String
"the binary executable to use"
        (ArgDescr Options -> OptDescr Options)
-> ArgDescr Options -> OptDescr Options
forall a b. (a -> b) -> a -> b
$ String -> (String -> OptSetter Options) -> ArgDescr Options
forall a. String -> (String -> OptSetter a) -> ArgDescr a
ReqArg String
"PATH" ((String -> OptSetter Options) -> ArgDescr Options)
-> (String -> OptSetter Options) -> ArgDescr Options
forall a b. (a -> b) -> a -> b
$ \String
s Options
o -> OptSetter Options
forall a b. b -> Either a b
Right Options
o { optBinary :: String
optBinary = String
s }

     , String
-> [String] -> String -> ArgDescr Options -> OptDescr Options
forall a. String -> [String] -> String -> ArgDescr a -> OptDescr a
Option String
"F" [String
"flag"]
        String
"add a flag to the test binary"
        (ArgDescr Options -> OptDescr Options)
-> ArgDescr Options -> OptDescr Options
forall a b. (a -> b) -> a -> b
$ String -> (String -> OptSetter Options) -> ArgDescr Options
forall a. String -> (String -> OptSetter a) -> ArgDescr a
ReqArg String
"STRING" ((String -> OptSetter Options) -> ArgDescr Options)
-> (String -> OptSetter Options) -> ArgDescr Options
forall a b. (a -> b) -> a -> b
$ \String
s Options
o -> OptSetter Options
forall a b. b -> Either a b
Right Options
o { optBinFlags :: [String]
optBinFlags = Options -> [String]
optBinFlags Options
o [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String
s]}

      , String
-> [String] -> String -> ArgDescr Options -> OptDescr Options
forall a. String -> [String] -> String -> ArgDescr a -> OptDescr a
Option String
"r" [String
"result-dir"]
        String
"the result directory for test runs"
        (ArgDescr Options -> OptDescr Options)
-> ArgDescr Options -> OptDescr Options
forall a b. (a -> b) -> a -> b
$ String -> (String -> OptSetter Options) -> ArgDescr Options
forall a. String -> (String -> OptSetter a) -> ArgDescr a
ReqArg String
"PATH" ((String -> OptSetter Options) -> ArgDescr Options)
-> (String -> OptSetter Options) -> ArgDescr Options
forall a b. (a -> b) -> a -> b
$ \String
s Options
o -> OptSetter Options
forall a b. b -> Either a b
Right Options
o { optResultDir :: String
optResultDir = String
s }

      , String
-> [String] -> String -> ArgDescr Options -> OptDescr Options
forall a. String -> [String] -> String -> ArgDescr a -> OptDescr a
Option String
"p" [String
"diff-prog"]
        String
"use this diffing program on failures"
        (ArgDescr Options -> OptDescr Options)
-> ArgDescr Options -> OptDescr Options
forall a b. (a -> b) -> a -> b
$ String -> (String -> OptSetter Options) -> ArgDescr Options
forall a. String -> (String -> OptSetter a) -> ArgDescr a
ReqArg String
"PROG" ((String -> OptSetter Options) -> ArgDescr Options)
-> (String -> OptSetter Options) -> ArgDescr Options
forall a b. (a -> b) -> a -> b
$ \String
s Options
o -> OptSetter Options
forall a b. b -> Either a b
Right Options
o { optDiffTool :: Maybe String
optDiffTool = String -> Maybe String
forall a. a -> Maybe a
Just String
s }

      , String
-> [String] -> String -> ArgDescr Options -> OptDescr Options
forall a. String -> [String] -> String -> ArgDescr a -> OptDescr a
Option String
"T" []
        String
"add an argument to pass to the test-runner main"
        (ArgDescr Options -> OptDescr Options)
-> ArgDescr Options -> OptDescr Options
forall a b. (a -> b) -> a -> b
$ String -> (String -> OptSetter Options) -> ArgDescr Options
forall a. String -> (String -> OptSetter a) -> ArgDescr a
ReqArg String
"STRING" ((String -> OptSetter Options) -> ArgDescr Options)
-> (String -> OptSetter Options) -> ArgDescr Options
forall a b. (a -> b) -> a -> b
$ \String
s Options
o -> OptSetter Options
forall a b. b -> Either a b
Right Options
o { optOther :: [String]
optOther = String
s String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Options -> [String]
optOther Options
o }

      , String
-> [String] -> String -> ArgDescr Options -> OptDescr Options
forall a. String -> [String] -> String -> ArgDescr a -> OptDescr a
Option String
"i" [String
"ignore-expected"]
        String
"ignore expected failures"
        (ArgDescr Options -> OptDescr Options)
-> ArgDescr Options -> OptDescr Options
forall a b. (a -> b) -> a -> b
$ OptSetter Options -> ArgDescr Options
forall a. OptSetter a -> ArgDescr a
NoArg (OptSetter Options -> ArgDescr Options)
-> OptSetter Options -> ArgDescr Options
forall a b. (a -> b) -> a -> b
$ \Options
o -> OptSetter Options
forall a b. b -> Either a b
Right Options
o { optIgnoreExpected :: Bool
optIgnoreExpected = Bool
True }

      , String
-> [String] -> String -> ArgDescr Options -> OptDescr Options
forall a. String -> [String] -> String -> ArgDescr a -> OptDescr a
Option String
"" [String
"ext"]
        String
"files with this extension are tests"
        (ArgDescr Options -> OptDescr Options)
-> ArgDescr Options -> OptDescr Options
forall a b. (a -> b) -> a -> b
$ String -> (String -> OptSetter Options) -> ArgDescr Options
forall a. String -> (String -> OptSetter a) -> ArgDescr a
ReqArg String
"STRING" ((String -> OptSetter Options) -> ArgDescr Options)
-> (String -> OptSetter Options) -> ArgDescr Options
forall a b. (a -> b) -> a -> b
$ \String
s Options
o ->
            let e :: String
e = case String
s of
                      Char
'.' : String
_ -> String
s
                      String
_ -> Char
'.' Char -> String -> String
forall a. a -> [a] -> [a]
: String
s
            in OptSetter Options
forall a b. b -> Either a b
Right Options
o { optTestFileExts :: [String]
optTestFileExts = String
e String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Options -> [String]
optTestFileExts Options
o }

      , String
-> [String] -> String -> ArgDescr Options -> OptDescr Options
forall a. String -> [String] -> String -> ArgDescr a -> OptDescr a
Option String
"" [String
"version"]
        String
"display current version"
        (ArgDescr Options -> OptDescr Options)
-> ArgDescr Options -> OptDescr Options
forall a b. (a -> b) -> a -> b
$ OptSetter Options -> ArgDescr Options
forall a. OptSetter a -> ArgDescr a
NoArg (OptSetter Options -> ArgDescr Options)
-> OptSetter Options -> ArgDescr Options
forall a b. (a -> b) -> a -> b
$ \Options
o -> OptSetter Options
forall a b. b -> Either a b
Right Options
o { optVersion :: Bool
optVersion = Bool
True }

      , String
-> [String] -> String -> ArgDescr Options -> OptDescr Options
forall a. String -> [String] -> String -> ArgDescr a -> OptDescr a
Option String
"h" [String
"help"]
        String
"display this message"
        (ArgDescr Options -> OptDescr Options)
-> ArgDescr Options -> OptDescr Options
forall a b. (a -> b) -> a -> b
$ OptSetter Options -> ArgDescr Options
forall a. OptSetter a -> ArgDescr a
NoArg (OptSetter Options -> ArgDescr Options)
-> OptSetter Options -> ArgDescr Options
forall a b. (a -> b) -> a -> b
$ \Options
o -> OptSetter Options
forall a b. b -> Either a b
Right Options
o { optHelp :: Bool
optHelp = Bool
True }
      ]

  , progParamDocs :: [(String, String)]
progParamDocs =
      [ (String
"FILES/DIRS",   String
"The tests to run.") ]

  , progParams :: String -> OptSetter Options
progParams = \String
p Options
o -> OptSetter Options
forall a b. b -> Either a b
Right Options
o { optTests :: [String]
optTests = String
p String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Options -> [String]
optTests Options
o }
  }

-- Test Generation -------------------------------------------------------------

-- | Turn a directory tree of tests into a collection of tests.
-- Tests in the same directory share a test-group.
generateTests :: Options -> TestFiles -> [Test]
generateTests :: Options -> TestFiles -> [Test]
generateTests Options
opts = String -> TestFiles -> [Test]
loop String
""
  where
  loop :: String -> TestFiles -> [Test]
loop String
dir TestFiles
tests = [Test]
as [Test] -> [Test] -> [Test]
forall a. [a] -> [a] -> [a]
++ [Test]
grouped
    where
    as :: [Test]
as      = (String -> Test) -> [String] -> [Test]
forall a b. (a -> b) -> [a] -> [b]
map (Options -> String -> String -> Test
generateAssertion Options
opts String
dir) (Set String -> [String]
forall a. Set a -> [a]
Set.toList (TestFiles -> Set String
files TestFiles
tests))
    grouped :: [Test]
grouped = [ String -> [Test] -> Test
testGroup String
path (String -> TestFiles -> [Test]
loop (String
dir String -> String -> String
</> String
path) TestFiles
t)
              | (String
path,TestFiles
t) <- Map String TestFiles -> [(String, TestFiles)]
forall k a. Map k a -> [(k, a)]
Map.toList (TestFiles -> Map String TestFiles
subDirs TestFiles
tests) ]



-- | This is how we run a test.
generateAssertion :: Options -> FilePath -> FilePath -> Test
generateAssertion :: Options -> String -> String -> Test
generateAssertion Options
opts String
dir String
file = String -> IO () -> Test
testCase String
file IO ()
runTest
  where
  -- file locations:
  resultDir :: String
resultDir        = Options -> String
optResultDir Options
opts String -> String -> String
</> String
dir        -- test output goes here
  goldFiles :: [String]
goldFiles        = [ String
dir String -> String -> String
</> String
file String -> String -> String
<.> String
"stdout" String -> String -> String
<.> String
os -- what we expect to see
                     , String
dir String -> String -> String
</> String
file String -> String -> String
<.> String
"stdout"        -- what we expect to see
                     ]
  knownFailureFile :: String
knownFailureFile = String
dir String -> String -> String
</> String
file String -> String -> String
<.> String
"fails"         -- expected failur
  resultOut :: String
resultOut        = String
resultDir String -> String -> String
</> String
file String -> String -> String
<.> String
"stdout"  -- outputfile

  getGoldFile :: [String] -> IO String
getGoldFile [String]
gfs =
    case [String]
gfs of
      [] -> String -> IO String
forall a. HasCallStack => String -> a
error (String
"Missing gold file for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show (String
dir String -> String -> String
</> String
file))
      String
f : [String]
fs -> do Bool
yes <- String -> IO Bool
doesFileExist String
f
                   if Bool
yes then String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
f else [String] -> IO String
getGoldFile [String]
fs

  runTest :: IO ()
runTest =
    do Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
resultDir
       String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
resultOut IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Handle
hout ->
         do Handle -> BufferMode -> IO ()
hSetBuffering Handle
hout BufferMode
NoBuffering
            Options -> Handle -> String -> String -> IO ()
runBinary Options
opts Handle
hout String
dir String
file

       String
out      <- String -> IO String
readFile String
resultOut
       String
gf       <- [String] -> IO String
getGoldFile [String]
goldFiles
       String
expected <- String -> IO String
readFile String
gf
       Either SomeException String
mbKnown  <- IO String -> IO (Either SomeException String)
forall e a. Exception e => IO a -> IO (Either e a)
X.try (String -> IO String
readFile String
knownFailureFile)
       String -> Either SomeException String -> String -> String -> IO ()
forall a.
Eq a =>
String -> Either SomeException String -> a -> a -> IO ()
checkOutput String
gf Either SomeException String
mbKnown String
expected String
out

  checkOutput :: String -> Either SomeException String -> a -> a -> IO ()
checkOutput String
goldFile Either SomeException String
mbKnown a
expected a
out
    | a
expected a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
out =
      case Either SomeException String
mbKnown of
        Left SomeException
_  -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        -- Test passed, but we expected a failure.
        Right String
_ ->
          String -> IO ()
forall a. HasCallStack => String -> IO a
assertFailure (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
            String
"Test completed successfully.  Please remove " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
knownFailureFile


      -- Gold and output differ
    | Bool
otherwise =
      case Either SomeException String
mbKnown of

        -- No expected errors.
        Left (X.SomeException {})

          -- A custom diff tool was lister.  We don't run it,
          -- we just write it on the terminal for easy copy and paste.
          | Just String
prog <- Options -> Maybe String
optDiffTool Options
opts ->
            do String
goldFile' <- String -> IO String
canonicalizePath String
goldFile
               String -> IO ()
forall a. HasCallStack => String -> IO a
assertFailure (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
                  [ [String] -> String
unwords [ String
prog, String
goldFile', String
"\\\n    ", String
resultOut ]
                  , String -> String -> String
makeGold String
resultOut String
goldFile'
                  ]

          -- Just use "diff"
          | Bool
otherwise ->
            do String
goldFile' <- String -> IO String
canonicalizePath String
goldFile
               (ExitCode
_,String
diffOut,String
_) <-
                  String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
"diff" [ String
goldFile', String
resultOut ] String
""
               String -> IO ()
forall a. HasCallStack => String -> IO a
assertFailure (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [ String
diffOut, String -> String -> String
makeGold String
resultOut String
goldFile' ]

        Right String
fail_msg
          -- Expected error.
          | Options -> Bool
optIgnoreExpected Options
opts -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          -- Different expected error.
          | Bool
otherwise              -> String -> IO ()
forall a. HasCallStack => String -> IO a
assertFailure String
fail_msg

  makeGold :: String -> String -> String
makeGold String
out String
gold =
    [String] -> String
unlines [ String
"# If output is OK:"
            , [String] -> String
unwords [ String
"cp", String
out, String
"\\\n    ", String
gold ]
            ]



-- | Write the output of stdout and stderr for a run of the binary to
-- the given handle.
runBinary :: Options -> Handle -> FilePath -> String -> IO ()
runBinary :: Options -> Handle -> String -> String -> IO ()
runBinary Options
opts Handle
hout String
path String
file =
  do let bin :: String
bin  = Options -> String
optBinary Options
opts
         args :: [String]
args = case Options -> Maybe Config
optCfg Options
opts of
                  Just Config
x -> Options -> [String]
optBinFlags Options
opts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Config -> String -> [String]
cfgBinOpts Config
x String
file
                  Maybe Config
Nothing -> Options -> [String]
optBinFlags Options
opts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
file]
     (Maybe Handle
_, Maybe Handle
_, Maybe Handle
_, ProcessHandle
ph) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (String -> [String] -> CreateProcess
proc String
bin [String]
args)
                        { cwd :: Maybe String
cwd     = String -> Maybe String
forall a. a -> Maybe a
Just String
path
                        , std_out :: StdStream
std_out = Handle -> StdStream
UseHandle Handle
hout
                        , std_in :: StdStream
std_in  = StdStream
Inherit
                        , std_err :: StdStream
std_err = Handle -> StdStream
UseHandle Handle
hout
                        }
     ExitCode
_ <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph
     () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()




-- Test Discovery --------------------------------------------------------------

-- | Directory structure of the discovered tests.  Each entry in the map
-- represents a single folder, with the top-level list representing tests
-- inside the base directory.
data TestFiles = TestFiles
  { TestFiles -> Map String TestFiles
subDirs :: Map String TestFiles
  , TestFiles -> Set String
files   :: Set String
  }

-- | An empty collection of tests.
noTests :: TestFiles
noTests :: TestFiles
noTests = TestFiles :: Map String TestFiles -> Set String -> TestFiles
TestFiles { subDirs :: Map String TestFiles
subDirs = Map String TestFiles
forall k a. Map k a
Map.empty, files :: Set String
files = Set String
forall a. Set a
Set.empty }

-- | Join two collections of tests, removing duplicates.
joinTests :: TestFiles -> TestFiles -> TestFiles
joinTests :: TestFiles -> TestFiles -> TestFiles
joinTests TestFiles
ts1 TestFiles
ts2 = TestFiles :: Map String TestFiles -> Set String -> TestFiles
TestFiles
  { files :: Set String
files   = Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
Set.union (TestFiles -> Set String
files TestFiles
ts1) (TestFiles -> Set String
files TestFiles
ts2)
  , subDirs :: Map String TestFiles
subDirs = (TestFiles -> TestFiles -> TestFiles)
-> Map String TestFiles
-> Map String TestFiles
-> Map String TestFiles
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith TestFiles -> TestFiles -> TestFiles
joinTests (TestFiles -> Map String TestFiles
subDirs TestFiles
ts1) (TestFiles -> Map String TestFiles
subDirs TestFiles
ts2)
  }

-- | Create a test collection with a single file.
testFile :: FilePath -> TestFiles
testFile :: String -> TestFiles
testFile String
path = (String -> TestFiles -> TestFiles)
-> TestFiles -> [String] -> TestFiles
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> TestFiles -> TestFiles
addDir TestFiles
baseTest [String]
dirs
  where
  baseTest :: TestFiles
baseTest   = TestFiles
noTests { files :: Set String
files = String -> Set String
forall a. a -> Set a
Set.singleton String
file }
  (String
dir,String
file) = String -> (String, String)
splitFileName String
path
  dirs :: [String]
dirs       = String -> [String]
splitDirectories String
dir
  addDir :: String -> TestFiles -> TestFiles
addDir String
d TestFiles
t = Map String TestFiles -> Set String -> TestFiles
TestFiles (String -> TestFiles -> Map String TestFiles
forall k a. k -> a -> Map k a
Map.singleton String
d TestFiles
t) Set String
forall a. Set a
Set.empty


-- | Find a bunch of tests.
findTests :: Options -> IO TestFiles
findTests :: Options -> IO TestFiles
findTests Options
opts = TestFiles -> [String] -> IO TestFiles
searchMany TestFiles
noTests (Options -> [String]
optTests Options
opts)
  where
  searchMany :: TestFiles -> [String] -> IO TestFiles
searchMany TestFiles
tests = (TestFiles -> String -> IO TestFiles)
-> TestFiles -> [String] -> IO TestFiles
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM TestFiles -> String -> IO TestFiles
step TestFiles
tests

  step :: TestFiles -> String -> IO TestFiles
step TestFiles
tests String
path =
    do Bool
isDir <- String -> IO Bool
doesDirectoryExist String
path
       if Bool
isDir
          then do [String]
fs <- String -> IO [String]
getDirectoryContents String
path
                  TestFiles -> [String] -> IO TestFiles
searchMany TestFiles
tests [ String
path String -> String -> String
</> String
f | String
f <- [String]
fs, Bool -> Bool
not (String -> Bool
isDotFile String
f) ]
          else if String -> Bool
isTestFile String
path
                    then TestFiles -> IO TestFiles
forall (m :: * -> *) a. Monad m => a -> m a
return (TestFiles -> IO TestFiles) -> TestFiles -> IO TestFiles
forall a b. (a -> b) -> a -> b
$! TestFiles -> TestFiles -> TestFiles
joinTests (String -> TestFiles
testFile String
path) TestFiles
tests
                    else TestFiles -> IO TestFiles
forall (m :: * -> *) a. Monad m => a -> m a
return TestFiles
tests

  isDotFile :: String -> Bool
isDotFile String
path = case String
path of
                     Char
'.' : String
_ -> Bool
True
                     String
_       -> Bool
False

  isTestFile :: String -> Bool
isTestFile String
f = case Options -> Maybe Config
optCfg Options
opts of
                   Maybe Config
Nothing -> Bool
byExt
                   Just Config
cfg -> Bool
byExt Bool -> Bool -> Bool
|| Config -> String -> Bool
cfgIsTestCase Config
cfg String
file
    where
    file :: String
file  = String -> String
takeFileName String
f
    byExt :: Bool
byExt = String -> String
takeExtension String
file String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Options -> [String]
optTestFileExts Options
opts