From 16f5aa118d707cc484cdee39351b176b6d17c3df Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Sat, 3 Jun 2017 20:59:18 +0200 Subject: [PATCH] Add flag to omit reformatting (ghc-exactprint only) --- src-brittany/Main.hs | 28 ++++++++++++------- .../Haskell/Brittany/Internal/Config.hs | 3 ++ .../Haskell/Brittany/Internal/Config/Types.hs | 2 ++ 3 files changed, 23 insertions(+), 10 deletions(-) diff --git a/src-brittany/Main.hs b/src-brittany/Main.hs index 1d060ad..0acdaff 100644 --- a/src-brittany/Main.hs +++ b/src-brittany/Main.hs @@ -153,13 +153,13 @@ mainCmdParser helpDesc = do -- amount of slight differences: This module is a bit more verbose, and -- it tries to use the full-blown `parseModule` function which supports -- CPP (but requires the input to be a file..). - let cppMode = config & _conf_preprocessor & _ppconf_CPPMode & runIdentity & Semigroup.getLast + let cppMode = config & _conf_preprocessor & _ppconf_CPPMode & confUnpack -- the flag will do the following: insert a marker string -- ("-- BRITTANY_INCLUDE_HACK ") right before any lines starting with -- "#include" before processing (parsing) input; and remove that marker -- string from the transformation output. - let hackAroundIncludes = - config & _conf_preprocessor & _ppconf_hackAroundIncludes & runIdentity & Semigroup.getLast + let hackAroundIncludes = config & _conf_preprocessor & _ppconf_hackAroundIncludes & confUnpack + let exactprintOnly = config & _conf_debug & _dconf_roundtrip_exactprint_only & confUnpack let cppCheckFunc dynFlags = if GHC.xopt GHC.Cpp dynFlags then case cppMode of CPPModeAbort -> do @@ -175,8 +175,10 @@ mainCmdParser helpDesc = do else return $ Right False parseResult <- case inputPathM of Nothing -> do + -- TODO: refactor this hack to not be mixed into parsing logic let hackF s = if "#include" `isPrefixOf` s then "-- BRITTANY_INCLUDE_HACK " ++ s else s - let hackTransform = if hackAroundIncludes then List.unlines . fmap hackF . List.lines else id + let hackTransform = + if hackAroundIncludes && not exactprintOnly then List.unlines . fmap hackF . List.lines else id inputString <- System.IO.hGetContents System.IO.stdin parseModuleFromString ghcOptions "stdin" cppCheckFunc (hackTransform inputString) Just p -> parseModule ghcOptions p cppCheckFunc @@ -190,12 +192,18 @@ mainCmdParser helpDesc = do let val = printTreeWithCustom 100 (customLayouterF anns) parsedSource trace ("---- ast ----\n" ++ show val) $ return () (errsWarns, outLText) <- do - let omitCheck = config & _conf_errorHandling .> _econf_omit_output_valid_check .> confUnpack - (ews, outRaw) <- if hasCPP || omitCheck - then return $ pPrintModule config anns parsedSource - else pPrintModuleAndCheck config anns parsedSource - let hackF s = fromMaybe s $ TextL.stripPrefix (TextL.pack "-- BRITTANY_INCLUDE_HACK ") s - pure $ if hackAroundIncludes then (ews, TextL.unlines $ fmap hackF $ TextL.lines outRaw) else (ews, outRaw) + if exactprintOnly + then do + pure ([], TextL.pack $ ExactPrint.exactPrint parsedSource anns) + else do + let omitCheck = config & _conf_errorHandling .> _econf_omit_output_valid_check .> confUnpack + (ews, outRaw) <- if hasCPP || omitCheck + then return $ pPrintModule config anns parsedSource + else pPrintModuleAndCheck config anns parsedSource + let hackF s = fromMaybe s $ TextL.stripPrefix (TextL.pack "-- BRITTANY_INCLUDE_HACK ") s + pure $ if hackAroundIncludes + then (ews, TextL.unlines $ fmap hackF $ TextL.lines outRaw) + else (ews, outRaw) let customErrOrder ErrorInput{} = 4 customErrOrder LayoutWarning{} = 0 :: Int customErrOrder ErrorOutputCheck{} = 1 diff --git a/src/Language/Haskell/Brittany/Internal/Config.hs b/src/Language/Haskell/Brittany/Internal/Config.hs index 53b10d4..593e616 100644 --- a/src/Language/Haskell/Brittany/Internal/Config.hs +++ b/src/Language/Haskell/Brittany/Internal/Config.hs @@ -57,6 +57,8 @@ configParser = do wError <- addSimpleBoolFlag "" ["werror"] (flagHelp $ parDoc "treat warnings as errors") omitValidCheck <- addSimpleBoolFlag "" ["omit-output-check"] (flagHelp $ parDoc "omit checking if the output is syntactically valid; for dev on brittany") + roundtripOnly <- addSimpleBoolFlag "" ["exactprint-only"] (flagHelp $ parDoc "do not reformat, but exclusively use exactprint to roundtrip (debugging)") + optionsGhc <- addFlagStringParams "" ["ghc-options"] "STRING" @@ -76,6 +78,7 @@ configParser = do , _dconf_dump_bridoc_simpl_columns = wrapLast $ falseToNothing dumpBriDocColumns , _dconf_dump_bridoc_simpl_indent = wrapLast $ falseToNothing dumpBriDocIndent , _dconf_dump_bridoc_final = wrapLast $ falseToNothing dumpBriDocFinal + , _dconf_roundtrip_exactprint_only = wrapLast $ falseToNothing roundtripOnly } , _conf_layout = LayoutConfig { _lconfig_cols = optionConcat cols diff --git a/src/Language/Haskell/Brittany/Internal/Config/Types.hs b/src/Language/Haskell/Brittany/Internal/Config/Types.hs index 806e085..243bf98 100644 --- a/src/Language/Haskell/Brittany/Internal/Config/Types.hs +++ b/src/Language/Haskell/Brittany/Internal/Config/Types.hs @@ -41,6 +41,7 @@ data CDebugConfig f = DebugConfig , _dconf_dump_bridoc_simpl_columns :: f (Semigroup.Last Bool) , _dconf_dump_bridoc_simpl_indent :: f (Semigroup.Last Bool) , _dconf_dump_bridoc_final :: f (Semigroup.Last Bool) + , _dconf_roundtrip_exactprint_only :: f (Semigroup.Last Bool) } deriving (Generic) @@ -331,6 +332,7 @@ staticDefaultConfig = Config , _dconf_dump_bridoc_simpl_columns = coerce False , _dconf_dump_bridoc_simpl_indent = coerce False , _dconf_dump_bridoc_final = coerce False + , _dconf_roundtrip_exactprint_only = coerce False } , _conf_layout = LayoutConfig { _lconfig_cols = coerce (80 :: Int)