diff options
author | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-08-18 20:32:12 +0200 |
---|---|---|
committer | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-08-22 23:40:27 +0200 |
commit | c2a4125e3a5158078d8c172a840f7292dcf3ab28 (patch) | |
tree | 903677dd4cc2fcb172a6d03b82c5117315452ee6 /haddock-test | |
parent | e614916d940943a1f4f7cd77d9957246d164ab1d (diff) |
Fix path handling in test runner.
Diffstat (limited to 'haddock-test')
-rw-r--r-- | haddock-test/src/Test/Haddock/Config.hs | 25 |
1 files changed, 10 insertions, 15 deletions
diff --git a/haddock-test/src/Test/Haddock/Config.hs b/haddock-test/src/Test/Haddock/Config.hs index 15a53829..1b89e276 100644 --- a/haddock-test/src/Test/Haddock/Config.hs +++ b/haddock-test/src/Test/Haddock/Config.hs @@ -238,34 +238,29 @@ defaultDiffTool = processFileArgs :: DirConfig -> [String] -> IO [TestPackage] processFileArgs dcfg [] = - processFileArgs dcfg . filter isValidEntry =<< getDirectoryContents srcDir + processFileArgs' dcfg . filter isValidEntry =<< getDirectoryContents srcDir where - isValidEntry entry = entry /= "." && entry /= ".." + isValidEntry entry + | hasExtension entry = takeExtension entry `elem` [".hs", ".lhs"] + | otherwise = entry /= "." && entry /= ".." srcDir = dcfgSrcDir dcfg processFileArgs dcfg args = processFileArgs' dcfg args processFileArgs' :: DirConfig -> [String] -> IO [TestPackage] processFileArgs' dcfg args = do - (mdls, dirs) <- partitionM doesDirectoryExist' args + (dirs, mdls) <- partitionM doesDirectoryExist' . map takeBaseName $ args rootPkg <- pure $ TestPackage { tpkgName = "" - , tpkgFiles = map (processFileArg dcfg) mdls + , tpkgFiles = map (srcDir </>) mdls } otherPkgs <- forM dirs $ \dir -> do - files <- getDirectoryContents dir + files <- getDirectoryContents (srcDir </> dir) pure $ TestPackage { tpkgName = dir - , tpkgFiles = map ((dcfgSrcDir dcfg </> dir) </>) files + , tpkgFiles = map ((srcDir </> dir) </>) files } pure $ rootPkg:otherPkgs where - doesDirectoryExist' path = doesDirectoryExist (dcfgSrcDir dcfg </> path) - - -processFileArg :: DirConfig -> String -> FilePath -processFileArg dcfg arg - | isSourceFile arg = arg - | otherwise = dcfgSrcDir dcfg </> arg </> ".hs" - where - isSourceFile path = takeExtension path `elem` [".hs", ".lhs"] + doesDirectoryExist' path = doesDirectoryExist (srcDir </> path) + srcDir = dcfgSrcDir dcfg |