Fix inline disabling of brittany

src-brittany/Main.hs

@@ -217,7 +217,8 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM = ExceptT.runEx
   -- The flag is intentionally misspelled to prevent clashing with
   -- inline-config stuff.
   let hackAroundIncludes = config & _conf_preprocessor & _ppconf_hackAroundIncludes & confUnpack
-  let exactprintOnly     = config & _conf_debug & _dconf_roundtrip_exactprint_only & confUnpack
+  let exactprintOnly     = (config & _conf_roundtrip_exactprint_only & confUnpack)
+                        || (config & _conf_debug & _dconf_roundtrip_exactprint_only & confUnpack)
   let cppCheckFunc dynFlags = if GHC.xopt GHC.Cpp dynFlags
         then case cppMode of
           CPPModeAbort -> do

src-literatetests/Main.hs

@@ -160,9 +160,9 @@ instance Show PPTextWrapper where
 
 defaultTestConfig :: Config
 defaultTestConfig = Config
-  { _conf_version = _conf_version staticDefaultConfig
+  { _conf_version                   = _conf_version staticDefaultConfig
-  , _conf_debug   = _conf_debug staticDefaultConfig
+  , _conf_debug                     = _conf_debug staticDefaultConfig
-  , _conf_layout  = LayoutConfig
+  , _conf_layout                    = LayoutConfig
     { _lconfig_cols                      = coerce (80 :: Int)
     , _lconfig_indentPolicy              = coerce IndentPolicyFree
     , _lconfig_indentAmount              = coerce (2 :: Int)
@@ -178,13 +178,12 @@ defaultTestConfig = Config
     , _lconfig_reformatModulePreamble    = coerce True
     , _lconfig_allowSingleLineExportList = coerce True
     }
-  , _conf_errorHandling = (_conf_errorHandling staticDefaultConfig)
+  , _conf_errorHandling             = (_conf_errorHandling staticDefaultConfig)
     { _econf_omit_output_valid_check = coerce True
     }
-  , _conf_preprocessor = _conf_preprocessor staticDefaultConfig
+  , _conf_preprocessor              = _conf_preprocessor staticDefaultConfig
-  , _conf_forward      = ForwardOptions
+  , _conf_forward = ForwardOptions {_options_ghc = Identity []}
-    { _options_ghc = Identity []
+  , _conf_roundtrip_exactprint_only = coerce True
-    }
   }
 
 contextFreeTestConfig :: Config

src-unittests/TestUtils.hs

@@ -42,9 +42,9 @@ instance Show PPTextWrapper where
 
 defaultTestConfig :: Config
 defaultTestConfig = Config
-  { _conf_version = _conf_version staticDefaultConfig
+  { _conf_version                   = _conf_version staticDefaultConfig
-  , _conf_debug   = _conf_debug staticDefaultConfig
+  , _conf_debug                     = _conf_debug staticDefaultConfig
-  , _conf_layout  = LayoutConfig
+  , _conf_layout                    = LayoutConfig
     { _lconfig_cols                      = coerce (80 :: Int)
     , _lconfig_indentPolicy              = coerce IndentPolicyFree
     , _lconfig_indentAmount              = coerce (2 :: Int)
@@ -60,11 +60,10 @@ defaultTestConfig = Config
     , _lconfig_reformatModulePreamble    = coerce True
     , _lconfig_allowSingleLineExportList = coerce True
     }
-  , _conf_errorHandling = (_conf_errorHandling staticDefaultConfig)
+  , _conf_errorHandling             = (_conf_errorHandling staticDefaultConfig)
     { _econf_ExactPrintFallback = coerce ExactPrintFallbackModeNever
     }
-  , _conf_preprocessor = (_conf_preprocessor staticDefaultConfig)
+  , _conf_preprocessor              = (_conf_preprocessor staticDefaultConfig)
-  , _conf_forward      = ForwardOptions
+  , _conf_forward = ForwardOptions {_options_ghc = Identity []}
-    { _options_ghc = Identity []
+  , _conf_roundtrip_exactprint_only = coerce False
-    }
   }

src/Language/Haskell/Brittany/Internal.hs

@@ -136,27 +136,19 @@ extractCommentConfigs anns (TopLevelDeclNameMap declNameMap) = do
       Butcher.addCmd "-next-binding" nextBinding
       Butcher.addCmd "-Next-Binding" nextBinding
       Butcher.addCmd "-NEXT-BINDING" nextBinding
-      let
+      let disableNextBinding = do
-        disableNextBinding = do
+            Butcher.addCmdImpl
-          Butcher.addCmdImpl
+              ( InlineConfigTargetNextBinding
-            ( InlineConfigTargetNextBinding
+              , mempty { _conf_roundtrip_exactprint_only = pure $ pure True }
-            , mempty
+              )
-              { _conf_debug =
-                mempty { _dconf_roundtrip_exactprint_only = pure $ pure True }
-              }
-            )
       Butcher.addCmd "-disable-next-binding" disableNextBinding
       Butcher.addCmd "-Disable-Next-Binding" disableNextBinding
       Butcher.addCmd "-DISABLE-NEXT-BINDING" disableNextBinding
-      let
+      let disableNextDecl = do
-        disableNextDecl = do
+            Butcher.addCmdImpl
-          Butcher.addCmdImpl
+              ( InlineConfigTargetNextDecl
-            ( InlineConfigTargetNextDecl
+              , mempty { _conf_roundtrip_exactprint_only = pure $ pure True }
-            , mempty
+              )
-              { _conf_debug =
-                mempty { _dconf_roundtrip_exactprint_only = pure $ pure True }
-              }
-            )
       Butcher.addCmd "-disable-next-declaration" disableNextDecl
       Butcher.addCmd "-Disable-Next-Declaration" disableNextDecl
       Butcher.addCmd "-DISABLE-NEXT-DECLARATION" disableNextDecl
@@ -458,7 +450,11 @@ ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do
     let config' = cZipWith fromOptionIdentity config $ mconcat
           (inlineModConf : (catMaybes (mBindingConfs ++ [mDeclConf])))
 
-    toLocal config' filteredAnns $ ppDecl decl
+    toLocal config' filteredAnns
+      $ if (config' & _conf_roundtrip_exactprint_only & confUnpack)
+          then briDocMToPPM (briDocByExactNoComment decl) >>= layoutBriDoc
+          else ppDecl decl
+
   let finalComments = filter
         (fst .> \case
           ExactPrint.AnnComment{} -> True

src/Language/Haskell/Brittany/Internal/Config.hs

@@ -89,6 +89,7 @@ staticDefaultConfig = Config
   , _conf_forward = ForwardOptions
     { _options_ghc = Identity []
     }
+  , _conf_roundtrip_exactprint_only  = coerce False
   }
 
 forwardOptionsSyntaxExtsEnabled :: ForwardOptions
@@ -109,6 +110,7 @@ forwardOptionsSyntaxExtsEnabled = ForwardOptions
     ]
   }
 
+-- brittany-next-binding --columns=200
 cmdlineConfigParser :: CmdParser Identity out (CConfig Option)
 cmdlineConfigParser = do
   -- TODO: why does the default not trigger; ind never should be []!!
@@ -156,7 +158,7 @@ cmdlineConfigParser = 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
+      , _dconf_roundtrip_exactprint_only  = mempty
       }
     , _conf_layout = LayoutConfig
       { _lconfig_cols                      = optionConcat cols
@@ -187,6 +189,7 @@ cmdlineConfigParser = do
     , _conf_forward = ForwardOptions
       { _options_ghc = [ optionsGhc & List.unwords & CmdArgs.splitArgs | not $ null optionsGhc ]
       }
+    , _conf_roundtrip_exactprint_only  = wrapLast $ falseToNothing roundtripOnly
     }
  where
   falseToNothing = Option . Bool.bool Nothing (Just True)

src/Language/Haskell/Brittany/Internal/Config/Types.hs

@@ -145,6 +145,11 @@ data CConfig f = Config
   , _conf_errorHandling :: CErrorHandlingConfig f
   , _conf_forward       :: CForwardOptions f
   , _conf_preprocessor  :: CPreProcessorConfig f
+  , _conf_roundtrip_exactprint_only :: f (Semigroup.Last Bool)
+    -- ^ this field is somewhat of a duplicate of the one in DebugConfig.
+    -- It is used for per-declaration disabling by the inline config
+    -- implementation. Could have re-used the existing field, but felt risky
+    -- to use a "debug" labeled field for non-debug functionality.
   }
   deriving (Generic)
 

src/Language/Haskell/Brittany/Internal/Config/Types/Instances.hs

@@ -119,6 +119,7 @@ instance FromJSON (CConfig Maybe) where
     <*> v .:?= Text.pack "conf_errorHandling"
     <*> v .:?= Text.pack "conf_forward"
     <*> v .:?= Text.pack "conf_preprocessor"
+    <*> v .:?  Text.pack "conf_roundtrip_exactprint_only"
   parseJSON invalid    = Aeson.typeMismatch "Config" invalid
 
 -- Pretends that the value is {} when the key is not present.