diff options
Diffstat (limited to 'haddock-test/src/Test')
-rw-r--r-- | haddock-test/src/Test/Haddock.hs | 4 | ||||
-rw-r--r-- | haddock-test/src/Test/Haddock/Config.hs | 42 | ||||
-rw-r--r-- | haddock-test/src/Test/Haddock/Xhtml.hs | 3 |
3 files changed, 40 insertions, 9 deletions
diff --git a/haddock-test/src/Test/Haddock.hs b/haddock-test/src/Test/Haddock.hs index f372f773..942c0587 100644 --- a/haddock-test/src/Test/Haddock.hs +++ b/haddock-test/src/Test/Haddock.hs @@ -158,7 +158,9 @@ maybeAcceptFile :: Config c -> FilePath -> CheckResult -> IO CheckResult maybeAcceptFile cfg file result | cfgAccept cfg && result `elem` [NoRef, Fail] = do Just out <- readOut cfg file - writeFile (refFile dcfg file) $ ccfgDump ccfg out + let ref = refFile dcfg file + createDirectoryIfMissing True (takeDirectory ref) + writeFile ref $ ccfgDump ccfg out pure Accepted where dcfg = cfgDirConfig cfg 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 = diff --git a/haddock-test/src/Test/Haddock/Xhtml.hs b/haddock-test/src/Test/Haddock/Xhtml.hs index 69361f7c..8bfc973f 100644 --- a/haddock-test/src/Test/Haddock/Xhtml.hs +++ b/haddock-test/src/Test/Haddock/Xhtml.hs @@ -1,6 +1,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StandaloneDeriving #-} - +{-# OPTIONS_GHC -fno-warn-orphans #-} module Test.Haddock.Xhtml ( Xml(..) @@ -22,7 +22,6 @@ newtype Xml = Xml } deriving Eq --- TODO: Find a way to avoid warning about orphan instances. deriving instance Eq Element deriving instance Eq Content deriving instance Eq CData |