From 49a2529a5b0ce7ee8b3b51b5207f493c6a5b32bd Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <hexagoxel@hexagoxel.de>
Date: Tue, 30 May 2023 10:44:30 +0200
Subject: [PATCH] Fix exactprinting fallback for inline splice
---
.../Brittany/Internal/ToBriDocTools.hs | 36 +++++++++----------
1 file changed, 16 insertions(+), 20 deletions(-)
diff --git a/source/library/Language/Haskell/Brittany/Internal/ToBriDocTools.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDocTools.hs
index c0dac9f..1058c54 100644
--- a/source/library/Language/Haskell/Brittany/Internal/ToBriDocTools.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/ToBriDocTools.hs
@@ -89,31 +89,27 @@ briDocByExactInlineOnly
)
=> String
-> GHC.XRec GhcPs a
- -> ToBriDocM BriDocNumbered
+ -> ToBriDocM (BriDocNumbered)
briDocByExactInlineOnly infoStr ast = do
- traceIfDumpConf
- "ast"
- _dconf_dump_ast_unknown
- (printTreeWithCustom 160 customLayouterF ast)
- let exactPrinted = Text.pack $ ExactPrint.exactPrint ast
+ traceIfDumpConf "ast"
+ _dconf_dump_ast_unknown
+ (printTreeWithCustom 160 customLayouterF ast)
+ let exactPrinted =
+ dropWhile Text.null $ Text.lines $ Text.pack $ ExactPrint.exactPrint ast
fallbackMode <-
mAsk <&> _conf_errorHandling .> _econf_ExactPrintFallback .> confUnpack
- let
- exactPrintNode t =
- allocateNode $ BDExternal
- -- (ExactPrint.Types.mkAnnKey ast)
- -- (foldedAnnKeys ast)
- False t
- let
- errorAction = do
- mTell [ErrorUnknownNode infoStr ast]
- docLit $ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}"
+ let exactPrintNode t = allocateNode $ BDExternal False t
+ let errorAction = do
+ mTell [ErrorUnknownNode infoStr ast]
+ docLit
+ $ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}"
mModify (+ connectedCommentCount ast)
- case (fallbackMode, Text.lines exactPrinted) of
- (ExactPrintFallbackModeNever, _) -> errorAction
- (_, [t]) -> exactPrintNode
+ case (fallbackMode, exactPrinted) of
+ (ExactPrintFallbackModeNever, _ ) -> errorAction
+ (_ , [t]) -> exactPrintNode
(Text.dropWhile Char.isSpace . Text.dropWhileEnd Char.isSpace $ t)
- (ExactPrintFallbackModeRisky, _) -> exactPrintNode exactPrinted
+ (ExactPrintFallbackModeRisky, _) -> exactPrintNode
+ (Text.unlines exactPrinted)
_ -> errorAction
rdrNameToText :: RdrName -> Text