diff options
Diffstat (limited to 'haddock-test')
| -rw-r--r-- | haddock-test/haddock-test.cabal | 2 | ||||
| -rw-r--r-- | haddock-test/src/Test/Haddock.hs | 40 | ||||
| -rw-r--r-- | haddock-test/src/Test/Haddock/Config.hs | 6 | 
3 files changed, 40 insertions, 8 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      } | 
