diff --git a/brittany.cabal b/brittany.cabal index 1643adf..3f96453 100644 --- a/brittany.cabal +++ b/brittany.cabal @@ -126,6 +126,9 @@ library Language.Haskell.Brittany.Internal.Config.Types Language.Haskell.Brittany.Internal.Config.Types.Instances1 Language.Haskell.Brittany.Internal.Config.Types.Instances2 + Language.Haskell.Brittany.Internal.ParseExact + Language.Haskell.Brittany.Internal.SplitExactModule + Language.Haskell.Brittany.Internal.ToBriDoc.Comment Language.Haskell.Brittany.Internal.ToBriDoc.DataDecl Language.Haskell.Brittany.Internal.ToBriDoc.Decl Language.Haskell.Brittany.Internal.ToBriDoc.Expr @@ -140,11 +143,10 @@ library Language.Haskell.Brittany.Internal.Components.BriDoc Language.Haskell.Brittany.Internal.Components.Obfuscation Language.Haskell.Brittany.Internal.Components.OpTree - Language.Haskell.Brittany.Internal.S1_Parsing - Language.Haskell.Brittany.Internal.S2_SplitModule - Language.Haskell.Brittany.Internal.S3_ToBriDocTools - Language.Haskell.Brittany.Internal.S4_WriteBriDoc - Language.Haskell.Brittany.Internal.StepOrchestrate + Language.Haskell.Brittany.Internal.ToBriDocTools + Language.Haskell.Brittany.Internal.WriteBriDoc + Language.Haskell.Brittany.Internal.PerModule + Language.Haskell.Brittany.Internal.PerDecl Language.Haskell.Brittany.Internal.Prelude Language.Haskell.Brittany.Internal.Transformations.T1_Alt Language.Haskell.Brittany.Internal.Transformations.T2_Floating @@ -156,7 +158,6 @@ library Language.Haskell.Brittany.Internal.WriteBriDoc.Types Language.Haskell.Brittany.Internal.Types Language.Haskell.Brittany.Internal.Utils - Language.Haskell.Brittany.Internal.Util.AST Paths_brittany executable brittany diff --git a/source/library/Language/Haskell/Brittany/Internal.hs b/source/library/Language/Haskell/Brittany/Internal.hs index fb460f3..4608b31 100644 --- a/source/library/Language/Haskell/Brittany/Internal.hs +++ b/source/library/Language/Haskell/Brittany/Internal.hs @@ -12,27 +12,36 @@ module Language.Haskell.Brittany.Internal , TraceFunc(TraceFunc) , Splitting.splitModuleDecls , Splitting.extractDeclMap + , applyCPPTransformIfEnabledPre + , applyCPPTransformIfEnabledPost + , parsePrintModuleCommon ) where import Control.Monad.Trans.Except +import DataTreePrint ( printTreeWithCustom ) import Data.CZipWith import qualified Data.Text as Text import qualified Data.Text.Lazy as TextL +import qualified Data.Text.IO as Text.IO import qualified GHC.Driver.Session as GHC import GHC.Hs import qualified GHC.LanguageExtensions.Type as GHC +import qualified Language.Haskell.GHC.ExactPrint + as ExactPrint import qualified GHC.OldList as List import Language.Haskell.Brittany.Internal.Config.Config import Language.Haskell.Brittany.Internal.Config.InlineParsing import Language.Haskell.Brittany.Internal.Config.Types -import Language.Haskell.Brittany.Internal.S3_ToBriDocTools +import Language.Haskell.Brittany.Internal.ToBriDocTools import Language.Haskell.Brittany.Internal.Prelude -import qualified Language.Haskell.Brittany.Internal.S1_Parsing +import qualified Language.Haskell.Brittany.Internal.ParseExact as Parsing -import qualified Language.Haskell.Brittany.Internal.S2_SplitModule +import qualified Language.Haskell.Brittany.Internal.SplitExactModule as Splitting -import Language.Haskell.Brittany.Internal.StepOrchestrate +import Language.Haskell.Brittany.Internal.Components.Obfuscation + ( obfuscate ) +import Language.Haskell.Brittany.Internal.PerModule ( processModule ) import Language.Haskell.Brittany.Internal.Types import Language.Haskell.Brittany.Internal.Utils @@ -40,6 +49,162 @@ import Language.Haskell.Brittany.Internal.Config.Types.Instances1 () +applyCPPTransformIfEnabledPre :: Config -> String -> String +applyCPPTransformIfEnabledPre config = + if hackAroundIncludes && not exactprintOnly + then List.intercalate "\n" . fmap hackF . lines' + else id + where + -- the flag will do the following: insert a marker string + -- ("-- BRITANY_INCLUDE_HACK ") right before any lines starting with + -- "#include" before processing (parsing) input; and remove that marker + -- string from the transformation output. + -- The flag is intentionally misspelled to prevent clashing with + -- inline-config stuff. + hackAroundIncludes = + config & _conf_preprocessor & _ppconf_hackAroundIncludes & confUnpack + exactprintOnly = viaGlobal || viaDebug + where + viaGlobal = config & _conf_roundtrip_exactprint_only & confUnpack + viaDebug = + config & _conf_debug & _dconf_roundtrip_exactprint_only & confUnpack + hackF s = if "#include" `isPrefixOf` s + then "-- BRITANY_INCLUDE_HACK " ++ s + else s + +applyCPPTransformIfEnabledPost :: Config -> TextL.Text -> TextL.Text +applyCPPTransformIfEnabledPost config = + if hackAroundIncludes && not exactprintOnly + then + TextL.intercalate (TextL.pack "\n") + . map hackF + . TextL.splitOn (TextL.pack "\n") + else id + where + hackAroundIncludes = + config & _conf_preprocessor & _ppconf_hackAroundIncludes & confUnpack + exactprintOnly = viaGlobal || viaDebug + where + viaGlobal = config & _conf_roundtrip_exactprint_only & confUnpack + viaDebug = + config & _conf_debug & _dconf_roundtrip_exactprint_only & confUnpack + hackF s = fromMaybe s + $ TextL.stripPrefix (TextL.pack "-- BRITANY_INCLUDE_HACK ") s + +parsePrintModuleCommon + :: TraceFunc + -> Config + -> Either FilePath String + -> IO () + -> IO (Either [BrittanyError] ([BrittanyError], Text, IO Bool)) +parsePrintModuleCommon traceFunc config inputE cppWarnAction = runExceptT $ do + let ghcOptions = config & _conf_forward & _options_ghc & runIdentity + let cppMode = config & _conf_preprocessor & _ppconf_CPPMode & confUnpack + let cppCheckFunc dynFlags = if GHC.xopt GHC.Cpp dynFlags + then case cppMode of + CPPModeAbort -> pure $ Left "Encountered -XCPP. Aborting." + CPPModeWarn -> cppWarnAction $> Right True + CPPModeNowarn -> pure $ Right True + else pure $ Right False + (parseResult, originalContentAct) <- case inputE of + Left p -> liftIO $ do + parseRes <- Parsing.parseModule ghcOptions p cppCheckFunc + pure (parseRes, Text.IO.readFile p) + -- The above means we read the file twice, but the + -- GHC API does not really expose the source it + -- read. Should be in cache still anyways. + -- + -- We do not use TextL.IO.readFile because lazy IO is evil. + -- (not identical -> read is not finished -> + -- handle still open -> write below crashes - evil.) + Right inputString -> do + parseRes <- liftIO + $ Parsing.parseModuleFromString + ghcOptions + "stdin" + cppCheckFunc + (applyCPPTransformIfEnabledPre config inputString) + pure (parseRes, pure $ Text.pack inputString) + (parsedSource, hasCPP) <- case parseResult of + Left err -> throwE [ErrorInput err] + Right x -> pure x + when (config & _conf_debug & _dconf_dump_ast_full & confUnpack) $ do + let val = printTreeWithCustom 160 customLayouterF parsedSource + liftIO $ useTraceFunc traceFunc ("---- ast ----\n" ++ show val) + let moduleElementList = Splitting.splitModuleDecls parsedSource + (inlineConf, perItemConf) <- + mapExceptT (fmap $ bimap (\(a, b) -> [ErrorMacroConfig a b]) id) + $ extractCommentConfigs (useTraceFunc traceFunc) + (Splitting.extractDeclMap parsedSource) + moduleElementList + let moduleConfig = cZipWith fromOptionIdentity config inlineConf + let disableFormatting = moduleConfig & _conf_disable_formatting & confUnpack + let exactprintOnly = viaGlobal || viaDebug + where + viaGlobal = config & _conf_roundtrip_exactprint_only & confUnpack + viaDebug = + config & _conf_debug & _dconf_roundtrip_exactprint_only & confUnpack + let omitCheck = + moduleConfig + & _conf_errorHandling + & _econf_omit_output_valid_check + & confUnpack + if + | disableFormatting -> do + originalContents <- liftIO $ originalContentAct + pure ([], originalContents, pure False) + | exactprintOnly -> do + let r = Text.pack $ ExactPrint.exactPrint parsedSource + pure + ( [] + , r + , do + originalContents <- originalContentAct + pure $ originalContents /= r + ) + | otherwise -> do + let + applyObfuscateIfEnabled = + if moduleConfig & _conf_obfuscate & confUnpack + then lift . obfuscate + else pure + (errsWarns, outRaw) <- if hasCPP || omitCheck + then lift + $ processModule traceFunc moduleConfig perItemConf moduleElementList + else lift + $ pPrintModuleAndCheck traceFunc + moduleConfig + perItemConf + moduleElementList + outputText <- applyObfuscateIfEnabled + (TextL.toStrict $ applyCPPTransformIfEnabledPost config outRaw) + let + hasErrors = \case + ErrorInput{} -> True + LayoutWarning{} -> + moduleConfig & _conf_errorHandling & _econf_Werror & confUnpack + ErrorOutputCheck{} -> True + ErrorUnusedComment{} -> True + ErrorUnusedComments{} -> True + ErrorUnknownNode{} -> True + ErrorMacroConfig{} -> True + outputOnErrs = + config + & _conf_errorHandling + & _econf_produceOutputOnErrors + & confUnpack + if any hasErrors errsWarns && not outputOnErrs + then throwE $ errsWarns + else pure + $ ( errsWarns + , outputText + , do + originalContents <- liftIO $ originalContentAct + pure $ originalContents /= outputText + ) + + -- pure $ _ (parsed, hasCPP, originalContentAct) + -- | Exposes the transformation in an pseudo-pure fashion. The signature -- contains `IO` due to the GHC API not exposing a pure parsing function, but -- there should be no observable effects. @@ -56,84 +221,12 @@ parsePrintModule parsePrintModule traceFunc configWithDebugs inputText = runExceptT $ do let config = configWithDebugs { _conf_debug = _conf_debug staticDefaultConfig } - let ghcOptions = config & _conf_forward & _options_ghc & runIdentity - let config_pp = config & _conf_preprocessor - let cppMode = config_pp & _ppconf_CPPMode & confUnpack - let hackAroundIncludes = - config_pp & _ppconf_hackAroundIncludes & confUnpack - (parsedSource, hasCPP) <- do - let hackF s = if "#include" `isPrefixOf` s - then "-- BRITANY_INCLUDE_HACK " ++ s - else s - let hackTransform = if hackAroundIncludes - then List.intercalate "\n" . fmap hackF . lines' - else id - let cppCheckFunc dynFlags = if GHC.xopt GHC.Cpp dynFlags - then case cppMode of - CPPModeAbort -> return $ Left "Encountered -XCPP. Aborting." - CPPModeWarn -> return $ Right True - CPPModeNowarn -> return $ Right True - else return $ Right False - parseResult <- lift $ Parsing.parseModuleFromString - ghcOptions - "stdin" - cppCheckFunc - (hackTransform $ Text.unpack inputText) - case parseResult of - Left err -> throwE [ErrorInput err] - Right x -> pure x - let moduleElementList = Splitting.splitModuleDecls parsedSource - (inlineConf, perItemConf) <- - mapExceptT (fmap $ bimap (\(a, b) -> [ErrorMacroConfig a b]) id) - $ extractCommentConfigs - (useTraceFunc traceFunc) - (Splitting.extractDeclMap parsedSource) - moduleElementList - let moduleConfig = cZipWith fromOptionIdentity config inlineConf - let disableFormatting = - moduleConfig & _conf_disable_formatting & confUnpack - if disableFormatting - then do - return inputText - else do - (errsWarns, outputTextL) <- do - let omitCheck = - moduleConfig - & _conf_errorHandling - & _econf_omit_output_valid_check - & confUnpack - (ews, outRaw) <- if hasCPP || omitCheck - then lift - $ processModule traceFunc moduleConfig perItemConf moduleElementList - else lift $ pPrintModuleAndCheck traceFunc - moduleConfig - perItemConf - moduleElementList - let hackF s = fromMaybe s - $ TextL.stripPrefix (TextL.pack "-- BRITANY_INCLUDE_HACK ") s - pure $ if hackAroundIncludes - then - ( ews - , TextL.intercalate (TextL.pack "\n") - $ hackF - <$> TextL.splitOn (TextL.pack "\n") outRaw - ) - else (ews, outRaw) - let customErrOrder ErrorInput{} = 5 - customErrOrder LayoutWarning{} = 0 :: Int - customErrOrder ErrorOutputCheck{} = 1 - customErrOrder ErrorUnusedComment{} = 2 - customErrOrder ErrorUnusedComments{} = 3 - customErrOrder ErrorUnknownNode{} = 4 - customErrOrder ErrorMacroConfig{} = 6 - let hasErrors = - if moduleConfig & _conf_errorHandling & _econf_Werror & confUnpack - then not $ null errsWarns - else 0 < maximum (-1 : fmap customErrOrder errsWarns) - if hasErrors - then throwE $ errsWarns - else pure $ TextL.toStrict outputTextL - + (_errsWarns, output, _) <- ExceptT $ liftIO $ parsePrintModuleCommon + traceFunc + config + (Right $ Text.unpack inputText) + (pure ()) + pure output -- | Additionally checks that the output compiles again, appending an error diff --git a/source/library/Language/Haskell/Brittany/Internal/S1_Parsing.hs b/source/library/Language/Haskell/Brittany/Internal/ParseExact.hs similarity index 99% rename from source/library/Language/Haskell/Brittany/Internal/S1_Parsing.hs rename to source/library/Language/Haskell/Brittany/Internal/ParseExact.hs index 98d0baf..36a07bb 100644 --- a/source/library/Language/Haskell/Brittany/Internal/S1_Parsing.hs +++ b/source/library/Language/Haskell/Brittany/Internal/ParseExact.hs @@ -1,6 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-} -module Language.Haskell.Brittany.Internal.S1_Parsing +module Language.Haskell.Brittany.Internal.ParseExact ( parseModule , parseModuleFromString ) diff --git a/source/library/Language/Haskell/Brittany/Internal/PerDecl.hs b/source/library/Language/Haskell/Brittany/Internal/PerDecl.hs new file mode 100644 index 0000000..0ae0b49 --- /dev/null +++ b/source/library/Language/Haskell/Brittany/Internal/PerDecl.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE DataKinds #-} + +module Language.Haskell.Brittany.Internal.PerDecl + ( ppToplevelDecl + ) where + +import Language.Haskell.Brittany.Internal.Prelude + +import qualified GHC +import GHC ( EpaCommentTok + , GenLocated(L) + , LHsDecl + , SrcSpanAnn'(SrcSpanAnn) + ) + +import Language.Haskell.Brittany.Internal.Config.Types +import Language.Haskell.Brittany.Internal.Config.Types.Instances2 + ( ) +import Language.Haskell.Brittany.Internal.ToBriDocTools +import Language.Haskell.Brittany.Internal.WriteBriDoc + ( ppBriDoc ) +import Language.Haskell.Brittany.Internal.ToBriDoc.Decl +import Language.Haskell.Brittany.Internal.ToBriDoc.Comment +import Language.Haskell.Brittany.Internal.Types +import Language.Haskell.Brittany.Internal.ToBriDoc + ( layouters ) + + + +ppToplevelDecl :: LHsDecl GhcPs -> [(Int, EpaCommentTok)] -> PPMLocal () +ppToplevelDecl decl immediateAfterComms = do + exactprintOnly <- mAsk <&> \declConfig -> + declConfig & _conf_roundtrip_exactprint_only & confUnpack + bd <- fmap fst $ if exactprintOnly + then briDocMToPPM layouters $ docSeq + (briDocByExactNoComment decl : map commentToDoc immediateAfterComms) + else do + let innerDoc = case decl of + L (SrcSpanAnn _ (GHC.RealSrcSpan s _)) _ -> + docFlushRemaining (GHC.srcSpanFile s) $ layoutDecl decl + _ -> layoutDecl decl + (r, errorCount) <- briDocMToPPM layouters $ docSeq + (innerDoc : map commentToDoc immediateAfterComms) + if errorCount == 0 + then pure (r, 0) + else briDocMToPPM layouters $ briDocByExactNoComment decl + ppBriDoc bd False + let commCntIn = connectedCommentCount decl + commCntOut <- mGet + when (commCntIn /= commCntOut) $ if commCntOut < commCntIn + then mTell + [ ErrorUnusedComments decl + (unCommentCounter commCntIn) + (unCommentCounter commCntOut) + ] + else mTell + [ ErrorUnusedComments decl + (unCommentCounter commCntIn) + (unCommentCounter commCntOut) + ] + -- error + -- $ "internal brittany error: inconsistent comment count (" + -- ++ show commCntOut + -- ++ ">" + -- ++ show commCntIn + -- ++ ")!" diff --git a/source/library/Language/Haskell/Brittany/Internal/StepOrchestrate.hs b/source/library/Language/Haskell/Brittany/Internal/PerModule.hs similarity index 77% rename from source/library/Language/Haskell/Brittany/Internal/StepOrchestrate.hs rename to source/library/Language/Haskell/Brittany/Internal/PerModule.hs index df2ddb1..fb58fd8 100644 --- a/source/library/Language/Haskell/Brittany/Internal/StepOrchestrate.hs +++ b/source/library/Language/Haskell/Brittany/Internal/PerModule.hs @@ -1,7 +1,7 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE DataKinds #-} -module Language.Haskell.Brittany.Internal.StepOrchestrate +module Language.Haskell.Brittany.Internal.PerModule ( processModule ) where @@ -24,7 +24,6 @@ import GHC ( EpaComment(EpaComment) , GenLocated(L) , HsModule(HsModule) , LHsDecl - , SrcSpanAnn'(SrcSpanAnn) ) import qualified GHC.Types.SrcLoc as GHC import qualified GHC.OldList as List @@ -36,19 +35,23 @@ import Language.Haskell.Brittany.Internal.Components.BriDoc import Language.Haskell.Brittany.Internal.Config.Types import Language.Haskell.Brittany.Internal.Config.Types.Instances2 ( ) -import Language.Haskell.Brittany.Internal.S2_SplitModule - ( splitModuleStart ) -import Language.Haskell.Brittany.Internal.S3_ToBriDocTools -import Language.Haskell.Brittany.Internal.S4_WriteBriDoc +import Language.Haskell.Brittany.Internal.SplitExactModule + ( getDeclBindingNames + , splitModuleStart + ) +import Language.Haskell.Brittany.Internal.ToBriDocTools +import Language.Haskell.Brittany.Internal.WriteBriDoc ( ppBriDoc ) -import Language.Haskell.Brittany.Internal.ToBriDoc.Decl +import Language.Haskell.Brittany.Internal.ToBriDoc.Comment + ( commentToDoc ) import Language.Haskell.Brittany.Internal.ToBriDoc.Import import Language.Haskell.Brittany.Internal.ToBriDoc.Module import Language.Haskell.Brittany.Internal.Types -import Language.Haskell.Brittany.Internal.Util.AST import Language.Haskell.Brittany.Internal.Utils import Language.Haskell.Brittany.Internal.ToBriDoc ( layouters ) +import Language.Haskell.Brittany.Internal.PerDecl + ( ppToplevelDecl ) @@ -182,21 +185,6 @@ processModule traceFunc conf inlineConf moduleElems = do -- mTell $ TextL.Builder.fromString ("whitespace " ++ show dp) ppmMoveToExactLoc dp -commentToDoc :: (Int, EpaCommentTok) -> ToBriDocM BriDocNumbered -commentToDoc (indent, c) = case c of - GHC.EpaDocCommentNext str -> handle str - GHC.EpaDocCommentPrev str -> handle str - GHC.EpaDocCommentNamed str -> handle str - GHC.EpaDocSection _ str -> handle str - GHC.EpaDocOptions str -> handle str - GHC.EpaLineComment str -> handle str - GHC.EpaBlockComment str -> handle str - GHC.EpaEofComment -> docEmpty - where - handle str = if indent == 0 - then docLitS str - else docSeq [docSeparator, docLitS $ (replicate (indent - 1) ' ') ++ str ] - -- Prints the information associated with the module annotation -- This includes the imports -- This returns a `Maybe` because it only produces a BriDocNumbered if @@ -234,41 +222,4 @@ getDeclConfig config inlineConf decl = cZipWith fromOptionIdentity config GHC.RealSrcSpan x _ -> Map.lookup x $ _icd_perAnchor inlineConf GHC.UnhelpfulSpan{} -> Nothing -ppToplevelDecl :: LHsDecl GhcPs -> [(Int, EpaCommentTok)] -> PPMLocal () -ppToplevelDecl decl immediateAfterComms = do - exactprintOnly <- mAsk <&> \declConfig -> - declConfig & _conf_roundtrip_exactprint_only & confUnpack - bd <- fmap fst $ if exactprintOnly - then briDocMToPPM layouters $ docSeq - (briDocByExactNoComment decl : map commentToDoc immediateAfterComms) - else do - let innerDoc = case decl of - L (SrcSpanAnn _ (GHC.RealSrcSpan s _)) _ -> - docFlushRemaining (GHC.srcSpanFile s) $ layoutDecl decl - _ -> layoutDecl decl - (r, errorCount) <- briDocMToPPM layouters $ docSeq - (innerDoc : map commentToDoc immediateAfterComms) - if errorCount == 0 - then pure (r, 0) - else briDocMToPPM layouters $ briDocByExactNoComment decl - ppBriDoc bd False - let commCntIn = connectedCommentCount decl - commCntOut <- mGet - when (commCntIn /= commCntOut) $ if commCntOut < commCntIn - then mTell - [ ErrorUnusedComments decl - (unCommentCounter commCntIn) - (unCommentCounter commCntOut) - ] - else mTell - [ ErrorUnusedComments decl - (unCommentCounter commCntIn) - (unCommentCounter commCntOut) - ] - -- error - -- $ "internal brittany error: inconsistent comment count (" - -- ++ show commCntOut - -- ++ ">" - -- ++ show commCntIn - -- ++ ")!" diff --git a/source/library/Language/Haskell/Brittany/Internal/Prelude.hs b/source/library/Language/Haskell/Brittany/Internal/Prelude.hs index d61ef6e..d4b130c 100644 --- a/source/library/Language/Haskell/Brittany/Internal/Prelude.hs +++ b/source/library/Language/Haskell/Brittany/Internal/Prelude.hs @@ -189,7 +189,7 @@ import Prelude as E , undefined , (||) ) -import System.IO as E (IO, hFlush, stdout) +import System.IO as E (IO, hFlush, stdout, FilePath) import Text.Read as E (readMaybe) import qualified Data.Strict.Maybe as Strict diff --git a/source/library/Language/Haskell/Brittany/Internal/S2_SplitModule.hs b/source/library/Language/Haskell/Brittany/Internal/SplitExactModule.hs similarity index 92% rename from source/library/Language/Haskell/Brittany/Internal/S2_SplitModule.hs rename to source/library/Language/Haskell/Brittany/Internal/SplitExactModule.hs index defba49..c2cdccf 100644 --- a/source/library/Language/Haskell/Brittany/Internal/S2_SplitModule.hs +++ b/source/library/Language/Haskell/Brittany/Internal/SplitExactModule.hs @@ -1,11 +1,11 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} --- TODO92 -module Language.Haskell.Brittany.Internal.S2_SplitModule +module Language.Haskell.Brittany.Internal.SplitExactModule ( extractDeclMap , splitModuleDecls , splitModuleStart + , getDeclBindingNames ) where @@ -15,6 +15,7 @@ import Language.Haskell.Brittany.Internal.Prelude import qualified Data.Generics as SYB import qualified Data.List.Extra import qualified Data.Map as Map +import qualified Data.Text as Text import qualified GHC import GHC ( AddEpAnn(AddEpAnn) , Anchor(Anchor) @@ -47,11 +48,21 @@ import GHC ( AddEpAnn(AddEpAnn) , SrcSpanAnn'(SrcSpanAnn) , anchor , ideclName + , moduleName , moduleNameString , srcLocCol , srcLocLine , unLoc ) +import GHC.Types.Name ( getOccString ) +import GHC.Types.Name.Occurrence ( occNameString ) +import GHC.Types.Name.Reader ( RdrName + ( Exact + , Orig + , Qual + , Unqual + ) + ) import qualified GHC.OldList as List import GHC.Parser.Annotation ( DeltaPos ( DifferentLine @@ -73,7 +84,6 @@ import qualified Control.Monad.Trans.Writer.Strict import Language.Haskell.Brittany.Internal.Components.BriDoc import Language.Haskell.Brittany.Internal.ToBriDoc.Module import Language.Haskell.Brittany.Internal.Types -import Language.Haskell.Brittany.Internal.Util.AST @@ -427,3 +437,19 @@ sortCommentedImports = (l@SamelineComment{} : rest) -> Left l : Right (reverse acc) : go [] rest (ImportStatement r : rest) -> go (r : acc) rest [] -> [Right (reverse acc)] + +rdrNameToText :: RdrName -> Text +-- rdrNameToText = Text.pack . show . flip runSDoc unsafeGlobalDynFlags . ppr +rdrNameToText (Unqual occname) = Text.pack $ occNameString occname +rdrNameToText (Qual mname occname) = + Text.pack $ moduleNameString mname ++ "." ++ occNameString occname +rdrNameToText (Orig modul occname) = + Text.pack $ moduleNameString (moduleName modul) ++ occNameString occname +rdrNameToText (Exact name) = Text.pack $ getOccString name + +getDeclBindingNames :: GHC.LHsDecl GhcPs -> [String] +getDeclBindingNames (L _ decl) = case decl of + GHC.SigD _ (GHC.TypeSig _ ns _) -> + ns <&> \(L _ n) -> Text.unpack (rdrNameToText n) + GHC.ValD _ (GHC.FunBind _ (L _ n) _ _) -> [Text.unpack $ rdrNameToText n] + _ -> [] diff --git a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Comment.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Comment.hs new file mode 100644 index 0000000..9d6652d --- /dev/null +++ b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Comment.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Language.Haskell.Brittany.Internal.ToBriDoc.Comment + ( commentToDoc + ) where + +import Language.Haskell.Brittany.Internal.Prelude + +import GHC ( EpaCommentTok + ( EpaBlockComment + , EpaDocCommentNamed + , EpaDocCommentNext + , EpaDocCommentPrev + , EpaDocOptions + , EpaDocSection + , EpaEofComment + , EpaLineComment + ) + ) +import Language.Haskell.Brittany.Internal.Types +import Language.Haskell.Brittany.Internal.Components.BriDoc +import Language.Haskell.Brittany.Internal.ToBriDocTools + + + +commentToDoc :: (Int, EpaCommentTok) -> ToBriDocM BriDocNumbered +commentToDoc (indent, c) = case c of + GHC.EpaDocCommentNext str -> handle str + GHC.EpaDocCommentPrev str -> handle str + GHC.EpaDocCommentNamed str -> handle str + GHC.EpaDocSection _ str -> handle str + GHC.EpaDocOptions str -> handle str + GHC.EpaLineComment str -> handle str + GHC.EpaBlockComment str -> handle str + GHC.EpaEofComment -> docEmpty + where + handle str = if indent == 0 + then docLitS str + else docSeq [docSeparator, docLitS $ (replicate (indent - 1) ' ') ++ str ] diff --git a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/DataDecl.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/DataDecl.hs index 4abba78..5cc4584 100644 --- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/DataDecl.hs +++ b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/DataDecl.hs @@ -7,7 +7,7 @@ import GHC (GenLocated(L)) import GHC.Hs import qualified GHC.OldList as List import Language.Haskell.Brittany.Internal.Config.Types -import Language.Haskell.Brittany.Internal.S3_ToBriDocTools +import Language.Haskell.Brittany.Internal.ToBriDocTools import Language.Haskell.Brittany.Internal.Prelude import Language.Haskell.Brittany.Internal.Types import Language.Haskell.Brittany.Internal.Components.BriDoc diff --git a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Decl.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Decl.hs index 8e6de93..10afe90 100644 --- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Decl.hs +++ b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Decl.hs @@ -21,7 +21,7 @@ import GHC.Types.SrcLoc (Located, getLoc, unLoc) import qualified GHC import qualified GHC.Types.SrcLoc as GHC import Language.Haskell.Brittany.Internal.Config.Types -import Language.Haskell.Brittany.Internal.S3_ToBriDocTools +import Language.Haskell.Brittany.Internal.ToBriDocTools import Language.Haskell.Brittany.Internal.Prelude import Language.Haskell.Brittany.Internal.Types import qualified Language.Haskell.GHC.ExactPrint as ExactPrint diff --git a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs index 85df541..f6b43e1 100644 --- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs +++ b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs @@ -23,7 +23,7 @@ import qualified GHC.Types.SrcLoc as GHC import Language.Haskell.Brittany.Internal.Components.BriDoc import Language.Haskell.Brittany.Internal.Config.Types import Language.Haskell.Brittany.Internal.Prelude -import Language.Haskell.Brittany.Internal.S3_ToBriDocTools +import Language.Haskell.Brittany.Internal.ToBriDocTools import Language.Haskell.Brittany.Internal.Types import Language.Haskell.Brittany.Internal.Utils diff --git a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/IE.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/IE.hs index a65eb2e..fa2da91 100644 --- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/IE.hs +++ b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/IE.hs @@ -17,7 +17,7 @@ import qualified Data.Data import Language.Haskell.Brittany.Internal.Components.BriDoc import Language.Haskell.Brittany.Internal.Prelude -import Language.Haskell.Brittany.Internal.S3_ToBriDocTools +import Language.Haskell.Brittany.Internal.ToBriDocTools import Language.Haskell.Brittany.Internal.Types import Language.Haskell.Brittany.Internal.Utils diff --git a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Import.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Import.hs index b4e035c..6476a3b 100644 --- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Import.hs +++ b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Import.hs @@ -13,7 +13,7 @@ import GHC.Types.Basic import GHC.Types.SourceText(SourceText(SourceText, NoSourceText), sl_st) import GHC.Unit.Types (IsBootInterface(..)) import Language.Haskell.Brittany.Internal.Config.Types -import Language.Haskell.Brittany.Internal.S3_ToBriDocTools +import Language.Haskell.Brittany.Internal.ToBriDocTools import Language.Haskell.Brittany.Internal.Prelude import Language.Haskell.Brittany.Internal.Types import Language.Haskell.Brittany.Internal.Components.BriDoc diff --git a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Module.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Module.hs index b8f7537..f84610a 100644 --- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Module.hs +++ b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Module.hs @@ -13,7 +13,7 @@ import GHC.Hs import Language.Haskell.Brittany.Internal.Components.BriDoc import Language.Haskell.Brittany.Internal.Config.Types import Language.Haskell.Brittany.Internal.Prelude -import Language.Haskell.Brittany.Internal.S3_ToBriDocTools +import Language.Haskell.Brittany.Internal.ToBriDocTools import Language.Haskell.Brittany.Internal.Types diff --git a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/OpTree.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/OpTree.hs index b7b583f..9475661 100644 --- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/OpTree.hs +++ b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/OpTree.hs @@ -12,7 +12,7 @@ import Language.Haskell.Brittany.Internal.Components.BriDoc import Language.Haskell.Brittany.Internal.Components.OpTree import Language.Haskell.Brittany.Internal.Config.Types import Language.Haskell.Brittany.Internal.Prelude -import Language.Haskell.Brittany.Internal.S3_ToBriDocTools +import Language.Haskell.Brittany.Internal.ToBriDocTools import Language.Haskell.Brittany.Internal.Types import Language.Haskell.Brittany.Internal.Utils diff --git a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Pattern.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Pattern.hs index 558657a..f9cfe9b 100644 --- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Pattern.hs +++ b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Pattern.hs @@ -10,7 +10,7 @@ import GHC (GenLocated(L), ol_val) import GHC.Hs import qualified GHC.OldList as List import GHC.Types.Basic -import Language.Haskell.Brittany.Internal.S3_ToBriDocTools +import Language.Haskell.Brittany.Internal.ToBriDocTools import Language.Haskell.Brittany.Internal.Prelude import Language.Haskell.Brittany.Internal.Types import Language.Haskell.Brittany.Internal.Components.BriDoc diff --git a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Stmt.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Stmt.hs index 25959c5..23d7ed8 100644 --- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Stmt.hs +++ b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Stmt.hs @@ -8,7 +8,7 @@ import qualified Data.Text as Text import GHC (GenLocated(L)) import GHC.Hs import Language.Haskell.Brittany.Internal.Config.Types -import Language.Haskell.Brittany.Internal.S3_ToBriDocTools +import Language.Haskell.Brittany.Internal.ToBriDocTools import Language.Haskell.Brittany.Internal.Prelude import Language.Haskell.Brittany.Internal.Types import Language.Haskell.Brittany.Internal.Components.BriDoc diff --git a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Type.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Type.hs index c35be67..bf7a426 100644 --- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Type.hs +++ b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Type.hs @@ -14,7 +14,7 @@ import GHC.Utils.Outputable (ftext, showSDocUnsafe) import GHC.Types.Fixity ( Fixity(Fixity) , FixityDirection(InfixN) ) -import Language.Haskell.Brittany.Internal.S3_ToBriDocTools +import Language.Haskell.Brittany.Internal.ToBriDocTools import Language.Haskell.Brittany.Internal.Prelude import Language.Haskell.Brittany.Internal.Types import Language.Haskell.Brittany.Internal.Components.BriDoc diff --git a/source/library/Language/Haskell/Brittany/Internal/S3_ToBriDocTools.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDocTools.hs similarity index 99% rename from source/library/Language/Haskell/Brittany/Internal/S3_ToBriDocTools.hs rename to source/library/Language/Haskell/Brittany/Internal/ToBriDocTools.hs index ba57df0..c0dac9f 100644 --- a/source/library/Language/Haskell/Brittany/Internal/S3_ToBriDocTools.hs +++ b/source/library/Language/Haskell/Brittany/Internal/ToBriDocTools.hs @@ -1,7 +1,7 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -module Language.Haskell.Brittany.Internal.S3_ToBriDocTools where +module Language.Haskell.Brittany.Internal.ToBriDocTools where import qualified Control.Monad.Writer.Strict as Writer import qualified Data.Char as Char diff --git a/source/library/Language/Haskell/Brittany/Internal/Util/AST.hs b/source/library/Language/Haskell/Brittany/Internal/Util/AST.hs deleted file mode 100644 index 9573c6b..0000000 --- a/source/library/Language/Haskell/Brittany/Internal/Util/AST.hs +++ /dev/null @@ -1,40 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} - -module Language.Haskell.Brittany.Internal.Util.AST where - -import Language.Haskell.Brittany.Internal.Prelude - -import qualified Data.Text as Text -import GHC ( moduleName - , moduleNameString - , GenLocated(L) - ) -import qualified GHC -import GHC.Types.Name ( getOccString ) -import GHC.Types.Name.Occurrence ( occNameString - ) -import GHC.Types.Name.Reader ( RdrName - ( Exact - , Orig - , Qual - , Unqual - ) - ) - - - -rdrNameToText :: RdrName -> Text --- rdrNameToText = Text.pack . show . flip runSDoc unsafeGlobalDynFlags . ppr -rdrNameToText (Unqual occname) = Text.pack $ occNameString occname -rdrNameToText (Qual mname occname) = - Text.pack $ moduleNameString mname ++ "." ++ occNameString occname -rdrNameToText (Orig modul occname) = - Text.pack $ moduleNameString (moduleName modul) ++ occNameString occname -rdrNameToText (Exact name) = Text.pack $ getOccString name - -getDeclBindingNames :: GHC.LHsDecl GhcPs -> [String] -getDeclBindingNames (L _ decl) = case decl of - GHC.SigD _ (GHC.TypeSig _ ns _) -> - ns <&> \(L _ n) -> Text.unpack (rdrNameToText n) - GHC.ValD _ (GHC.FunBind _ (L _ n) _ _) -> [Text.unpack $ rdrNameToText n] - _ -> [] diff --git a/source/library/Language/Haskell/Brittany/Internal/S4_WriteBriDoc.hs b/source/library/Language/Haskell/Brittany/Internal/WriteBriDoc.hs similarity index 99% rename from source/library/Language/Haskell/Brittany/Internal/S4_WriteBriDoc.hs rename to source/library/Language/Haskell/Brittany/Internal/WriteBriDoc.hs index ac1b65a..035b697 100644 --- a/source/library/Language/Haskell/Brittany/Internal/S4_WriteBriDoc.hs +++ b/source/library/Language/Haskell/Brittany/Internal/WriteBriDoc.hs @@ -1,6 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-} -module Language.Haskell.Brittany.Internal.S4_WriteBriDoc +module Language.Haskell.Brittany.Internal.WriteBriDoc ( ppBriDoc ) where diff --git a/source/library/Language/Haskell/Brittany/Main.hs b/source/library/Language/Haskell/Brittany/Main.hs index b8d8498..08922b3 100644 --- a/source/library/Language/Haskell/Brittany/Main.hs +++ b/source/library/Language/Haskell/Brittany/Main.hs @@ -6,28 +6,20 @@ module Language.Haskell.Brittany.Main where import Control.Monad (zipWithM) import qualified Control.Monad.Trans.Except as ExceptT -import Data.CZipWith import qualified Data.Either import qualified Data.List.Extra import qualified Data.Monoid -import qualified Data.Text as Text import qualified Data.Text.IO as Text.IO -import qualified Data.Text.Lazy as TextL -import DataTreePrint import GHC (GenLocated(L)) import qualified GHC -import qualified GHC.Driver.Session as GHC -import qualified GHC.LanguageExtensions.Type as GHC import qualified GHC.OldList as List import GHC.Utils.Outputable (Outputable(..), showSDocUnsafe) import Language.Haskell.Brittany.Internal import Language.Haskell.Brittany.Internal.Config.Config import Language.Haskell.Brittany.Internal.Config.Types -import Language.Haskell.Brittany.Internal.Components.Obfuscation import Language.Haskell.Brittany.Internal.Prelude import Language.Haskell.Brittany.Internal.Types import Language.Haskell.Brittany.Internal.Utils -import qualified Language.Haskell.GHC.ExactPrint as ExactPrint import Paths_brittany import qualified System.Directory as Directory import qualified System.Environment as Environment @@ -309,135 +301,14 @@ coreIO coreIO putErrorLnIO config suppressOutput checkMode inputPathM outputPathM = ExceptT.runExceptT $ do let putErrorLn = liftIO . putErrorLnIO :: String -> ExceptT.ExceptT e IO () - let ghcOptions = config & _conf_forward & _options_ghc & runIdentity - -- there is a good of code duplication between the following code and the - -- `pureModuleTransform` function. Unfortunately, there are also a good - -- 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 & confUnpack - -- the flag will do the following: insert a marker string - -- ("-- BRITANY_INCLUDE_HACK ") right before any lines starting with - -- "#include" before processing (parsing) input; and remove that marker - -- string from the transformation output. - -- The flag is intentionally misspelled to prevent clashing with - -- inline-config stuff. - let - hackAroundIncludes = - config & _conf_preprocessor & _ppconf_hackAroundIncludes & confUnpack - let - exactprintOnly = viaGlobal || viaDebug - where - viaGlobal = config & _conf_roundtrip_exactprint_only & confUnpack - viaDebug = - config & _conf_debug & _dconf_roundtrip_exactprint_only & confUnpack - let - cppCheckFunc dynFlags = if GHC.xopt GHC.Cpp dynFlags - then case cppMode of - CPPModeAbort -> do - return $ Left "Encountered -XCPP. Aborting." - CPPModeWarn -> do - putErrorLnIO - $ "Warning: Encountered -XCPP." - ++ " Be warned that -XCPP is not supported and that" - ++ " brittany cannot check that its output is syntactically" - ++ " valid in its presence." - return $ Right True - CPPModeNowarn -> return $ Right True - else return $ Right False - (parseResult, originalContents) <- case inputPathM of + inputVal <- case inputPathM of Nothing -> do - -- TODO: refactor this hack to not be mixed into parsing logic - let - hackF s = if "#include" `isPrefixOf` s - then "-- BRITANY_INCLUDE_HACK " ++ s - else s - let - hackTransform = if hackAroundIncludes && not exactprintOnly - then List.intercalate "\n" . fmap hackF . lines' - else id inputString <- liftIO System.IO.getContents - parseRes <- liftIO $ parseModuleFromString - ghcOptions - "stdin" - cppCheckFunc - (hackTransform inputString) - return (parseRes, Text.pack inputString) - Just p -> liftIO $ do - parseRes <- parseModule ghcOptions p cppCheckFunc - inputText <- Text.IO.readFile p - -- The above means we read the file twice, but the - -- GHC API does not really expose the source it - -- read. Should be in cache still anyways. - -- - -- We do not use TextL.IO.readFile because lazy IO is evil. - -- (not identical -> read is not finished -> - -- handle still open -> write below crashes - evil.) - return (parseRes, inputText) - case parseResult of - Left left -> do - putErrorLn "parse error:" - putErrorLn left - ExceptT.throwE 60 - Right (parsedSource, hasCPP) -> do - let moduleElementList = splitModuleDecls parsedSource - (inlineConf, perItemConf) <- do - resE <- - liftIO - $ ExceptT.runExceptT - $ extractCommentConfigs - putErrorLnIO - (extractDeclMap parsedSource) - moduleElementList - case resE of - Left (err, input) -> do - putErrorLn $ "Error: parse error in inline configuration:" - putErrorLn err - putErrorLn $ " in the string \"" ++ input ++ "\"." - ExceptT.throwE 61 - Right c -> -- trace (showTree c) $ - pure c - let moduleConf = cZipWith fromOptionIdentity config inlineConf - when (config & _conf_debug & _dconf_dump_ast_full & confUnpack) $ do - let val = printTreeWithCustom 160 customLayouterF parsedSource - putErrorLn ("---- ast ----\n" ++ show val) - let - disableFormatting = - moduleConf & _conf_disable_formatting & confUnpack - (errsWarns, outSText, hasChanges) <- do - if - | disableFormatting -> do - pure ([], originalContents, False) - | exactprintOnly -> do - let r = Text.pack $ ExactPrint.exactPrint parsedSource - pure ([], r, r /= originalContents) - | otherwise -> do - let - omitCheck = - moduleConf - & _conf_errorHandling - .> _econf_omit_output_valid_check - .> confUnpack - (ews, outRaw) <- if hasCPP || omitCheck - then liftIO $ processModule (TraceFunc putErrorLnIO) moduleConf perItemConf moduleElementList - else liftIO - $ pPrintModuleAndCheck (TraceFunc putErrorLnIO) moduleConf perItemConf moduleElementList - let - hackF s = fromMaybe s $ TextL.stripPrefix - (TextL.pack "-- BRITANY_INCLUDE_HACK ") - s - let - out = TextL.toStrict $ if hackAroundIncludes - then - TextL.intercalate (TextL.pack "\n") - $ hackF - <$> TextL.splitOn (TextL.pack "\n") outRaw - else outRaw - out' <- if moduleConf & _conf_obfuscate & confUnpack - then lift $ obfuscate out - else pure out - pure $ (ews, out', out' /= originalContents) + pure $ Right inputString + Just p -> pure $ Left p + let + printErrorsAndWarnings errsWarns = do let customErrOrder ErrorInput{} = 4 customErrOrder LayoutWarning{} = -1 :: Int @@ -507,23 +378,35 @@ coreIO putErrorLnIO config suppressOutput checkMode inputPathM outputPathM = putErrorLn err putErrorLn $ " in the string \"" ++ input ++ "\"." [] -> error "cannot happen" + parseResult <- liftIO $ parsePrintModuleCommon + (TraceFunc putErrorLnIO) + config + inputVal + ( putErrorLnIO + $ "Warning: Encountered -XCPP." + ++ " Be warned that -XCPP is not supported and that" + ++ " brittany cannot check that its output is syntactically" + ++ " valid in its presence." + ) + + case parseResult of + Left errWarns@[ErrorInput{}] -> do + printErrorsAndWarnings errWarns + ExceptT.throwE 60 + Left errWarns@(ErrorMacroConfig{}: _) -> do + printErrorsAndWarnings errWarns + ExceptT.throwE 61 + Left errWarns -> do + printErrorsAndWarnings errWarns + ExceptT.throwE 70 + Right (errsWarns, outSText, hasChangesAct) -> do + printErrorsAndWarnings errsWarns + + hasChanges <- liftIO $ hasChangesAct + -- TODO: don't output anything when there are errors unless user -- adds some override? - let - hasErrors = - if config & _conf_errorHandling & _econf_Werror & confUnpack - then not $ null errsWarns - else 0 < maximum (-1 : fmap customErrOrder errsWarns) - outputOnErrs = - config - & _conf_errorHandling - & _econf_produceOutputOnErrors - & confUnpack - shouldOutput = - not suppressOutput - && not checkMode - && (not hasErrors || outputOnErrs) - + let shouldOutput = not suppressOutput && not checkMode when shouldOutput $ addTraceSep (_conf_debug config) $ case outputPathM of @@ -539,7 +422,6 @@ coreIO putErrorLnIO config suppressOutput checkMode inputPathM outputPathM = Nothing -> pure () Just p -> liftIO $ putStrLn $ "formatting would modify: " ++ p - when hasErrors $ ExceptT.throwE 70 return (if hasChanges then Changes else NoChanges) where addTraceSep conf =