Refactor internals and expose pPrintModule
parent
af227a797d
commit
8bd669f145
|
|
@ -328,18 +328,6 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM =
|
|||
putErrorLn $ show left
|
||||
ExceptT.throwE 60
|
||||
Right (anns, parsedSource, hasCPP) -> do
|
||||
(inlineConf, perItemConf) <-
|
||||
case
|
||||
extractCommentConfigs anns (getTopLevelDeclNameMap parsedSource)
|
||||
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 100 (customLayouterF anns) parsedSource
|
||||
trace ("---- ast ----\n" ++ show val) $ return ()
|
||||
|
|
@ -349,15 +337,14 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM =
|
|||
pure ([], Text.pack $ ExactPrint.exactPrint parsedSource anns)
|
||||
else do
|
||||
let omitCheck =
|
||||
moduleConf
|
||||
config
|
||||
& _conf_errorHandling
|
||||
.> _econf_omit_output_valid_check
|
||||
.> confUnpack
|
||||
(ews, outRaw) <- if hasCPP || omitCheck
|
||||
then return
|
||||
$ pPrintModule moduleConf perItemConf anns parsedSource
|
||||
else liftIO $ pPrintModuleAndCheck moduleConf
|
||||
perItemConf
|
||||
$ pPrintModule config anns parsedSource
|
||||
else liftIO $ pPrintModuleAndCheck config
|
||||
anns
|
||||
parsedSource
|
||||
let hackF s = fromMaybe s $ TextL.stripPrefix
|
||||
|
|
@ -369,7 +356,7 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM =
|
|||
$ fmap hackF
|
||||
$ TextL.splitOn (TextL.pack "\n") outRaw
|
||||
else outRaw
|
||||
out' <- if moduleConf & _conf_obfuscate & confUnpack
|
||||
out' <- if config & _conf_obfuscate & confUnpack
|
||||
then lift $ obfuscate out
|
||||
else pure out
|
||||
pure $ (ews, out')
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
|
||||
module Language.Haskell.Brittany
|
||||
( parsePrintModule
|
||||
, pPrintModule
|
||||
, staticDefaultConfig
|
||||
, forwardOptionsSyntaxExtsEnabled
|
||||
, userConfigPath
|
||||
|
|
|
|||
|
|
@ -263,20 +263,16 @@ parsePrintModule configWithDebugs inputText = runExceptT $ do
|
|||
case parseResult of
|
||||
Left err -> throwE [ErrorInput err]
|
||||
Right x -> pure x
|
||||
(inlineConf, perItemConf) <-
|
||||
either (throwE . (: []) . uncurry ErrorMacroConfig) pure
|
||||
$ extractCommentConfigs anns (getTopLevelDeclNameMap parsedSource)
|
||||
let moduleConfig = cZipWith fromOptionIdentity config inlineConf
|
||||
(errsWarns, outputTextL) <- do
|
||||
let omitCheck =
|
||||
moduleConfig
|
||||
config
|
||||
& _conf_errorHandling
|
||||
& _econf_omit_output_valid_check
|
||||
& confUnpack
|
||||
(ews, outRaw) <- if hasCPP || omitCheck
|
||||
then return $ pPrintModule moduleConfig perItemConf anns parsedSource
|
||||
then return $ pPrintModule config anns parsedSource
|
||||
else lift
|
||||
$ pPrintModuleAndCheck moduleConfig perItemConf anns parsedSource
|
||||
$ pPrintModuleAndCheck config anns parsedSource
|
||||
let hackF s = fromMaybe s
|
||||
$ TextL.stripPrefix (TextL.pack "-- BRITANY_INCLUDE_HACK ") s
|
||||
pure $ if hackAroundIncludes
|
||||
|
|
@ -294,7 +290,7 @@ parsePrintModule configWithDebugs inputText = runExceptT $ do
|
|||
customErrOrder ErrorUnknownNode{} = 3
|
||||
customErrOrder ErrorMacroConfig{} = 5
|
||||
let hasErrors =
|
||||
case moduleConfig & _conf_errorHandling & _econf_Werror & confUnpack of
|
||||
case config & _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
|
||||
|
|
@ -307,23 +303,28 @@ parsePrintModule configWithDebugs inputText = runExceptT $ do
|
|||
-- can occur.
|
||||
pPrintModule
|
||||
:: Config
|
||||
-> PerItemConfig
|
||||
-> ExactPrint.Anns
|
||||
-> GHC.ParsedSource
|
||||
-> ([BrittanyError], TextL.Text)
|
||||
pPrintModule conf inlineConf anns parsedModule =
|
||||
let ((out, errs), debugStrings) =
|
||||
pPrintModule conf anns parsedModule =
|
||||
case extractCommentConfigs anns (getTopLevelDeclNameMap parsedModule) of
|
||||
Left (eErr, eInp) -> ([ErrorMacroConfig eErr eInp], TextL.empty)
|
||||
Right (inlineConf, perItemConf) ->
|
||||
let moduleConfig = cZipWith fromOptionIdentity conf inlineConf
|
||||
((out, errs), debugStrings) =
|
||||
runIdentity
|
||||
$ MultiRWSS.runMultiRWSTNil
|
||||
$ MultiRWSS.withMultiWriterAW
|
||||
$ MultiRWSS.withMultiWriterAW
|
||||
$ MultiRWSS.withMultiWriterW
|
||||
$ MultiRWSS.withMultiReader anns
|
||||
$ MultiRWSS.withMultiReader conf
|
||||
$ MultiRWSS.withMultiReader inlineConf
|
||||
$ MultiRWSS.withMultiReader (extractToplevelAnns parsedModule anns)
|
||||
$ MultiRWSS.withMultiReader moduleConfig
|
||||
$ MultiRWSS.withMultiReader perItemConf
|
||||
$ MultiRWSS.withMultiReader
|
||||
(extractToplevelAnns parsedModule anns)
|
||||
$ do
|
||||
traceIfDumpConf "bridoc annotations raw" _dconf_dump_annotations
|
||||
traceIfDumpConf "bridoc annotations raw"
|
||||
_dconf_dump_annotations
|
||||
$ annsDoc anns
|
||||
ppModule parsedModule
|
||||
tracer = if Seq.null debugStrings
|
||||
|
|
@ -332,6 +333,7 @@ pPrintModule conf inlineConf anns parsedModule =
|
|||
trace ("---- DEBUGMESSAGES ---- ")
|
||||
. foldr (seq . join trace) id debugStrings
|
||||
in tracer $ (errs, Text.Builder.toLazyText out)
|
||||
|
||||
-- unless () $ do
|
||||
--
|
||||
-- debugStrings `forM_` \s ->
|
||||
|
|
@ -341,13 +343,12 @@ pPrintModule conf inlineConf anns parsedModule =
|
|||
-- if it does not.
|
||||
pPrintModuleAndCheck
|
||||
:: Config
|
||||
-> PerItemConfig
|
||||
-> ExactPrint.Anns
|
||||
-> GHC.ParsedSource
|
||||
-> IO ([BrittanyError], TextL.Text)
|
||||
pPrintModuleAndCheck conf inlineConf anns parsedModule = do
|
||||
pPrintModuleAndCheck conf anns parsedModule = do
|
||||
let (errs, output) = pPrintModule conf anns parsedModule
|
||||
let ghcOptions = conf & _conf_forward & _options_ghc & runIdentity
|
||||
let (errs, output) = pPrintModule conf inlineConf anns parsedModule
|
||||
parseResult <- parseModuleFromString ghcOptions
|
||||
"output"
|
||||
(\_ -> return $ Right ())
|
||||
|
|
@ -367,20 +368,15 @@ parsePrintModuleTests conf filename input = do
|
|||
case parseResult of
|
||||
Left (_ , s ) -> return $ Left $ "parsing error: " ++ s
|
||||
Right (anns, parsedModule) -> runExceptT $ do
|
||||
(inlineConf, perItemConf) <-
|
||||
case extractCommentConfigs anns (getTopLevelDeclNameMap parsedModule) of
|
||||
Left err -> throwE $ "error in inline config: " ++ show err
|
||||
Right x -> pure x
|
||||
let moduleConf = cZipWith fromOptionIdentity conf inlineConf
|
||||
let omitCheck =
|
||||
conf
|
||||
& _conf_errorHandling
|
||||
.> _econf_omit_output_valid_check
|
||||
.> confUnpack
|
||||
(errs, ltext) <- if omitCheck
|
||||
then return $ pPrintModule moduleConf perItemConf anns parsedModule
|
||||
then return $ pPrintModule conf anns parsedModule
|
||||
else lift
|
||||
$ pPrintModuleAndCheck moduleConf perItemConf anns parsedModule
|
||||
$ pPrintModuleAndCheck conf anns parsedModule
|
||||
if null errs
|
||||
then pure $ TextL.toStrict $ ltext
|
||||
else
|
||||
|
|
|
|||
Loading…
Reference in New Issue