Add check mode for use by test suites

This mode makes no changes to files, but returns 0 (success) when no
changes would be made and 1 (failure) when changes would be made.
pull/178/head
Doug Beardsley 2018-09-11 01:25:35 -04:00
parent 8c5cce5070
commit 3729a57196
1 changed files with 45 additions and 23 deletions

View File

@ -156,6 +156,16 @@ mainCmdParser helpDesc = do
"v" "v"
["verbose"] ["verbose"]
(flagHelp $ parDoc "[currently without effect; TODO]") (flagHelp $ parDoc "[currently without effect; TODO]")
checkMode <- addSimpleBoolFlag
"c"
["check-mode"]
(flagHelp
(PP.vcat
[ PP.text "check for changes but do not write them out"
, PP.text "exits with code 0 if no changes necessary, 1 otherwise"
]
)
)
writeMode <- addFlagReadParam writeMode <- addFlagReadParam
"" ""
["write-mode"] ["write-mode"]
@ -209,15 +219,22 @@ mainCmdParser helpDesc = do
$ trace (showConfigYaml config) $ trace (showConfigYaml config)
$ return () $ return ()
results <- zipWithM (coreIO putStrErrLn config suppressOutput) results <- zipWithM (coreIO putStrErrLn config (suppressOutput || checkMode))
inputPaths inputPaths
outputPaths outputPaths
case results of
if checkMode
then when (any (==Changes) (Data.Either.rights results)) $
System.Exit.exitWith (System.Exit.ExitFailure 1)
else case results of
xs | all Data.Either.isRight xs -> pure () xs | all Data.Either.isRight xs -> pure ()
[Left x] -> System.Exit.exitWith (System.Exit.ExitFailure x) [Left x] -> System.Exit.exitWith (System.Exit.ExitFailure x)
_ -> System.Exit.exitWith (System.Exit.ExitFailure 1) _ -> System.Exit.exitWith (System.Exit.ExitFailure 1)
data ChangeStatus = Changes | NoChanges
deriving (Eq)
-- | The main IO parts for the default mode of operation, and after commandline -- | The main IO parts for the default mode of operation, and after commandline
-- and config stuff is processed. -- and config stuff is processed.
coreIO coreIO
@ -229,7 +246,7 @@ coreIO
-- currently not part of program config. -- currently not part of program config.
-> Maybe FilePath.FilePath -- ^ input filepath; stdin if Nothing. -> Maybe FilePath.FilePath -- ^ input filepath; stdin if Nothing.
-> Maybe FilePath.FilePath -- ^ output filepath; stdout if Nothing. -> Maybe FilePath.FilePath -- ^ output filepath; stdout if Nothing.
-> IO (Either Int ()) -- ^ Either an errorNo, or success. -> IO (Either Int ChangeStatus) -- ^ Either an errorNo, or the change status.
coreIO putErrorLnIO config suppressOutput inputPathM outputPathM = coreIO putErrorLnIO config suppressOutput inputPathM outputPathM =
ExceptT.runExceptT $ do ExceptT.runExceptT $ do
let putErrorLn = liftIO . putErrorLnIO :: String -> ExceptT.ExceptT e IO () let putErrorLn = liftIO . putErrorLnIO :: String -> ExceptT.ExceptT e IO ()
@ -268,7 +285,7 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM =
return $ Right True return $ Right True
CPPModeNowarn -> return $ Right True CPPModeNowarn -> return $ Right True
else return $ Right False else return $ Right False
parseResult <- case inputPathM of (parseResult, originalContents) <- case inputPathM of
Nothing -> do Nothing -> do
-- TODO: refactor this hack to not be mixed into parsing logic -- TODO: refactor this hack to not be mixed into parsing logic
let hackF s = if "#include" `isPrefixOf` s let hackF s = if "#include" `isPrefixOf` s
@ -278,11 +295,22 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM =
then List.intercalate "\n" . fmap hackF . lines' then List.intercalate "\n" . fmap hackF . lines'
else id else id
inputString <- liftIO $ System.IO.hGetContents System.IO.stdin inputString <- liftIO $ System.IO.hGetContents System.IO.stdin
liftIO $ parseModuleFromString ghcOptions parseRes <- liftIO $ parseModuleFromString ghcOptions
"stdin" "stdin"
cppCheckFunc cppCheckFunc
(hackTransform inputString) (hackTransform inputString)
Just p -> liftIO $ parseModule ghcOptions p cppCheckFunc return (parseRes, Text.pack inputString)
Just p -> liftIO $ do
parseRes <- parseModule ghcOptions p cppCheckFunc
inputText <- Text.IO.readFile p
-- The above means we read the file twice, but the
-- GHC API does not really expose the source it
-- read. Should be in cache still anyways.
--
-- We do not use TextL.IO.readFile because lazy IO is evil.
-- (not identical -> read is not finished ->
-- handle still open -> write below crashes - evil.)
return (parseRes, inputText)
case parseResult of case parseResult of
Left left -> do Left left -> do
putErrorLn "parse error:" putErrorLn "parse error:"
@ -401,25 +429,19 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM =
& confUnpack & confUnpack
shouldOutput = not suppressOutput && (not hasErrors || outputOnErrs) shouldOutput = not suppressOutput && (not hasErrors || outputOnErrs)
let noChanges = outSText == originalContents
when shouldOutput when shouldOutput
$ addTraceSep (_conf_debug config) $ addTraceSep (_conf_debug config)
$ case outputPathM of $ case outputPathM of
Nothing -> liftIO $ Text.IO.putStr $ outSText Nothing -> liftIO $ Text.IO.putStr $ outSText
Just p -> liftIO $ do Just p -> liftIO $ do
isIdentical <- case inputPathM of let isIdentical = case inputPathM of
Nothing -> pure False Nothing -> False
Just path -> do Just _ -> noChanges
(== outSText) <$> Text.IO.readFile path
-- The above means we read the file twice, but the
-- GHC API does not really expose the source it
-- read. Should be in cache still anyways.
--
-- We do not use TextL.IO.readFile because lazy IO is evil.
-- (not identical -> read is not finished ->
-- handle still open -> write below crashes - evil.)
unless isIdentical $ Text.IO.writeFile p $ outSText unless isIdentical $ Text.IO.writeFile p $ outSText
when hasErrors $ ExceptT.throwE 70 when hasErrors $ ExceptT.throwE 70
return (if noChanges then NoChanges else Changes)
where where
addTraceSep conf = addTraceSep conf =
if or if or