hexagoxel
/
brittany
1
0
Fork 0
Code Issues 117 Pull Requests 5 Packages Projects Releases 5 Wiki Activity

Apply brittany to Main.hs

remotes/felixonmars/release
Lennart Spitzner 2019-06-23 17:15:59 +02:00
parent bd10c3c4ef
commit 033fdc6517
1 changed files with 35 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
src-brittany/Main.hs
View File

@ -57,8 +57,7 @@ data WriteMode = Display | Inplace
instance Read WriteMode where instance Read WriteMode where
readPrec = val "display" Display <|> val "inplace" Inplace readPrec = val "display" Display <|> val "inplace" Inplace
where where val iden v = ReadPrec.lift $ ReadP.string iden >> return v
val iden v = ReadPrec.lift $ ReadP.string iden >> return v
instance Show WriteMode where instance Show WriteMode where
show Display = "display" show Display = "display"
@ -166,11 +165,11 @@ mainCmdParser helpDesc = do
"c" "c"
["check-mode"] ["check-mode"]
(flagHelp (flagHelp
(PP.vcat (PP.vcat
[ PP.text "check for changes but do not write them out" [ PP.text "check for changes but do not write them out"
, PP.text "exits with code 0 if no changes necessary, 1 otherwise" , PP.text "exits with code 0 if no changes necessary, 1 otherwise"
] ]
) )
) )
writeMode <- addFlagReadParam writeMode <- addFlagReadParam
"" ""
@ -226,17 +225,18 @@ mainCmdParser helpDesc = do
$ trace (showConfigYaml config) $ trace (showConfigYaml config)
$ return () $ return ()
results <- zipWithM (coreIO putStrErrLn config (suppressOutput || checkMode)) results <- zipWithM
inputPaths (coreIO putStrErrLn config (suppressOutput || checkMode))
outputPaths inputPaths
outputPaths
if checkMode if checkMode
then when (any (==Changes) (Data.Either.rights results)) $ then when (any (== Changes) (Data.Either.rights results))
System.Exit.exitWith (System.Exit.ExitFailure 1) $ System.Exit.exitWith (System.Exit.ExitFailure 1)
else case results of 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 data ChangeStatus = Changes | NoChanges
@ -278,20 +278,19 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM =
viaDebug = viaDebug =
config & _conf_debug & _dconf_roundtrip_exactprint_only & confUnpack config & _conf_debug & _dconf_roundtrip_exactprint_only & confUnpack
let let cppCheckFunc dynFlags = if GHC.xopt GHC.Cpp dynFlags
cppCheckFunc dynFlags = if GHC.xopt GHC.Cpp dynFlags then case cppMode of
then case cppMode of CPPModeAbort -> do
CPPModeAbort -> do return $ Left "Encountered -XCPP. Aborting."
return $ Left "Encountered -XCPP. Aborting." CPPModeWarn -> do
CPPModeWarn -> do putErrorLnIO
putErrorLnIO $ "Warning: Encountered -XCPP."
$ "Warning: Encountered -XCPP." ++ " Be warned that -XCPP is not supported and that"
++ " Be warned that -XCPP is not supported and that" ++ " brittany cannot check that its output is syntactically"
++ " brittany cannot check that its output is syntactically" ++ " valid in its presence."
++ " valid in its presence." return $ Right True
return $ Right True CPPModeNowarn -> return $ Right True
CPPModeNowarn -> return $ Right True else return $ Right False
else return $ Right False
(parseResult, originalContents) <- 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
@ -308,7 +307,7 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM =
(hackTransform inputString) (hackTransform inputString)
return (parseRes, Text.pack inputString) return (parseRes, Text.pack inputString)
Just p -> liftIO $ do Just p -> liftIO $ do
parseRes <- parseModule ghcOptions p cppCheckFunc parseRes <- parseModule ghcOptions p cppCheckFunc
inputText <- Text.IO.readFile p inputText <- Text.IO.readFile p
-- The above means we read the file twice, but the -- The above means we read the file twice, but the
-- GHC API does not really expose the source it -- GHC API does not really expose the source it
@ -359,13 +358,12 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM =
let hackF s = fromMaybe s $ TextL.stripPrefix let hackF s = fromMaybe s $ TextL.stripPrefix
(TextL.pack "-- BRITANY_INCLUDE_HACK ") (TextL.pack "-- BRITANY_INCLUDE_HACK ")
s s
let let out = TextL.toStrict $ if hackAroundIncludes
out = TextL.toStrict $ if hackAroundIncludes then
then TextL.intercalate (TextL.pack "\n")
TextL.intercalate (TextL.pack "\n") $ fmap hackF
$ fmap hackF $ TextL.splitOn (TextL.pack "\n") outRaw
$ TextL.splitOn (TextL.pack "\n") outRaw else outRaw
else outRaw
out' <- if moduleConf & _conf_obfuscate & confUnpack out' <- if moduleConf & _conf_obfuscate & confUnpack
then lift $ obfuscate out then lift $ obfuscate out
else pure out else pure out