aboutsummaryrefslogtreecommitdiff
path: root/haddock-test/src/Test
diff options
context:
space:
mode:
authorAlec Theriault <alec.theriault@gmail.com>2018-06-14 12:42:45 -0700
committerAlexander Biehl <alexbiehl@gmail.com>2018-06-14 21:42:45 +0200
commit5b25163bad9c28040fdc61555659b4b4b6168032 (patch)
treee209c13491c1a9b8d0ee03b3a485eba52969e082 /haddock-test/src/Test
parent6247ec8b5a5bc8145ce851dce11eb617a380381c (diff)
Improved handling of interfaces in 'haddock-test' (#851)
This should now work with an inplace GHC where (for instance) HTML directories may not be properly recorded in the package DB.
Diffstat (limited to 'haddock-test/src/Test')
-rw-r--r--haddock-test/src/Test/Haddock/Config.hs42
1 files changed, 36 insertions, 6 deletions
diff --git a/haddock-test/src/Test/Haddock/Config.hs b/haddock-test/src/Test/Haddock/Config.hs
index 8b395b6c..51032a3a 100644
--- a/haddock-test/src/Test/Haddock/Config.hs
+++ b/haddock-test/src/Test/Haddock/Config.hs
@@ -15,8 +15,9 @@ import Control.Monad
import qualified Data.List as List
import Data.Maybe
+import Distribution.Text
+import Distribution.Types.PackageName
import Distribution.InstalledPackageInfo
-import Distribution.Package
import Distribution.Simple.Compiler hiding (Flag)
import Distribution.Simple.GHC
import Distribution.Simple.PackageIndex
@@ -256,15 +257,44 @@ baseDependencies ghcPath = do
concat `fmap` mapM (getDependency pkgIndex) pkgs
where
getDependency pkgIndex name = case ifaces pkgIndex name of
- [] -> do
- hPutStrLn stderr $ "Couldn't find base test dependency: " ++ name
+ [] -> do
+ hPutStrLn stderr $ "Couldn't find base test dependency: " ++ name
+ exitFailure
+
+ (unit, ifaceOpt, htmlOpt) : alts -> do
+ when (not . null $ alts) $
+ hPutStr stderr $ unlines
+ [ "Multiple options found for base test dependency: " ++ name
+ , "Choosing the first of these, which has unit id: " ++ unit
+ ]
+
+ case (ifaceOpt, htmlOpt) of
+ (Nothing, _) -> do
+ hPutStr stderr $
+ "No '.haddock' file found for base test dependency: " ++ name
exitFailure
- (ifArg:_) -> pure ["--optghc=-package" ++ name, ifArg]
+
+ (Just iface, Nothing) -> do
+ hPutStrLn stderr $
+ "No HTML directory found for base test dependency: " ++ name
+ pure [ "--optghc=-package" ++ name
+ , "--read-interface=" ++ iface
+ ]
+
+ (Just iface, Just html) ->
+ pure [ "--optghc=-package" ++ name
+ , "--read-interface=" ++ html ++ "," ++ iface
+ ]
+
ifaces pkgIndex name = do
pkg <- join $ snd <$> lookupPackageName pkgIndex (mkPackageName name)
- iface <$> haddockInterfaces pkg <*> haddockHTMLs pkg
- iface file html = "--read-interface=" ++ html ++ "," ++ file
+ let unitId = display (installedUnitId pkg)
+ ifaceOpt = listToMaybe (haddockInterfaces pkg)
+ htmlDirOpt = listToMaybe (haddockHTMLs pkg)
+
+ pure (unitId, ifaceOpt, htmlDirOpt)
+
defaultDiffTool :: IO (Maybe FilePath)
defaultDiffTool =