Introduce flag to disable formatting per-module

New inline config `-- brittany-disable` that parses but
ignores the current module. Useful if both brittany
and ghc-exactprint bug out for some syntax.

src-brittany/Main.hs

@@ -343,11 +343,16 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM =
         when (config & _conf_debug & _dconf_dump_ast_full & confUnpack) $ do
           let val = printTreeWithCustom 100 (customLayouterF anns) parsedSource
           trace ("---- ast ----\n" ++ show val) $ return ()
-        (errsWarns, outSText) <- do
+        let disableFormatting =
-          if exactprintOnly
+              moduleConf & _conf_disable_formatting & confUnpack
-            then do
+        (errsWarns, outSText, hasChanges) <- do
-              pure ([], Text.pack $ ExactPrint.exactPrint parsedSource anns)
+          if
-            else do
+            | disableFormatting -> do
+              pure ([], originalContents, False)
+            | exactprintOnly -> do
+              let r = Text.pack $ ExactPrint.exactPrint parsedSource anns
+              pure ([], r, r /= originalContents)
+            | otherwise -> do
               let omitCheck =
                     moduleConf
                       &  _conf_errorHandling
@@ -372,7 +377,7 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM =
               out' <- if moduleConf & _conf_obfuscate & confUnpack
                 then lift $ obfuscate out
                 else pure out
-              pure $ (ews, out')
+              pure $ (ews, out', out' /= originalContents)
         let customErrOrder ErrorInput{}         = 4
             customErrOrder LayoutWarning{}      = -1 :: Int
             customErrOrder ErrorOutputCheck{}   = 1
@@ -440,7 +445,6 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM =
               & confUnpack
           shouldOutput = not suppressOutput && (not hasErrors || outputOnErrs)
 
-        let noChanges = outSText == originalContents
         when shouldOutput
           $ addTraceSep (_conf_debug config)
           $ case outputPathM of
@@ -448,11 +452,11 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM =
               Just p  -> liftIO $ do
                 let isIdentical = case inputPathM of
                       Nothing -> False
-                      Just _  -> noChanges
+                      Just _  -> not hasChanges
                 unless isIdentical $ Text.IO.writeFile p $ outSText
 
         when hasErrors $ ExceptT.throwE 70
-        return (if noChanges then NoChanges else Changes)
+        return (if hasChanges then Changes else NoChanges)
  where
   addTraceSep conf =
     if or

src-literatetests/Main.hs

@@ -220,6 +220,7 @@ defaultTestConfig = Config
   , _conf_preprocessor              = _conf_preprocessor staticDefaultConfig
   , _conf_forward                   = ForwardOptions { _options_ghc = Identity [] }
   , _conf_roundtrip_exactprint_only = coerce False
+  , _conf_disable_formatting        = coerce False
   , _conf_obfuscate                 = coerce False
   }
 

src-unittests/TestUtils.hs

@@ -69,5 +69,6 @@ defaultTestConfig = Config
   , _conf_preprocessor              = (_conf_preprocessor staticDefaultConfig)
   , _conf_forward = ForwardOptions {_options_ghc = Identity []}
   , _conf_roundtrip_exactprint_only = coerce False
+  , _conf_disable_formatting = coerce False
   , _conf_obfuscate = coerce False
   }

src/Language/Haskell/Brittany/Internal.hs

@@ -160,6 +160,12 @@ extractCommentConfigs anns (TopLevelDeclNameMap declNameMap) = do
       Butcher.addCmd "-disable-next-declaration" disableNextDecl
       Butcher.addCmd "-Disable-Next-Declaration" disableNextDecl
       Butcher.addCmd "-DISABLE-NEXT-DECLARATION" disableNextDecl
+      let disableFormatting = do
+            Butcher.addCmdImpl
+              ( InlineConfigTargetModule
+              , mempty { _conf_disable_formatting = pure $ pure True }
+              )
+      Butcher.addCmd "-disable" disableFormatting
       Butcher.addCmd "@" $ do
         -- Butcher.addCmd "module" $ do
         --   conf <- configParser
@@ -266,38 +272,47 @@ parsePrintModule configWithDebugs inputText = runExceptT $ do
   (inlineConf, perItemConf) <-
     either (throwE . (: []) . uncurry ErrorMacroConfig) pure
       $ extractCommentConfigs anns (getTopLevelDeclNameMap parsedSource)
-  let moduleConfig = cZipWith fromOptionIdentity config inlineConf
+  let moduleConfig      = cZipWith fromOptionIdentity config inlineConf
-  (errsWarns, outputTextL) <- do
+  let disableFormatting = moduleConfig & _conf_disable_formatting & confUnpack
-    let omitCheck =
+  if disableFormatting
-          moduleConfig
+    then do
-            & _conf_errorHandling
+      return inputText
-            & _econf_omit_output_valid_check
+    else do
-            & confUnpack
+      (errsWarns, outputTextL) <- do
-    (ews, outRaw) <- if hasCPP || omitCheck
+        let omitCheck =
-      then return $ pPrintModule moduleConfig perItemConf anns parsedSource
+              moduleConfig
-      else lift
+                & _conf_errorHandling
-        $ pPrintModuleAndCheck moduleConfig perItemConf anns parsedSource
+                & _econf_omit_output_valid_check
-    let hackF s = fromMaybe s
+                & confUnpack
-          $ TextL.stripPrefix (TextL.pack "-- BRITANY_INCLUDE_HACK ") s
+        (ews, outRaw) <- if hasCPP || omitCheck
-    pure $ if hackAroundIncludes
+          then return $ pPrintModule moduleConfig perItemConf anns parsedSource
-      then
+          else lift
-        ( ews
+            $ pPrintModuleAndCheck moduleConfig perItemConf anns parsedSource
-        , TextL.intercalate (TextL.pack "\n") $ fmap hackF $ TextL.splitOn
+        let hackF s = fromMaybe s
-          (TextL.pack "\n")
+              $ TextL.stripPrefix (TextL.pack "-- BRITANY_INCLUDE_HACK ") s
-          outRaw
+        pure $ if hackAroundIncludes
-        )
+          then
-      else (ews, outRaw)
+            ( ews
-  let customErrOrder ErrorInput{}         = 4
+            , TextL.intercalate (TextL.pack "\n") $ fmap hackF $ TextL.splitOn
-      customErrOrder LayoutWarning{}      = 0 :: Int
+              (TextL.pack "\n")
-      customErrOrder ErrorOutputCheck{}   = 1
+              outRaw
-      customErrOrder ErrorUnusedComment{} = 2
+            )
-      customErrOrder ErrorUnknownNode{}   = 3
+          else (ews, outRaw)
-      customErrOrder ErrorMacroConfig{}   = 5
+      let customErrOrder ErrorInput{}         = 4
-  let hasErrors =
+          customErrOrder LayoutWarning{}      = 0 :: Int
-        case moduleConfig & _conf_errorHandling & _econf_Werror & confUnpack of
+          customErrOrder ErrorOutputCheck{}   = 1
-          False -> 0 < maximum (-1 : fmap customErrOrder errsWarns)
+          customErrOrder ErrorUnusedComment{} = 2
-          True  -> not $ null errsWarns
+          customErrOrder ErrorUnknownNode{}   = 3
-  if hasErrors then throwE $ errsWarns else pure $ TextL.toStrict outputTextL
+          customErrOrder ErrorMacroConfig{}   = 5
+      let hasErrors =
+            case
+                moduleConfig & _conf_errorHandling & _econf_Werror & confUnpack
+              of
+                False -> 0 < maximum (-1 : fmap customErrOrder errsWarns)
+                True  -> not $ null errsWarns
+      if hasErrors
+        then throwE $ errsWarns
+        else pure $ TextL.toStrict outputTextL
 
 
 
@@ -459,6 +474,7 @@ ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do
           $ mconcat (catMaybes (mBindingConfs ++ [mDeclConf]))
 
     let exactprintOnly = config' & _conf_roundtrip_exactprint_only & confUnpack
+    when exactprintOnly $ mTell $ Text.Builder.fromText $ Text.pack "abc"
     toLocal config' filteredAnns $ do
       bd <- if exactprintOnly
         then briDocMToPPM $ briDocByExactNoComment decl

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

@@ -93,6 +93,7 @@ staticDefaultConfig = Config
     { _options_ghc = Identity []
     }
   , _conf_roundtrip_exactprint_only  = coerce False
+  , _conf_disable_formatting         = coerce False
   , _conf_obfuscate                  = coerce False
   }
 
@@ -147,6 +148,7 @@ cmdlineConfigParser = do
                                            ["ghc-options"]
                                            "STRING"
                                            (flagHelp $ parDoc "allows to define default language extensions. The parameter is forwarded to ghc.")
+  disableFormatting <- addSimpleBoolFlag "" ["disable-formatting"] (flagHelp $ parDoc "parse, but don't transform the input at all. Useful for inline config for specific modules.")
   obfuscate <- addSimpleBoolFlag "" ["obfuscate"] (flagHelp $ parDoc "apply obfuscator to the output.")
 
   return $ Config
@@ -198,6 +200,7 @@ cmdlineConfigParser = do
       { _options_ghc = [ optionsGhc & List.unwords & CmdArgs.splitArgs | not $ null optionsGhc ]
       }
     , _conf_roundtrip_exactprint_only  = wrapLast $ falseToNothing roundtripOnly
+    , _conf_disable_formatting         = wrapLast $ falseToNothing disableFormatting
     , _conf_obfuscate                  = wrapLast $ falseToNothing obfuscate
     }
  where

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

@@ -187,11 +187,17 @@ data CConfig f = Config
   , _conf_forward       :: CForwardOptions f
   , _conf_preprocessor  :: CPreProcessorConfig f
   , _conf_roundtrip_exactprint_only :: f (Semigroup.Last Bool)
-  , _conf_obfuscate     :: 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.
+  , _conf_disable_formatting :: f (Semigroup.Last Bool)
+    -- ^ Used for inline config that disables brittany entirely for this
+    -- module. Useful for wildcard application
+    -- (`find -name "*.hs" | xargs brittany --write-mode inplace` or something
+    -- in that direction).
+  , _conf_obfuscate     :: f (Semigroup.Last Bool)
+
   }
   deriving (Generic)
 

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

@@ -120,6 +120,7 @@ instance FromJSON (CConfig Maybe) where
     <*> v .:?= Text.pack "conf_forward"
     <*> v .:?= Text.pack "conf_preprocessor"
     <*> v .:?  Text.pack "conf_roundtrip_exactprint_only"
+    <*> v .:?  Text.pack "conf_disable_formatting"
     <*> v .:?  Text.pack "conf_obfuscate"
   parseJSON invalid    = Aeson.typeMismatch "Config" invalid