From 48b5858b9b37e4190c475558a6c88dc923ec5c5a Mon Sep 17 00:00:00 2001
From: Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com>
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(-)

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