diff --git a/src-brittany/Main.hs b/src-brittany/Main.hs index ba66188..3652d47 100644 --- a/src-brittany/Main.hs +++ b/src-brittany/Main.hs @@ -248,7 +248,7 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM = ExceptT.runEx putErrorLn $ show left ExceptT.throwE 60 Right (anns, parsedSource, hasCPP) -> do - inlineConf <- case extractCommentConfigs anns (getTopLevelDeclNameMap parsedSource) of + (inlineConf, perItemConf) <- case extractCommentConfigs anns (getTopLevelDeclNameMap parsedSource) of Left (err, input) -> do putErrorLn $ "Error: parse error in inline configuration:" @@ -257,6 +257,7 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM = ExceptT.runEx 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 () @@ -265,15 +266,15 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM = ExceptT.runEx then do pure ([], Text.pack $ ExactPrint.exactPrint parsedSource anns) else do - let omitCheck = config & _conf_errorHandling .> _econf_omit_output_valid_check .> confUnpack + let omitCheck = moduleConf & _conf_errorHandling .> _econf_omit_output_valid_check .> confUnpack (ews, outRaw) <- if hasCPP || omitCheck - then return $ pPrintModule config inlineConf anns parsedSource - else liftIO $ pPrintModuleAndCheck config inlineConf anns parsedSource + then return $ pPrintModule moduleConf perItemConf anns parsedSource + else liftIO $ pPrintModuleAndCheck moduleConf perItemConf anns parsedSource 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") $ fmap hackF $ TextL.splitOn (TextL.pack "\n") outRaw else outRaw - out' <- if config & _conf_obfuscate & confUnpack + out' <- if moduleConf & _conf_obfuscate & confUnpack then lift $ obfuscate out else pure out pure $ (ews, out') diff --git a/src/Language/Haskell/Brittany/Internal.hs b/src/Language/Haskell/Brittany/Internal.hs index 6bc70eb..182f3ed 100644 --- a/src/Language/Haskell/Brittany/Internal.hs +++ b/src/Language/Haskell/Brittany/Internal.hs @@ -71,7 +71,7 @@ data InlineConfigTarget extractCommentConfigs :: ExactPrint.Anns -> TopLevelDeclNameMap - -> Either (String, String) InlineConfig + -> Either (String, String) (CConfig Option, PerItemConfig) extractCommentConfigs anns (TopLevelDeclNameMap declNameMap) = do let commentLiness = @@ -200,11 +200,10 @@ extractCommentConfigs anns (TopLevelDeclNameMap declNameMap) = do _ -> False ] - pure $ InlineConfig - { _icd_perModule = perModule - , _icd_perBinding = perBinding - , _icd_perKey = perKey - } + pure + $ ( perModule + , PerItemConfig { _icd_perBinding = perBinding, _icd_perKey = perKey } + ) getTopLevelDeclNameMap :: GHC.ParsedSource -> TopLevelDeclNameMap @@ -256,17 +255,19 @@ parsePrintModule configWithDebugs inputText = runExceptT $ do case parseResult of Left err -> throwE [ErrorInput err] Right x -> pure x - inlineConf <- either (throwE . (: []) . uncurry ErrorMacroConfig) pure - $ extractCommentConfigs anns (getTopLevelDeclNameMap parsedSource) + (inlineConf, perItemConf) <- + either (throwE . (: []) . uncurry ErrorMacroConfig) pure + $ extractCommentConfigs anns (getTopLevelDeclNameMap parsedSource) + let moduleConfig = cZipWith fromOptionIdentity config inlineConf (errsWarns, outputTextL) <- do let omitCheck = - config + moduleConfig & _conf_errorHandling & _econf_omit_output_valid_check & confUnpack (ews, outRaw) <- if hasCPP || omitCheck - then return $ pPrintModule config inlineConf anns parsedSource - else lift $ pPrintModuleAndCheck config inlineConf anns parsedSource + then return $ pPrintModule moduleConfig perItemConf anns parsedSource + else lift $ pPrintModuleAndCheck moduleConfig perItemConf anns parsedSource let hackF s = fromMaybe s $ TextL.stripPrefix (TextL.pack "-- BRITANY_INCLUDE_HACK ") s pure $ if hackAroundIncludes @@ -284,7 +285,7 @@ parsePrintModule configWithDebugs inputText = runExceptT $ do customErrOrder ErrorUnknownNode{} = 3 customErrOrder ErrorMacroConfig{} = 5 let hasErrors = - case config & _conf_errorHandling & _econf_Werror & confUnpack of + 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 @@ -297,7 +298,7 @@ parsePrintModule configWithDebugs inputText = runExceptT $ do -- can occur. pPrintModule :: Config - -> InlineConfig + -> PerItemConfig -> ExactPrint.Anns -> GHC.ParsedSource -> ([BrittanyError], TextL.Text) @@ -335,7 +336,7 @@ pPrintModule conf inlineConf anns parsedModule = -- if it does not. pPrintModuleAndCheck :: Config - -> InlineConfig + -> PerItemConfig -> ExactPrint.Anns -> GHC.ParsedSource -> IO ([BrittanyError], TextL.Text) @@ -361,18 +362,20 @@ parsePrintModuleTests conf filename input = do case parseResult of Left (_ , s ) -> return $ Left $ "parsing error: " ++ s Right (anns, parsedModule) -> runExceptT $ do - inlineConf <- + (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 conf inlineConf anns parsedModule - else lift $ pPrintModuleAndCheck conf inlineConf anns parsedModule + then return $ pPrintModule moduleConf perItemConf anns parsedModule + else + lift $ pPrintModuleAndCheck moduleConf perItemConf anns parsedModule if null errs then pure $ TextL.toStrict $ ltext else @@ -434,7 +437,6 @@ ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do let declAnnKey = ExactPrint.mkAnnKey decl let declBindingNames = getDeclBindingNames decl inlineConf <- mAsk - let inlineModConf = _icd_perModule inlineConf let mDeclConf = Map.lookup declAnnKey $ _icd_perKey inlineConf let mBindingConfs = declBindingNames <&> \n -> Map.lookup n $ _icd_perBinding inlineConf @@ -448,7 +450,7 @@ ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do config <- mAsk let config' = cZipWith fromOptionIdentity config $ mconcat - (inlineModConf : (catMaybes (mBindingConfs ++ [mDeclConf]))) + (catMaybes (mBindingConfs ++ [mDeclConf])) let exactprintOnly = config' & _conf_roundtrip_exactprint_only & confUnpack toLocal config' filteredAnns $ do diff --git a/src/Language/Haskell/Brittany/Internal/Types.hs b/src/Language/Haskell/Brittany/Internal/Types.hs index a28f940..221e1a9 100644 --- a/src/Language/Haskell/Brittany/Internal/Types.hs +++ b/src/Language/Haskell/Brittany/Internal/Types.hs @@ -28,9 +28,8 @@ import Data.Generics.Uniplate.Direct as Uniplate -data InlineConfig = InlineConfig - { _icd_perModule :: CConfig Option - , _icd_perBinding :: Map String (CConfig Option) +data PerItemConfig = PerItemConfig + { _icd_perBinding :: Map String (CConfig Option) , _icd_perKey :: Map ExactPrint.Types.AnnKey (CConfig Option) } #if MIN_VERSION_ghc(8,2,0) @@ -38,7 +37,7 @@ data InlineConfig = InlineConfig #endif type PPM = MultiRWSS.MultiRWS - '[Map ExactPrint.AnnKey ExactPrint.Anns, InlineConfig, Config, ExactPrint.Anns] + '[Map ExactPrint.AnnKey ExactPrint.Anns, PerItemConfig, Config, ExactPrint.Anns] '[Text.Builder.Builder, [BrittanyError], Seq String] '[]