Fix exactprinting fallback for inline splice

ghc92
Lennart Spitzner 2023-05-30 10:44:30 +02:00
parent 4ed3a2f53d
commit 49a2529a5b
1 changed files with 16 additions and 20 deletions

View File

@ -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