Refactor a bit (Internal.ppDecl -> Decl.layoutDecl)

src/Language/Haskell/Brittany/Internal.hs

@@ -450,10 +450,12 @@ ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do
     let config' = cZipWith fromOptionIdentity config $ mconcat
           (inlineModConf : (catMaybes (mBindingConfs ++ [mDeclConf])))
 
-    toLocal config' filteredAnns
+    let exactprintOnly = config' & _conf_roundtrip_exactprint_only & confUnpack
-      $ if (config' & _conf_roundtrip_exactprint_only & confUnpack)
+    toLocal config' filteredAnns $ do
-          then briDocMToPPM (briDocByExactNoComment decl) >>= layoutBriDoc
+      bd <- briDocMToPPM $ if exactprintOnly
-          else ppDecl decl
+        then briDocByExactNoComment decl
+        else layoutDecl decl
+      layoutBriDoc bd
 
   let finalComments = filter
         (fst .> \case
@@ -477,19 +479,6 @@ ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do
       in  ppmMoveToExactLoc $ ExactPrint.DP (eofZ - cmY, eofX - cmX)
     _ -> return ()
 
-withTransformedAnns :: Data ast => ast -> PPMLocal () -> PPMLocal ()
-withTransformedAnns ast m = do
-  -- TODO: implement `local` for MultiReader/MultiRWS
-  readers@(conf :+: anns :+: HNil) <- MultiRWSS.mGetRawR
-  MultiRWSS.mPutRawR (conf :+: f anns :+: HNil)
-  m
-  MultiRWSS.mPutRawR readers
- where
-  f anns =
-    let ((), (annsBalanced, _), _) =
-          ExactPrint.runTransform anns (commentAnnFixTransformGlob ast)
-    in  annsBalanced
-
 
 getDeclBindingNames :: LHsDecl GhcPs -> [String]
 getDeclBindingNames (L _ decl) = case decl of
@@ -498,38 +487,6 @@ getDeclBindingNames (L _ decl) = case decl of
   _ -> []
 
 
-ppDecl :: LHsDecl GhcPs -> PPMLocal ()
-ppDecl d@(L loc decl) = case decl of
-  SigD sig -> -- trace (_sigHead sig) $
-              withTransformedAnns d $ do
-    -- runLayouter $ Old.layoutSig (L loc sig)
-    briDoc <- briDocMToPPM $ layoutSig (L loc sig)
-    layoutBriDoc briDoc
-  ValD bind -> -- trace (_bindHead bind) $
-               withTransformedAnns d $ do
-    -- Old.layoutBind (L loc bind)
-    briDoc <- briDocMToPPM $ do
-      eitherNode <- layoutBind (L loc bind)
-      case eitherNode of
-        Left  ns -> docLines $ return <$> ns
-        Right n  -> return n
-    layoutBriDoc briDoc
-  InstD (TyFamInstD{}) -> do
-    -- this is a (temporary (..)) workaround for "type instance" decls
-    -- that do not round-trip through exactprint properly.
-    let fixer s = case List.stripPrefix "type " s of
-          Just rest | not ("instance" `isPrefixOf` rest) ->
-            "type instance " ++ rest
-          _ -> s
-    str <- mAsk <&> \anns ->
-      intercalate "\n" $ fmap fixer $ lines' $ ExactPrint.exactPrint d anns
-    bd <- briDocMToPPM $ allocateNode $ BDFExternal (ExactPrint.mkAnnKey d)
-                                                    (foldedAnnKeys d)
-                                                    False
-                                                    (Text.pack str)
-    layoutBriDoc bd
-  _ -> briDocMToPPM (briDocByExactNoComment d) >>= layoutBriDoc
-
 -- Prints the information associated with the module annotation
 -- This includes the imports
 ppPreamble :: GenLocated SrcSpan (HsModule GhcPs)

src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs

@@ -7,6 +7,7 @@ module Language.Haskell.Brittany.Internal.ExactPrintUtils
   , commentAnnFixTransformGlob
   , extractToplevelAnns
   , foldedAnnKeys
+  , withTransformedAnns
   )
 where
 
@@ -17,6 +18,8 @@ where
 import           Language.Haskell.Brittany.Internal.Types
 import           Language.Haskell.Brittany.Internal.Config.Types
 import           Language.Haskell.Brittany.Internal.Utils
+import           Data.Data
+import           Data.HList.HList
 
 import           DynFlags ( getDynFlags )
 import           GHC ( runGhc, GenLocated(L), moduleNameString )
@@ -266,6 +269,25 @@ foldedAnnKeys ast = SYB.everything
   where locTyCon = SYB.typeRepTyCon (SYB.typeOf (L () ()))
 
 
+withTransformedAnns
+  :: Data ast
+  => ast
+  -> MultiRWSS.MultiRWS '[Config, ExactPrint.Anns] w s a
+  -> MultiRWSS.MultiRWS '[Config, ExactPrint.Anns] w s a
+withTransformedAnns ast m = do
+  -- TODO: implement `local` for MultiReader/MultiRWS
+  readers@(conf :+: anns :+: HNil) <- MultiRWSS.mGetRawR
+  MultiRWSS.mPutRawR (conf :+: f anns :+: HNil)
+  x <- m
+  MultiRWSS.mPutRawR readers
+  pure x
+ where
+  f anns =
+    let ((), (annsBalanced, _), _) =
+          ExactPrint.runTransform anns (commentAnnFixTransformGlob ast)
+    in  annsBalanced
+
+
 #if MIN_VERSION_ghc(8,4,0) /* ghc-8.4 */
 warnExtractorCompat :: GHC.Warn -> String
 warnExtractorCompat (GHC.Warn _ (L _ s)) = s

src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs

@@ -2,7 +2,8 @@
 {-# LANGUAGE TypeApplications #-}
 
 module Language.Haskell.Brittany.Internal.Layouters.Decl
-  ( layoutSig
+  ( layoutDecl
+  , layoutSig
   , layoutBind
   , layoutLocalBinds
   , layoutGuardLStmt
@@ -20,6 +21,11 @@ import           Language.Haskell.Brittany.Internal.Types
 import           Language.Haskell.Brittany.Internal.LayouterBasics
 import           Language.Haskell.Brittany.Internal.Config.Types
 
+import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
+import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
+import           Language.Haskell.Brittany.Internal.ExactPrintUtils
+import           Language.Haskell.Brittany.Internal.Utils
+
 import           GHC ( runGhc, GenLocated(L), moduleNameString )
 import           SrcLoc ( SrcSpan )
 import           HsSyn
@@ -40,6 +46,28 @@ import           Bag ( mapBagM )
 
 
 
+layoutDecl :: ToBriDoc HsDecl
+layoutDecl d@(L loc decl) = case decl of
+  SigD sig  -> withTransformedAnns d $ layoutSig (L loc sig)
+  ValD bind -> withTransformedAnns d $ layoutBind (L loc bind) >>= \case
+    Left  ns -> docLines $ return <$> ns
+    Right n  -> return n
+  InstD (TyFamInstD{}) -> do
+    -- this is a (temporary (..)) workaround for "type instance" decls
+    -- that do not round-trip through exactprint properly.
+    let fixer s = case List.stripPrefix "type " s of
+          Just rest | not ("instance" `isPrefixOf` rest) ->
+            "type instance " ++ rest
+          _ -> s
+    str <- mAsk <&> \anns ->
+      intercalate "\n" $ fmap fixer $ lines' $ ExactPrint.exactPrint d anns
+    allocateNode $ BDFExternal (ExactPrint.mkAnnKey d)
+                               (foldedAnnKeys d)
+                               False
+                               (Text.pack str)
+  _ -> briDocByExactNoComment d
+
+
 layoutSig :: ToBriDoc Sig
 layoutSig lsig@(L _loc sig) = case sig of
 #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */