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
parent
8c5cce5070
commit
3729a57196
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue