diff options
author | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-08-18 23:06:00 +0200 |
---|---|---|
committer | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-08-22 23:40:28 +0200 |
commit | 48b5858b9b37e4190c475558a6c88dc923ec5c5a (patch) | |
tree | c0b336a3fd31d24d27ed4008f9f68328c9dc3b06 | |
parent | ebf06f31c1eaf0e9d045f8472548196d47d53431 (diff) |
Fix path handling in test module loader.
-rw-r--r-- | haddock-test/src/Test/Haddock/Config.hs | 20 |
1 files changed, 16 insertions, 4 deletions
diff --git a/haddock-test/src/Test/Haddock/Config.hs b/haddock-test/src/Test/Haddock/Config.hs index 9fca3348..f3056061 100644 --- a/haddock-test/src/Test/Haddock/Config.hs +++ b/haddock-test/src/Test/Haddock/Config.hs @@ -241,8 +241,8 @@ processFileArgs dcfg [] = processFileArgs' dcfg . filter isValidEntry =<< getDirectoryContents srcDir where isValidEntry entry - | hasExtension entry = takeExtension entry `elem` [".hs", ".lhs"] - | otherwise = entry /= "." && entry /= ".." + | hasExtension entry = isSourceFile entry + | otherwise = isRealDir entry srcDir = dcfgSrcDir dcfg processFileArgs dcfg args = processFileArgs' dcfg args @@ -255,12 +255,24 @@ processFileArgs' dcfg args = do , tpkgFiles = map (srcDir </>) mdls } otherPkgs <- forM dirs $ \dir -> do - files <- getDirectoryContents (srcDir </> dir) + let srcDir' = srcDir </> dir + files <- filterM (isModule dir) =<< getDirectoryContents srcDir' pure $ TestPackage { tpkgName = dir - , tpkgFiles = map ((srcDir </> dir) </>) files + , tpkgFiles = map (srcDir' </>) files } pure $ rootPkg:otherPkgs where doesDirectoryExist' path = doesDirectoryExist (srcDir </> path) + isModule dir file = (isSourceFile file &&) <$> + doesFileExist (srcDir </> dir </> file) + doesFileExist' dir path = doesFileExist (srcDir </> dir </> path) srcDir = dcfgSrcDir dcfg + + +isSourceFile :: FilePath -> Bool +isSourceFile file = takeExtension file `elem` [".hs", ".lhs"] + + +isRealDir :: FilePath -> Bool +isRealDir dir = not $ dir `elem` [".", ".."] |