From 5568091a53ee53f742b6fe9f11b3edd1664228b9 Mon Sep 17 00:00:00 2001 From: Ɓukasz Hanuszczak Date: Mon, 17 Aug 2015 12:54:48 +0200 Subject: Implement output accepting mechanism in test package. --- haddock-test/src/Test/Haddock.hs | 16 +++++++++++++++- haddock-test/src/Test/Haddock/Config.hs | 6 ++++++ 2 files changed, 21 insertions(+), 1 deletion(-) (limited to 'haddock-test') diff --git a/haddock-test/src/Test/Haddock.hs b/haddock-test/src/Test/Haddock.hs index 78204840..a2c6609a 100644 --- a/haddock-test/src/Test/Haddock.hs +++ b/haddock-test/src/Test/Haddock.hs @@ -29,7 +29,11 @@ data CheckResult runAndCheck :: Config c -> IO () -runAndCheck cfg = runHaddock cfg >> checkFiles cfg +runAndCheck cfg = do + runHaddock cfg + if cfgAccept cfg + then acceptFiles cfg + else checkFiles cfg checkFiles :: Config c -> IO () @@ -55,6 +59,16 @@ checkFiles cfg@(Config { .. }) = do exitFailure +acceptFiles :: Config c -> IO () +acceptFiles (Config { cfgFiles = files, cfgDirConfig = dcfg }) = do + + forM_ files $ \file -> do + let mdl = takeBaseName file + putStr $ "Accepting " ++ mdl ++ "... " + copyFile (outFile dcfg mdl) (refFile dcfg mdl) + putStrLn "DONE" + + maybeDiff :: Config c -> [String] -> IO () maybeDiff (Config { cfgDiffTool = Nothing }) _ = pure () maybeDiff cfg@(Config { cfgDiffTool = (Just diff) }) mdls = do diff --git a/haddock-test/src/Test/Haddock/Config.hs b/haddock-test/src/Test/Haddock/Config.hs index 4f6bb818..451cd809 100644 --- a/haddock-test/src/Test/Haddock/Config.hs +++ b/haddock-test/src/Test/Haddock/Config.hs @@ -68,6 +68,7 @@ data Config c = Config , cfgHaddockStdOut :: FilePath , cfgDiffTool :: Maybe FilePath , cfgEnv :: Environment + , cfgAccept :: Bool , cfgCheckConfig :: CheckConfig c , cfgDirConfig :: DirConfig } @@ -87,6 +88,7 @@ data Flag | FlagHaddockStdOut FilePath | FlagDiffTool FilePath | FlagNoDiff + | FlagAccept | FlagHelp deriving Eq @@ -118,6 +120,8 @@ options = "where to redirect Haddock output" , Option [] ["diff-tool"] (ReqArg FlagDiffTool "PATH") "diff tool to use when printing failed cases" + , Option ['a'] ["accept"] (NoArg FlagAccept) + "accept generated output" , Option [] ["no-diff"] (NoArg FlagNoDiff) "do not print diff for failed cases" , Option ['h'] ["help"] (NoArg FlagHelp) @@ -178,6 +182,8 @@ loadConfig ccfg dcfg flags files = do then pure Nothing else (<|>) <$> pure (flagsDiffTool flags) <*> defaultDiffTool + let cfgAccept = FlagAccept `elem` flags + let cfgCheckConfig = ccfg let cfgDirConfig = dcfg -- cgit v1.2.3