From e614916d940943a1f4f7cd77d9957246d164ab1d Mon Sep 17 00:00:00 2001
From: Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com>
Date: Tue, 18 Aug 2015 18:47:11 +0200
Subject: Make Haddock test package more generic.

---
 haddock-test/src/Test/Haddock/Config.hs | 50 ++++++++++++++++++++++-----------
 1 file changed, 34 insertions(+), 16 deletions(-)

(limited to 'haddock-test/src/Test/Haddock')

diff --git a/haddock-test/src/Test/Haddock/Config.hs b/haddock-test/src/Test/Haddock/Config.hs
index 451cd809..15a53829 100644
--- a/haddock-test/src/Test/Haddock/Config.hs
+++ b/haddock-test/src/Test/Haddock/Config.hs
@@ -2,7 +2,7 @@
 
 
 module Test.Haddock.Config
-    ( CheckConfig(..), DirConfig(..), Config(..)
+    ( TestPackage(..), CheckConfig(..), DirConfig(..), Config(..)
     , defaultDirConfig
     , cfgSrcDir, cfgRefDir, cfgOutDir, cfgResDir
     , parseArgs, checkOpt, loadConfig
@@ -35,6 +35,12 @@ import Test.Haddock.Process
 import Test.Haddock.Utils
 
 
+data TestPackage = TestPackage
+    { tpkgName :: String
+    , tpkgFiles :: [FilePath]
+    }
+
+
 data CheckConfig c = CheckConfig
     { ccfgRead :: String -> String -> Maybe c
     , ccfgDump :: c -> String
@@ -63,7 +69,7 @@ defaultDirConfig baseDir = DirConfig
 
 data Config c = Config
     { cfgHaddockPath :: FilePath
-    , cfgFiles :: [FilePath]
+    , cfgPackages :: [TestPackage]
     , cfgHaddockArgs :: [String]
     , cfgHaddockStdOut :: FilePath
     , cfgDiffTool :: Maybe FilePath
@@ -164,7 +170,7 @@ loadConfig ccfg dcfg flags files = do
 
     printVersions cfgEnv cfgHaddockPath
 
-    cfgFiles <- processFileArgs dcfg files
+    cfgPackages <- processFileArgs dcfg files
 
     cfgHaddockArgs <- liftM concat . sequence $
         [ pure ["--no-warnings"]
@@ -230,24 +236,36 @@ defaultDiffTool =
     isAvailable = liftM isJust . findProgramLocation silent
 
 
-processFileArgs :: DirConfig -> [String] -> IO [FilePath]
+processFileArgs :: DirConfig -> [String] -> IO [TestPackage]
 processFileArgs dcfg [] =
-    map toModulePath . filter isSourceFile <$> getDirectoryContents srcDir
+    processFileArgs dcfg . filter isValidEntry =<< getDirectoryContents srcDir
   where
+    isValidEntry entry = entry /= "." && entry /= ".."
     srcDir = dcfgSrcDir dcfg
-    toModulePath = modulePath dcfg . takeBaseName
-processFileArgs dcfg args = pure $ map (processFileArg dcfg) args
+processFileArgs dcfg args = processFileArgs' dcfg args
+
+
+processFileArgs' :: DirConfig -> [String] -> IO [TestPackage]
+processFileArgs' dcfg args = do
+    (mdls, dirs) <- partitionM doesDirectoryExist' args
+    rootPkg <- pure $ TestPackage
+        { tpkgName = ""
+        , tpkgFiles = map (processFileArg dcfg) mdls
+        }
+    otherPkgs <- forM dirs $ \dir -> do
+        files <- getDirectoryContents dir
+        pure $ TestPackage
+            { tpkgName = dir
+            , tpkgFiles = map ((dcfgSrcDir dcfg </> dir) </>) files
+            }
+    pure $ rootPkg:otherPkgs
+  where
+    doesDirectoryExist' path = doesDirectoryExist (dcfgSrcDir dcfg </> path)
 
 
 processFileArg :: DirConfig -> String -> FilePath
 processFileArg dcfg arg
     | isSourceFile arg = arg
-    | otherwise = modulePath dcfg arg
-
-
-isSourceFile :: FilePath -> Bool
-isSourceFile path = takeExtension path `elem` [".hs", ".lhs"]
-
-
-modulePath :: DirConfig -> String -> FilePath
-modulePath dcfg mdl = dcfgSrcDir dcfg </> mdl <.> "hs"
+    | otherwise = dcfgSrcDir dcfg </> arg </> ".hs"
+  where
+    isSourceFile path = takeExtension path `elem` [".hs", ".lhs"]
-- 
cgit v1.2.3