Apply inline config to module header (fixes #151)

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')

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
+  (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

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]
   '[]