aboutsummaryrefslogtreecommitdiff
path: root/haddock-test/src/Test/Haddock
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-test/src/Test/Haddock')
-rw-r--r--haddock-test/src/Test/Haddock/Config.hs50
1 files changed, 34 insertions, 16 deletions
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"]