Add flag to omit reformatting (ghc-exactprint only)

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

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

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)