From 48b5858b9b37e4190c475558a6c88dc923ec5c5a Mon Sep 17 00:00:00 2001 From: Ɓukasz Hanuszczak Date: Tue, 18 Aug 2015 23:06:00 +0200 Subject: Fix path handling in test module loader. --- haddock-test/src/Test/Haddock/Config.hs | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) (limited to 'haddock-test/src') 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` [".", ".."] -- cgit v1.2.3