aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--haddock-test/haddock-test.cabal2
-rw-r--r--haddock-test/src/Test/Haddock.hs40
-rw-r--r--haddock-test/src/Test/Haddock/Config.hs6
-rw-r--r--hoogle-test/Main.hs3
-rwxr-xr-xhtml-test/Main.hs3
-rw-r--r--hypsrc-test/Main.hs3
-rwxr-xr-xlatex-test/Main.hs3
7 files changed, 48 insertions, 12 deletions
diff --git a/haddock-test/haddock-test.cabal b/haddock-test/haddock-test.cabal
index 0394da8f..2b75ea81 100644
--- a/haddock-test/haddock-test.cabal
+++ b/haddock-test/haddock-test.cabal
@@ -16,7 +16,7 @@ library
default-language: Haskell2010
ghc-options: -Wall
hs-source-dirs: src
- build-depends: base, directory, process, filepath, Cabal, xml, xhtml, syb
+ build-depends: base, bytestring, directory, process, filepath, Cabal, xml, xhtml, syb
exposed-modules:
Test.Haddock
diff --git a/haddock-test/src/Test/Haddock.hs b/haddock-test/src/Test/Haddock.hs
index e8a0ac8e..6041c77c 100644
--- a/haddock-test/src/Test/Haddock.hs
+++ b/haddock-test/src/Test/Haddock.hs
@@ -16,6 +16,7 @@ import System.Exit
import System.FilePath
import System.IO
import System.Process
+import qualified Data.ByteString.Char8 as BS
import Test.Haddock.Config
import Test.Haddock.Process
@@ -95,8 +96,8 @@ checkFile cfg file = do
hasRef <- doesFileExist $ refFile dcfg file
if hasRef
then do
- mout <- ccfgRead ccfg file <$> readFile (outFile dcfg file)
- mref <- ccfgRead ccfg file <$> readFile (refFile dcfg file)
+ mout <- readOut cfg file
+ mref <- readRef cfg file
return $ case (mout, mref) of
(Just out, Just ref)
| ccfgEqual ccfg out ref -> Pass
@@ -107,11 +108,34 @@ checkFile cfg file = do
ccfg = cfgCheckConfig cfg
dcfg = cfgDirConfig cfg
+-- We use ByteString here to ensure that no lazy I/O is performed.
+-- This way to ensure that the reference file isn't held open in
+-- case after `diffFile` (which is problematic if we need to rewrite
+-- the reference file in `maybeAcceptFile`)
+
+-- | Read the reference artifact for a test
+readRef :: Config c -> FilePath -> IO (Maybe c)
+readRef cfg file =
+ ccfgRead ccfg . BS.unpack
+ <$> BS.readFile (refFile dcfg file)
+ where
+ ccfg = cfgCheckConfig cfg
+ dcfg = cfgDirConfig cfg
+
+-- | Read (and clean) the test output artifact for a test
+readOut :: Config c -> FilePath -> IO (Maybe c)
+readOut cfg file =
+ fmap (ccfgClean ccfg file) . ccfgRead ccfg . BS.unpack
+ <$> BS.readFile (outFile dcfg file)
+ where
+ ccfg = cfgCheckConfig cfg
+ dcfg = cfgDirConfig cfg
+
diffFile :: Config c -> FilePath -> FilePath -> IO ()
diffFile cfg diff file = do
- Just out <- ccfgRead ccfg file <$> readFile (outFile dcfg file)
- Just ref <- ccfgRead ccfg file <$> readFile (refFile dcfg file)
+ Just out <- readOut cfg file
+ Just ref <- readRef cfg file
writeFile outFile' $ ccfgDump ccfg out
writeFile refFile' $ ccfgDump ccfg ref
@@ -130,10 +154,14 @@ diffFile cfg diff file = do
maybeAcceptFile :: Config c -> FilePath -> CheckResult -> IO CheckResult
-maybeAcceptFile cfg@(Config { cfgDirConfig = dcfg }) file result
+maybeAcceptFile cfg file result
| cfgAccept cfg && result `elem` [NoRef, Fail] = do
- copyFile' (outFile dcfg file) (refFile dcfg file)
+ Just out <- readOut cfg file
+ writeFile (refFile dcfg file) $ ccfgDump ccfg out
pure Accepted
+ where
+ dcfg = cfgDirConfig cfg
+ ccfg = cfgCheckConfig cfg
maybeAcceptFile _ _ result = pure result
diff --git a/haddock-test/src/Test/Haddock/Config.hs b/haddock-test/src/Test/Haddock/Config.hs
index cd878178..dea101d8 100644
--- a/haddock-test/src/Test/Haddock/Config.hs
+++ b/haddock-test/src/Test/Haddock/Config.hs
@@ -42,7 +42,11 @@ data TestPackage = TestPackage
data CheckConfig c = CheckConfig
- { ccfgRead :: String -> String -> Maybe c
+ { ccfgRead :: String -> Maybe c
+ -- ^ @f contents@ parses file contents @contents@ to
+ -- produce a thing to be compared.
+ , ccfgClean :: String -> c -> c
+ -- ^ @f fname x@ cleans @x@ to such that it can be compared
, ccfgDump :: c -> String
, ccfgEqual :: c -> c -> Bool
}
diff --git a/hoogle-test/Main.hs b/hoogle-test/Main.hs
index c8cda640..59a98fd0 100644
--- a/hoogle-test/Main.hs
+++ b/hoogle-test/Main.hs
@@ -9,7 +9,8 @@ import Test.Haddock
checkConfig :: CheckConfig String
checkConfig = CheckConfig
- { ccfgRead = \_ input -> Just input
+ { ccfgRead = Just
+ , ccfgClean = \_ -> id
, ccfgDump = id
, ccfgEqual = (==)
}
diff --git a/html-test/Main.hs b/html-test/Main.hs
index 3880fc3c..02a86d43 100755
--- a/html-test/Main.hs
+++ b/html-test/Main.hs
@@ -12,7 +12,8 @@ import Test.Haddock.Xhtml
checkConfig :: CheckConfig Xml
checkConfig = CheckConfig
- { ccfgRead = \mdl input -> stripIfRequired mdl <$> parseXml input
+ { ccfgRead = parseXml
+ , ccfgClean = stripIfRequired
, ccfgDump = dumpXml
, ccfgEqual = (==)
}
diff --git a/hypsrc-test/Main.hs b/hypsrc-test/Main.hs
index 0490be47..01cc5429 100644
--- a/hypsrc-test/Main.hs
+++ b/hypsrc-test/Main.hs
@@ -13,7 +13,8 @@ import Test.Haddock.Xhtml
checkConfig :: CheckConfig Xml
checkConfig = CheckConfig
- { ccfgRead = \_ input -> strip <$> parseXml input
+ { ccfgRead = parseXml
+ , ccfgClean = \_ -> strip
, ccfgDump = dumpXml
, ccfgEqual = (==)
}
diff --git a/latex-test/Main.hs b/latex-test/Main.hs
index 2ee01a26..5989410b 100755
--- a/latex-test/Main.hs
+++ b/latex-test/Main.hs
@@ -9,7 +9,8 @@ import Test.Haddock
checkConfig :: CheckConfig String
checkConfig = CheckConfig
- { ccfgRead = \_ input -> Just input
+ { ccfgRead = Just
+ , ccfgClean = \_ -> id
, ccfgDump = id
, ccfgEqual = (==)
}