Use dependency-injection for ToBriDoc modules

I assume this makes inlining impossible, but it enables
parallel compilation of all these modules. In my tests
this reduce wall clock time to 92%, and with more cores
the benefit should be higher.

brittany.cabal

@@ -136,6 +136,7 @@ library
     Language.Haskell.Brittany.Internal.ToBriDoc.Pattern
     Language.Haskell.Brittany.Internal.ToBriDoc.Stmt
     Language.Haskell.Brittany.Internal.ToBriDoc.Type
+    Language.Haskell.Brittany.Internal.ToBriDoc
     Language.Haskell.Brittany.Internal.Components.BriDoc
     Language.Haskell.Brittany.Internal.Components.Obfuscation
     Language.Haskell.Brittany.Internal.Components.OpTree

source/library/Language/Haskell/Brittany/Internal/Components/OpTree.hs

@@ -5,7 +5,6 @@ module Language.Haskell.Brittany.Internal.Components.OpTree where
 import           Language.Haskell.Brittany.Internal.Prelude
 
 import qualified Data.Text                     as Text
-import           GHC                            ( RealSrcLoc )
 import           GHC.Types.Fixity               ( Fixity(Fixity)
                                                 , FixityDirection
                                                   ( InfixL
@@ -23,20 +22,6 @@ import           Language.Haskell.Brittany.Internal.Types
 
 
 
-data OpTree
-  = OpUnknown Bool -- Z paren?
-              (Maybe RealSrcLoc) -- paren open loc
-              (Maybe RealSrcLoc) -- paren close loc
-              OpTree -- left operand
-              [(BriDocNumbered, BriDocNumbered)] -- list of (next operand, symbol)
-  | OpKnown Bool     -- with paren?
-              (Maybe RealSrcLoc) -- paren open loc
-              (Maybe RealSrcLoc) -- paren close loc
-            Fixity   -- only Just after (successful!) lookup phase
-            OpTree
-            [(BriDocNumbered, OpTree)]
-  | OpLeaf BriDocNumbered
-
 displayOpTree :: OpTree -> String
 displayOpTree = \case
   OpUnknown p _ _ leftTree rs ->

source/library/Language/Haskell/Brittany/Internal/StepOrchestrate.hs

@@ -45,6 +45,7 @@ import           Language.Haskell.Brittany.Internal.ToBriDoc.Module
 import           Language.Haskell.Brittany.Internal.Types
 import           Language.Haskell.Brittany.Internal.Util.AST
 import           Language.Haskell.Brittany.Internal.Utils
+import           Language.Haskell.Brittany.Internal.ToBriDoc (layouters)
 
 
 
@@ -87,7 +88,7 @@ processModule traceFunc conf inlineConf parsedModule = do
                   case modHead of
                     HsModule epAnn _layoutInfo Nothing Nothing _ _ _ _ -> do
                       (bd, _) <-
-                        briDocMToPPM
+                        briDocMToPPM layouters
                         $ maybe id
                                 docFlushRemaining
                                 (srcSpanFileName_maybe loc)
@@ -97,7 +98,7 @@ processModule traceFunc conf inlineConf parsedModule = do
                       "brittany internal error: exports without module name"
                     HsModule epAnn _layoutInfo (Just n) les _ _ _ _ -> do
                       (bd, _) <-
-                        briDocMToPPM
+                        briDocMToPPM layouters
                         $ maybe id
                                 docFlushRemaining
                                 (srcSpanFileName_maybe loc)
@@ -106,7 +107,7 @@ processModule traceFunc conf inlineConf parsedModule = do
                 MEImportDecl importDecl immediateAfterComms ->
                   wrapNonDeclToBriDoc $ do
                     (bd, _) <-
-                      briDocMToPPM
+                      briDocMToPPM layouters
                         $ docSeq
                             ( layoutImport importDecl
                             : map commentToDoc immediateAfterComms
@@ -215,18 +216,18 @@ ppToplevelDecl decl immediateAfterComms = do
   exactprintOnly <- mAsk <&> \declConfig ->
     declConfig & _conf_roundtrip_exactprint_only & confUnpack
   bd <- fmap fst $ if exactprintOnly
-    then briDocMToPPM
+    then briDocMToPPM layouters
       $ docSeq (briDocByExact decl : map commentToDoc immediateAfterComms)
     else do
       let innerDoc = case decl of
             L (SrcSpanAnn _ (GHC.RealSrcSpan s _)) _ ->
               docFlushRemaining (GHC.srcSpanFile s) $ layoutDecl decl
             _ -> layoutDecl decl
-      (r, errorCount) <- briDocMToPPM
+      (r, errorCount) <- briDocMToPPM layouters
         $ docSeq (innerDoc : map commentToDoc immediateAfterComms)
       if errorCount == 0
         then pure (r, 0)
-        else briDocMToPPM $ briDocByExactNoComment decl
+        else briDocMToPPM layouters $ briDocByExactNoComment decl
   ppBriDoc bd False
   let commCntIn = connectedCommentCount decl
   commCntOut <- mGet

source/library/Language/Haskell/Brittany/Internal/ToBriDoc.hs

@@ -0,0 +1,39 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Language.Haskell.Brittany.Internal.ToBriDoc where
+
+
+import           Language.Haskell.Brittany.Internal.Types
+import           Language.Haskell.Brittany.Internal.ToBriDoc.DataDecl
+import           Language.Haskell.Brittany.Internal.ToBriDoc.Decl
+import           Language.Haskell.Brittany.Internal.ToBriDoc.Expr
+import           Language.Haskell.Brittany.Internal.ToBriDoc.OpTree
+import           Language.Haskell.Brittany.Internal.ToBriDoc.IE
+import           Language.Haskell.Brittany.Internal.ToBriDoc.Pattern
+import           Language.Haskell.Brittany.Internal.ToBriDoc.Stmt
+import           Language.Haskell.Brittany.Internal.ToBriDoc.Type
+
+layouters :: Layouters
+layouters = Layouters
+  { layout_expr                 = layoutExpr
+  , layout_lit                  = litBriDoc
+  , layout_overLit              = overLitValBriDoc
+  , layout_type                 = layoutType
+  , layout_sigType              = layoutSigType
+  , layout_stmt                 = layoutStmt
+  , layout_gatherOpTreeE        = gatherOpTreeE
+  , layout_gatherOpTreeT        = gatherOpTreeT
+  , layout_opTree               = processOpTree
+  , layout_grhs                 = layoutGrhs
+  , layout_pat                  = layoutPat
+  , layout_colsWrapPat          = colsWrapPat
+  , layout_patternBind          = layoutPatternBind
+  , layout_patternBindFinal     = layoutPatternBindFinal
+  , layout_localBinds           = layoutLocalBinds
+  , layout_dataDecl             = layoutDataDecl
+  , layout_tyVarBndrs           = layoutTyVarBndrs
+  , layout_tyVarBndrsSingleline = processTyVarBndrsSingleline
+  , layout_hsTyPats             = layoutHsTyPats
+  , layout_LLIEs                = layoutLLIEs
+  , layout_annAndSepLLIEs       = layoutAnnAndSepLLIEs
+  }

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/DataDecl.hs

@@ -8,7 +8,6 @@ import GHC.Hs
 import qualified GHC.OldList as List
 import Language.Haskell.Brittany.Internal.Config.Types
 import Language.Haskell.Brittany.Internal.S3_ToBriDocTools
-import Language.Haskell.Brittany.Internal.ToBriDoc.Type
 import Language.Haskell.Brittany.Internal.Prelude
 import Language.Haskell.Brittany.Internal.Types
 import Language.Haskell.Brittany.Internal.Components.BriDoc
@@ -223,8 +222,9 @@ layoutDataDecl ltycl declEpAnn name (HsQTvs _ bndrs) pats defn = case defn of
 layoutHsTyPats
   :: [LHsTypeArg GhcPs] -> [ToBriDocM BriDocNumbered]
 layoutHsTyPats pats = pats <&> \case
-  HsValArg tm -> layoutType tm
+  HsValArg tm -> callLayouter layout_type tm
-  HsTypeArg _l ty -> docSeq [docLit $ Text.pack "@", layoutType ty]
+  HsTypeArg _l ty ->
+    docSeq [docLit $ Text.pack "@", callLayouter layout_type ty]
     -- we ignore the SourceLoc here.. this LPat not being (L _ Pat{}) change
     -- is a bit strange. Hopefully this does not ignore any important
     -- annotations.
@@ -233,10 +233,10 @@ layoutHsTyPats pats = pats <&> \case
 createContextDoc :: HsContext GhcPs -> ToBriDocM BriDocNumbered
 createContextDoc [] = docEmpty
 createContextDoc [t] =
-  docSeq [layoutType t, docSeparator, docLitS "=>", docSeparator]
+  docSeq [callLayouter layout_type t, docSeparator, docLitS "=>", docSeparator]
 createContextDoc (t1 : tR) = do
-  t1Doc <- shareDoc $ layoutType t1
+  t1Doc <- shareDoc $ callLayouter layout_type t1
-  tRDocs <- tR `forM` (shareDoc . layoutType)
+  tRDocs <- tR `forM` (shareDoc . callLayouter layout_type)
   docAlt
     [ docSeq
       [ docLitS "("
@@ -258,7 +258,7 @@ createBndrDoc bs = do
   tyVarDocs <- bs `forM` \case
     (L _ (UserTyVar _ _ext vname)) -> return $ (lrdrNameToText vname, Nothing)
     (L _ (KindedTyVar _ _ext lrdrName kind)) -> do
-      d <- shareDoc $ layoutType kind
+      d <- shareDoc $ callLayouter layout_type kind
       return $ (lrdrNameToText lrdrName, Just $ d)
   docSeq $ List.intersperse docSeparator $ tyVarDocs <&> \(vname, mKind) ->
     case mKind of
@@ -297,7 +297,7 @@ derivingClauseDoc (L _ (HsDerivingClause epAnn mStrategy types)) =
         [ docDeriving
         , docHandleComms types $ lhsStrategy
         , docSeparator
-        , docHandleListElemComms layoutSigType ty -- TODO92 `docHandleRemaining types` here ?
+        , docHandleListElemComms (callLayouter layout_sigType) ty -- TODO92 `docHandleRemaining types` here ?
           -- \case
           --     HsIB _ t -> layoutType t
         , rhsStrategy
@@ -319,7 +319,7 @@ derivingClauseDoc (L _ (HsDerivingClause epAnn mStrategy types)) =
         , whenMoreThan1Type "("
         , docSeq -- TODO92 `docHandleRemaining types` here ?
         $ List.intersperse docCommaSep
-        $ ts <&> docHandleListElemComms layoutSigType
+        $ ts <&> docHandleListElemComms (callLayouter layout_sigType)
         , docHandleComms posClose $ whenMoreThan1Type ")"
         , rhsStrategy
         ]
@@ -335,7 +335,7 @@ derivingClauseDoc (L _ (HsDerivingClause epAnn mStrategy types)) =
       , docSeq
         [ docHandleComms viaEpAnn $ docLitS " via"
         , docSeparator
-        , docHandleListElemComms layoutSigType viaType
+        , docHandleListElemComms (callLayouter layout_sigType) viaType
         ]
       )
 
@@ -353,23 +353,25 @@ createDetailsDoc consNameStr details = case details of
         $ docSeq
         $ List.intersperse docSeparator
         $ fmap hsScaledThing args
-        <&> layoutType
+        <&> callLayouter layout_type
         ]
       leftIndented =
         docSetParSpacing
           . docAddBaseY BrIndentRegular
           . docPar (docLit consNameStr)
           . docLines
-          $ layoutType
+          $ callLayouter layout_type
           <$> fmap hsScaledThing args
       multiAppended = docSeq
         [ docLit consNameStr
         , docSeparator
-        , docSetBaseY $ docLines $ layoutType <$> fmap hsScaledThing args
+        , docSetBaseY
+          $ docLines
+          $ callLayouter layout_type <$> fmap hsScaledThing args
         ]
       multiIndented = docSetBaseY $ docAddBaseY BrIndentRegular $ docPar
         (docLit consNameStr)
-        (docLines $ layoutType <$> fmap hsScaledThing args)
+        (docLines $ callLayouter layout_type <$> fmap hsScaledThing args)
     case indentPolicy of
       IndentPolicyLeft -> docAlt [singleLine, leftIndented]
       IndentPolicyMultiple -> docAlt [singleLine, multiAppended, leftIndented]
@@ -450,11 +452,11 @@ createDetailsDoc consNameStr details = case details of
           ]
         )
   InfixCon arg1 arg2 -> docSeq
-    [ layoutType $ hsScaledThing arg1
+    [ callLayouter layout_type $ hsScaledThing arg1
     , docSeparator
     , docLit consNameStr
     , docSeparator
-    , layoutType $ hsScaledThing arg2
+    , callLayouter layout_type $ hsScaledThing arg2
     ]
  where
   mkFieldDocs
@@ -480,7 +482,7 @@ createNamesAndTypeDoc lField@(L _ (ConDeclField epAnn names t _)) =
             L _ (FieldOcc _ fieldName) ->
               docLit =<< lrdrNameToTextAnn fieldName
         ]
-  , docFlushCommsPost True posComma (layoutType t)
+  , docFlushCommsPost True posComma (callLayouter layout_type t)
   )
  where
   (posStart, posComma) = obtainListElemStartCommaLocs lField

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Decl.hs

@@ -22,11 +22,6 @@ import qualified GHC
 import qualified GHC.Types.SrcLoc as GHC
 import Language.Haskell.Brittany.Internal.Config.Types
 import Language.Haskell.Brittany.Internal.S3_ToBriDocTools
-import Language.Haskell.Brittany.Internal.ToBriDoc.DataDecl
-import {-# SOURCE #-} Language.Haskell.Brittany.Internal.ToBriDoc.Expr
-import Language.Haskell.Brittany.Internal.ToBriDoc.Pattern
-import {-# SOURCE #-} Language.Haskell.Brittany.Internal.ToBriDoc.Stmt
-import Language.Haskell.Brittany.Internal.ToBriDoc.Type
 import Language.Haskell.Brittany.Internal.Prelude
 import Language.Haskell.Brittany.Internal.Types
 import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
@@ -96,7 +91,7 @@ layoutSig fallback sig = case sig of
     let posColon = obtainAnnPos addEpAnn AnnDcolon
     nameStrs <- names `forM` lrdrNameToTextAnn
     let nameStr = Text.intercalate (Text.pack ", ") $ nameStrs
-    typeDoc <- shareDoc $ layoutSigType sigTy
+    typeDoc <- shareDoc $ callLayouter layout_sigType sigTy
     let hasComments = hasAnyCommentsBelow fallback
     shouldBeHanging <-
       mAsk <&> _conf_layout .> _lconfig_hangingTypeSignature .> confUnpack
@@ -160,8 +155,8 @@ layoutBind lbind@(L _ bind) = case bind of
       $ matches `forM` layoutPatternBind (Just idStr) binderDoc
     return $ Left $ funcPatDocs
   PatBind _epAnn pat (GRHSs _ grhss whereBinds) ([], []) -> do -- TODO92 are we ignoring something in whereBinds?
-    patDocs <- colsWrapPat =<< layoutPat pat
+    patDocs <- callLayouter layout_colsWrapPat =<< callLayouter layout_pat pat
-    mWhereDocs <- layoutLocalBinds $ whereBinds
+    mWhereDocs <- layoutLocalBinds whereBinds
     -- let mWhereArg = mWhereDocs <&> (,) (mkAnnKey lbind) -- TODO: is this the right AnnKey?
     binderDoc <- docLit $ Text.pack "="
     let hasComments = hasAnyCommentsBelow lbind
@@ -241,8 +236,8 @@ layoutGrhs (L _ (GRHS epAnn guards body)) = do
   let posArrow = obtainAnnPos epAnn AnnRarrow
   guardDocs <- case guards of
     [] -> pure []
-    _ -> docFlushCommsPost False posArrow $ layoutStmt `mapM` guards
+    _  -> docFlushCommsPost False posArrow $ callLayouter layout_stmt `mapM` guards
-  bodyDoc <- layoutExpr body
+  bodyDoc <- callLayouter layout_expr body
   return (docHandleComms epAnn, guardDocs, bodyDoc)
 
 layoutPatternBind
@@ -252,7 +247,8 @@ layoutPatternBind
   -> ToBriDocM BriDocNumbered
 layoutPatternBind funId binderDoc lmatch@(L _ match) = do
   let Match epAnn matchCtx pats (GRHSs _ grhss whereBinds) = match
-  patDocs <- pats `forM` \p -> fmap return $ colsWrapPat =<< layoutPat p
+  patDocs <- pats `forM` \p ->
+    fmap return $ callLayouter layout_colsWrapPat =<< callLayouter layout_pat p
   let isInfix = isInfixMatch match
   let matchEndLoc = case GHC.locA $ GHC.getLoc lmatch of
         GHC.RealSrcSpan s _ -> Just $ GHC.realSrcSpanEnd s
@@ -410,7 +406,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses mWhereDocs hasCo
 
     clauseDocs <- case clauses of
       Left expr -> do
-        e <- layoutExpr expr
+        e <- callLayouter layout_expr expr
         pure [(id, [], e)]
       Right grhss -> layoutGrhs `mapM` grhss
 
@@ -656,7 +652,7 @@ layoutPatSynBind name patSynDetails patDir rpat = do
     binderDoc = case patDir of
       ImplicitBidirectional -> docLit $ Text.pack "="
       _ -> docLit $ Text.pack "<-"
-    body = colsWrapPat =<< layoutPat rpat
+    body = callLayouter layout_colsWrapPat =<< callLayouter layout_pat rpat
     whereDoc = docLit $ Text.pack "where"
   mWhereDocs <- layoutPatSynWhere patDir
   headDoc <-
@@ -775,15 +771,16 @@ layoutTyCl ltycl@(L _loc tycl) = case tycl of
                  ]
               ++ fmap (layoutTyVarBndr True) (hsq_explicit vars)
       sharedLhs <- shareDoc $ id lhs
-      typeDoc   <- shareDoc $ layoutType typ
+      typeDoc   <- shareDoc $ callLayouter layout_type typ
       let hasComments = hasAnyCommentsConnected ltycl
       layoutLhsAndType hasComments
                        sharedLhs
                        (docHandleComms posEqual $ docLit $ Text.pack "=")
                        1
                        typeDoc
-  DataDecl epAnn name tyVars _ dataDefn ->
+  DataDecl epAnn name tyVars _ dataDefn -> do
-    layoutDataDecl ltycl epAnn name tyVars [] dataDefn
+    layouters <- mAsk
+    layout_dataDecl layouters ltycl epAnn name tyVars [] dataDefn
   _ -> briDocByExactNoComment ltycl
 
 layoutTyVarBndr :: Bool -> ToBriDoc (HsTyVarBndr ())
@@ -798,7 +795,7 @@ layoutTyVarBndr needsSep (L _ bndr) = case bndr of
       ++ [ docLit $ Text.pack "("
          , appSep $ docLit nameStr
          , appSep . docLit $ Text.pack "::"
-         , docForceSingleline $ layoutType kind
+         , docForceSingleline $ callLayouter layout_type kind
          , docLit $ Text.pack ")"
          ]
 
@@ -825,6 +822,7 @@ layoutTyFamInstDecl inClass outerNode tfid = do
   nameStr <- lrdrNameToTextAnn name
   -- TODO92 needsParens <- hasAnnKeyword outerNode AnnOpenP
   let needsParens = False
+  layouters <- mAsk
   let
     instanceDoc = docHandleComms posType $ if inClass
       then docLit $ Text.pack "type"
@@ -832,9 +830,10 @@ layoutTyFamInstDecl inClass outerNode tfid = do
         [appSep . docLit $ Text.pack "type", docLit $ Text.pack "instance"]
     makeForallDoc :: [LHsTyVarBndr () GhcPs] -> ToBriDocM BriDocNumbered
     makeForallDoc bndrs = do
-      bndrDocs <- layoutTyVarBndrs bndrs
+      bndrDocs <- callLayouter layout_tyVarBndrs bndrs
       docSeq
-        ([docLit (Text.pack "forall")] ++ processTyVarBndrsSingleline bndrDocs
+        (  [docLit (Text.pack "forall")]
+        ++ layout_tyVarBndrsSingleline layouters bndrDocs
         )
     lhs =
       docHandleComms epAnn $ docSeq
@@ -842,14 +841,14 @@ layoutTyFamInstDecl inClass outerNode tfid = do
         ++ [ makeForallDoc foralls | (HsOuterExplicit _ foralls) <- [bndrsMay] ]
         ++ [ docParenL | needsParens ]
         ++ [appSep $ docHandleComms name $ docLit nameStr]
-        ++ intersperse docSeparator (layoutHsTyPats pats)
+        ++ intersperse docSeparator (layout_hsTyPats layouters pats)
         ++ [ docParenR | needsParens ]
   -- TODO92 hasComments <-
     -- (||)
     -- <$> hasAnyRegularCommentsConnected outerNode
     -- <*> hasAnyRegularCommentsRest innerNode
   let hasComments = hasAnyCommentsConnected outerNode
-  typeDoc <- shareDoc $ layoutType typ
+  typeDoc <- shareDoc $ callLayouter layout_type typ
   layoutLhsAndType hasComments lhs (docHandleComms posEqual $ docLit $ Text.pack "=") 1 typeDoc
 
 
@@ -941,7 +940,9 @@ layoutClsInst (L declLoc _) cid = do
   layoutDataFamInstDecl ldfid@(L _ (DataFamInstDecl famEqn)) =
     docHandleComms ldfid $ case famEqn of
       FamEqn epAnn tycon bndrs pats Prefix rhs -> do
-        layoutDataDecl
+        layouters <- mAsk
+        layout_dataDecl
+          layouters
           (error "Unsupported form of DataFamInstDecl")
           epAnn
           tycon

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs

@@ -24,13 +24,8 @@ import           Language.Haskell.Brittany.Internal.Components.BriDoc
 import           Language.Haskell.Brittany.Internal.Config.Types
 import           Language.Haskell.Brittany.Internal.Prelude
 import           Language.Haskell.Brittany.Internal.S3_ToBriDocTools
-import           Language.Haskell.Brittany.Internal.ToBriDoc.Decl
-import           Language.Haskell.Brittany.Internal.ToBriDoc.Pattern
-import {-# SOURCE #-} Language.Haskell.Brittany.Internal.ToBriDoc.Stmt
-import           Language.Haskell.Brittany.Internal.ToBriDoc.Type
 import           Language.Haskell.Brittany.Internal.Types
 import           Language.Haskell.Brittany.Internal.Utils
-import           Language.Haskell.Brittany.Internal.ToBriDoc.OpTree
 
 
 
@@ -59,6 +54,7 @@ layoutExpr lexpr@(L _ expr) = do
       , EmptyLocalBinds{} <- llocals
       , L _ (GRHS rhsEpAnn [] body) <- lgrhs
       -> do
+        layouters <- mAsk
         patDocs <- zip (True : repeat False) pats `forM` \(isFirst, p) ->
           fmap return $ do
             -- this code could be as simple as `colsWrapPat =<< layoutPat p`
@@ -73,13 +69,13 @@ layoutExpr lexpr@(L _ expr) = do
                   L _ LazyPat{} -> isFirst
                   L _ BangPat{} -> isFirst
                   _             -> False
-            patDocSeq <- layoutPat p
+            patDocSeq <- callLayouter layout_pat p
             fixed     <- case Seq.viewl patDocSeq of
               p1 Seq.:< pr | shouldPrefixSeparator -> do
                 p1' <- docSeq [docSeparator, pure p1]
                 pure (p1' Seq.<| pr)
               _ -> pure patDocSeq
-            colsWrapPat fixed
+            layout_colsWrapPat layouters fixed
         bodyDoc <-
           shareDoc
           $ docAddBaseY BrIndentRegular
@@ -130,7 +126,9 @@ layoutExpr lexpr@(L _ expr) = do
         $ (docLit $ Text.pack "\\case {}")
     HsLamCase _ (MG _ lmatches@(L _ matches) _) -> do
       binderDoc   <- docLit $ Text.pack "->"
-      funcPatDocs <- layoutPatternBind Nothing binderDoc `mapM` matches
+      layouters <- mAsk
+      funcPatDocs <-
+        layout_patternBind layouters Nothing binderDoc `mapM` matches
       docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
         (docLit $ Text.pack "\\case")
         ( docSetBaseAndIndent
@@ -211,8 +209,8 @@ layoutExpr lexpr@(L _ expr) = do
           headDoc
           (docNonBottomSpacing $ docLines paramDocs)
     HsAppType _ exp1 (HsWC _ ty1) -> do
-      t <- shareDoc $ layoutType ty1
+      t <- shareDoc $ callLayouter layout_type ty1
-      e <- shareDoc $ layoutExpr exp1
+      e <- shareDoc $ callLayouter layout_expr exp1
       docAlt
         [ docSeq
           [ docForceSingleline e
@@ -233,8 +231,10 @@ layoutExpr lexpr@(L _ expr) = do
       --       not
       --         $  hasAnyCommentsConnected expLeft
       --         || hasAnyCommentsConnected expOp
-      treeAndHasComms <- gatherOpTreeE False False id Nothing Nothing [] lexpr
+      layouters <- mAsk
-      processOpTree treeAndHasComms
+      treeAndHasComms <-
+        layout_gatherOpTreeE layouters False False id Nothing Nothing [] lexpr
+      layout_opTree layouters treeAndHasComms
     OpApp epAnn expLeft expOp expRight -> docHandleComms epAnn $ do
       expDocLeft  <- shareDoc $ layoutExpr expLeft
       expDocOp    <- shareDoc $ layoutExpr expOp
@@ -309,8 +309,10 @@ layoutExpr lexpr@(L _ expr) = do
                   -- not
                   --   $  hasAnyCommentsConnected expLeft
                   --   || hasAnyCommentsConnected expOp
-      treeAndHasComms <- gatherOpTreeE False False id Nothing Nothing [] lexpr
+      layouters <- mAsk
-      processOpTree treeAndHasComms
+      treeAndHasComms <-
+        layout_gatherOpTreeE layouters False False id Nothing Nothing [] lexpr
+      layout_opTree layouters treeAndHasComms
     HsPar epAnn innerExp -> docHandleComms epAnn $ do
       let AnnParen _ spanOpen spanClose = anns epAnn
       let wrapOpen                      = docHandleComms spanOpen
@@ -445,9 +447,10 @@ layoutExpr lexpr@(L _ expr) = do
       docHandleComms epAnn $ do
         cExpDoc     <- shareDoc $ layoutExpr cExp
         binderDoc   <- docLit $ Text.pack "->"
+        layouters   <- mAsk
         funcPatDocs <-
           -- docWrapNode lmatches
-                       layoutPatternBind Nothing binderDoc `mapM` matches
+          layout_patternBind layouters Nothing binderDoc `mapM` matches
         docAlt
           [ docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
             (docSeq
@@ -574,21 +577,23 @@ layoutExpr lexpr@(L _ expr) = do
             hasAnyCommentsBelow epAnn
             || any (\(L _ (GRHS gEpAnn _ _)) -> hasAnyCommentsBelow gEpAnn) cases
       let posIf = obtainAnnPos epAnn AnnIf
+      layouters <- mAsk
       docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
         (docHandleComms posIf $ docLit $ Text.pack "if")
-        (layoutPatternBindFinal Nothing
+        (layout_patternBindFinal layouters
-                                binderDoc
+                                 Nothing
-                                Nothing
+                                 binderDoc
-                                (Right cases)
+                                 Nothing
-                                Nothing
+                                 (Right cases)
-                                hasComments
+                                 Nothing
+                                 hasComments
         )
     HsLet epAnn binds exp1 -> docHandleComms epAnn $ do
       let AnnsLet spanLet spanIn = anns epAnn
       let hasComments            = hasAnyCommentsBelow lexpr
       let wrapLet                = docHandleComms spanLet
       let wrapIn                 = docHandleComms spanIn
-      mBindDocs <- layoutLocalBinds binds
+      mBindDocs <- callLayouter layout_localBinds binds
       let ifIndentFreeElse :: a -> a -> a
           ifIndentFreeElse x y = case indentPolicy of
             IndentPolicyLeft     -> y
@@ -692,7 +697,7 @@ layoutExpr lexpr@(L _ expr) = do
         case stmtCtx of
           DoExpr _ -> do
             stmtDocs <- docHandleComms stmtEpAnn $ do
-              stmts `forM` docHandleListElemComms layoutStmt
+              stmts `forM` docHandleListElemComms (callLayouter layout_stmt)
             docSetParSpacing $ docAddBaseY BrIndentRegularForce $ docPar
               (docLit $ Text.pack "do")
               ( docSetBaseAndIndent
@@ -702,7 +707,7 @@ layoutExpr lexpr@(L _ expr) = do
               )
           MDoExpr _ -> do
             stmtDocs <- docHandleComms stmtEpAnn $ do
-              stmts `forM` docHandleListElemComms layoutStmt
+              stmts `forM` docHandleListElemComms (callLayouter layout_stmt)
             docSetParSpacing $ docAddBaseY BrIndentRegularForce $ docPar
               (docLit $ Text.pack "mdo")
               (   docSetBaseAndIndent
@@ -720,7 +725,7 @@ layoutExpr lexpr@(L _ expr) = do
               stmtDocs <-
                 docHandleComms stmtEpAnn
                 $      stmts
-                `forM` docHandleListElemComms layoutStmt
+                `forM` docHandleListElemComms (callLayouter layout_stmt)
               let hasComments = hasAnyCommentsBelow lexpr
               runFilteredAlternative $ do
                 addAlternativeCond (not hasComments) $ docSeq
@@ -893,8 +898,8 @@ layoutExpr lexpr@(L _ expr) = do
                        fieldLayouter
                        fields
     ExprWithTySig _ exp1 (HsWC _ typ1) -> do
-      expDoc <- shareDoc $ layoutExpr exp1
+      expDoc <- shareDoc $ callLayouter layout_expr exp1
-      typDoc <- shareDoc $ layoutSigType typ1
+      typDoc <- shareDoc $ callLayouter layout_sigType typ1
       docSeq [appSep expDoc, appSep $ docLit $ Text.pack "::", typDoc]
     ArithSeq _ Nothing info -> case info of
       From e1 -> do

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs-boot

@@ -1,15 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-
-module Language.Haskell.Brittany.Internal.ToBriDoc.Expr where
-
-import GHC.Hs
-import Language.Haskell.Brittany.Internal.Types
-import Language.Haskell.Brittany.Internal.Components.BriDoc
-
-
-
-layoutExpr :: ToBriDoc HsExpr
-
-litBriDoc :: HsLit GhcPs -> BriDocWrapped
-
-overLitValBriDoc :: OverLitVal -> BriDocWrapped

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/IE.hs

@@ -116,7 +116,6 @@ layoutIE commAst lie@(L _ ie) = docHandleComms lie $ case ie of
       name <- lrdrNameToTextAnn n
       docHandleComms loc $ docLit $ Text.pack "type " <> name
 
-data SortItemsFlag = ShouldSortItems | KeepItemsUnsorted
 -- Helper function to deal with Located lists of LIEs.
 -- In particular this will also associate documentation
 -- from the located list that actually belongs to the last IE.

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Import.hs

@@ -14,7 +14,6 @@ import GHC.Types.SourceText(SourceText(SourceText, NoSourceText), sl_st)
 import GHC.Unit.Types (IsBootInterface(..))
 import Language.Haskell.Brittany.Internal.Config.Types
 import Language.Haskell.Brittany.Internal.S3_ToBriDocTools
-import Language.Haskell.Brittany.Internal.ToBriDoc.IE
 import Language.Haskell.Brittany.Internal.Prelude
 import Language.Haskell.Brittany.Internal.Types
 import Language.Haskell.Brittany.Internal.Components.BriDoc
@@ -37,6 +36,7 @@ layoutImport ldecl@(L _ importD) = docHandleComms ldecl $ case importD of
     importAsCol <-
       mAsk <&> _conf_layout .> _lconfig_importAsColumn .> confUnpack
     indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack
+    layouters <- mAsk
     let
       compact = indentPolicy /= IndentPolicyFree
       modNameT = Text.pack $ moduleNameString modName
@@ -89,16 +89,18 @@ layoutImport ldecl@(L _ importD) = docHandleComms ldecl $ case importD of
             then docAlt
               [ docSeq
                 [ hidDoc
-                , docForceSingleline $ layoutLLIEs True ShouldSortItems llies
+                , docForceSingleline
+                  $ layout_LLIEs layouters True ShouldSortItems llies
                 ]
               , let
                   makeParIfHiding = if hiding
                     then docAddBaseY BrIndentRegular . docPar hidDoc
                     else id
-                in makeParIfHiding (layoutLLIEs True ShouldSortItems llies)
+                in makeParIfHiding
+                  (layout_LLIEs layouters True ShouldSortItems llies)
               ]
             else do
-              ieDs <- layoutAnnAndSepLLIEs ShouldSortItems llies lies
+              ieDs <- layout_annAndSepLLIEs layouters ShouldSortItems llies lies
               -- TODO92 docWrapNodeRest llies
               docHandleComms llies $ docEnsureIndent (BrIndentSpecial hidDocCol)
                 $ case ieDs of

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Module.hs

@@ -14,7 +14,6 @@ import           Language.Haskell.Brittany.Internal.Components.BriDoc
 import           Language.Haskell.Brittany.Internal.Config.Types
 import           Language.Haskell.Brittany.Internal.Prelude
 import           Language.Haskell.Brittany.Internal.S3_ToBriDocTools
-import           Language.Haskell.Brittany.Internal.ToBriDoc.IE
 import           Language.Haskell.Brittany.Internal.Types
 
 
@@ -40,13 +39,14 @@ moduleNameExportBridoc epAnn modName les = do
         Just SameLine{}          -> id
         Just (DifferentLine 0 _) -> id
         Just dp                  -> docAddEntryDelta dp
+  layouters <- mAsk
   docHandleComms epAnn $ docHandleComms posModule $ runFilteredAlternative $ do
     addAlternativeCond allowSingleLine $ docSeq
       [ appSep $ wrapModule $ docLit $ Text.pack "module"
       , appSep $ docLit tn
       , docForceSingleline $ appSep $ case les of
         Nothing -> docEmpty
-        Just x  -> layoutLLIEs True KeepItemsUnsorted x
+        Just x  -> layout_LLIEs layouters True KeepItemsUnsorted x
       , docSeparator
       , docHandleComms posWhere $ docLit $ Text.pack "where"
       ]
@@ -58,7 +58,7 @@ moduleNameExportBridoc epAnn modName les = do
           (docSeq
             [ case les of
               Nothing -> docEmpty
-              Just x  -> layoutLLIEs False KeepItemsUnsorted x
+              Just x  -> layout_LLIEs layouters False KeepItemsUnsorted x
             , docSeparator
             , docHandleComms posWhere $ docLit $ Text.pack "where"
             ]

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/OpTree.hs

@@ -15,8 +15,6 @@ import           Language.Haskell.Brittany.Internal.Prelude
 import           Language.Haskell.Brittany.Internal.S3_ToBriDocTools
 import           Language.Haskell.Brittany.Internal.Types
 import           Language.Haskell.Brittany.Internal.Utils
-import {-# SOURCE #-} Language.Haskell.Brittany.Internal.ToBriDoc.Expr
-import {-# SOURCE #-} Language.Haskell.Brittany.Internal.ToBriDoc.Type
 
 
 gatherOpTreeE
@@ -36,7 +34,11 @@ gatherOpTreeE hasParen hasComms commWrap locOpen locClose opExprList = \case
       commWrap
       locOpen
       locClose
-      ((docHandleComms epAnn $ layoutExpr op1, layoutExpr r1) : opExprList)
+      ( ( docHandleComms epAnn $ callLayouter layout_expr op1
+        , callLayouter layout_expr r1
+        )
+      : opExprList
+      )
       l1
   (L _ (HsPar epAnn inner)) -> do
     let AnnParen _ spanOpen spanClose = anns epAnn
@@ -63,7 +65,7 @@ gatherOpTreeE hasParen hasComms commWrap locOpen locClose opExprList = \case
             , innerHasComms
             )
   final -> do
-    numberedLeft   <- commWrap $ layoutExpr final
+    numberedLeft   <- commWrap $ callLayouter layout_expr final
     numberedRights <- opExprList `forM` \(x, y) -> do
       x' <- x
       y' <- y
@@ -94,7 +96,7 @@ gatherOpTreeT hasParen hasComms commWrap locOpen locClose opExprList = \case
       commWrap
       locOpen
       locClose
-      ((docLit $ printRdrNameWithAnns op1, layoutType r1) : opExprList)
+      ((docLit $ printRdrNameWithAnns op1, callLayouter layout_type r1) : opExprList)
       l1
   (L _ (HsParTy epAnn inner)) -> do
     let AnnParen _ spanOpen spanClose = anns epAnn
@@ -121,7 +123,7 @@ gatherOpTreeT hasParen hasComms commWrap locOpen locClose opExprList = \case
             , innerHasComms
             )
   final -> do
-    numberedLeft   <- commWrap $ layoutType final
+    numberedLeft   <- commWrap $ callLayouter layout_type final
     numberedRights <- opExprList `forM` \(x, y) -> do
       x' <- x
       y' <- y

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Pattern.hs

@@ -11,8 +11,6 @@ import GHC.Hs
 import qualified GHC.OldList as List
 import GHC.Types.Basic
 import Language.Haskell.Brittany.Internal.S3_ToBriDocTools
-import {-# SOURCE #-} Language.Haskell.Brittany.Internal.ToBriDoc.Expr
-import Language.Haskell.Brittany.Internal.ToBriDoc.Type
 import Language.Haskell.Brittany.Internal.Prelude
 import Language.Haskell.Brittany.Internal.Types
 import Language.Haskell.Brittany.Internal.Components.BriDoc
@@ -35,7 +33,9 @@ layoutPat lpat@(L _ pat) = docHandleComms lpat $ case pat of
     -- _ -> expr
   VarPat _ n -> fmap Seq.singleton $ docLit $ lrdrNameToText n
     -- abc -> expr
-  LitPat _ lit -> fmap Seq.singleton $ allocateNode $ litBriDoc lit
+  LitPat _ lit -> do
+    layouters <- mAsk
+    fmap Seq.singleton $ allocateNode $ layout_lit layouters lit
     -- 0 -> expr
   ParPat _ inner -> do
     -- (nestedpat) -> expr
@@ -142,7 +142,7 @@ layoutPat lpat@(L _ pat) = docHandleComms lpat $ case pat of
   SigPat _ pat1 (HsPS _ ty1) -> do
     -- i :: Int -> expr
     patDocs <- layoutPat pat1
-    tyDoc <- shareDoc $ layoutType ty1
+    tyDoc <- shareDoc $ callLayouter layout_type ty1
     case Seq.viewr patDocs of
       Seq.EmptyR -> error "cannot happen ljoiuxoasdcoviuasd"
       xR Seq.:> xN -> do
@@ -173,13 +173,14 @@ layoutPat lpat@(L _ pat) = docHandleComms lpat $ case pat of
     -- -13 -> expr
     -- TODO92 we had `docWrapNode llit` below, but I don't think that is
     --        necessary/possible any longer..
-    litDoc <- allocateNode $ overLitValBriDoc $ GHC.ol_val ol
+    layouters <- mAsk
+    litDoc <- allocateNode $ layout_overLit layouters $ GHC.ol_val ol
     negDoc <- docLit $ Text.pack "-"
     pure $ case mNegative of
       Just{} -> Seq.fromList [negDoc, litDoc]
       Nothing -> Seq.singleton litDoc
   ViewPat epAnn pat1 pat2 -> do
-    pat1Doc <- docHandleComms epAnn $ layoutExpr pat1
+    pat1Doc <- docHandleComms epAnn $ callLayouter layout_expr pat1
     let arrowLoc = obtainAnnPos epAnn AnnRarrow
     pat1DocC <- appSep $ pure pat1Doc
     pat2Docs <- layoutPat pat2

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Stmt.hs

@@ -9,9 +9,6 @@ import GHC (GenLocated(L))
 import GHC.Hs
 import Language.Haskell.Brittany.Internal.Config.Types
 import Language.Haskell.Brittany.Internal.S3_ToBriDocTools
-import Language.Haskell.Brittany.Internal.ToBriDoc.Decl
-import {-# SOURCE #-} Language.Haskell.Brittany.Internal.ToBriDoc.Expr
-import Language.Haskell.Brittany.Internal.ToBriDoc.Pattern
 import Language.Haskell.Brittany.Internal.Prelude
 import Language.Haskell.Brittany.Internal.Types
 import Language.Haskell.Brittany.Internal.Components.BriDoc
@@ -28,10 +25,11 @@ layoutStmt lstmt@(L _ stmt) = do
       -- at least the "|" of a monadcomprehension for _some_ reason
       -- is connected to the _body_ of the "result" stmt. So we need
       -- to docHandleListElemComms here..
-      docHandleListElemComms layoutExpr body
+      docHandleListElemComms (callLayouter layout_expr) body
     BindStmt epAnn lPat expr -> docHandleComms epAnn $ do
-      patDoc <- fmap return $ colsWrapPat =<< layoutPat lPat
+      patDoc <- fmap return
-      expDoc <- shareDoc $ layoutExpr expr
+        $ callLayouter layout_colsWrapPat =<< callLayouter layout_pat lPat
+      expDoc <- shareDoc $ callLayouter layout_expr expr
       docAlt
         [ docCols
           ColBindStmt
@@ -51,7 +49,7 @@ layoutStmt lstmt@(L _ stmt) = do
     LetStmt epAnn binds -> docHandleComms epAnn $ do
       let isFree = indentPolicy == IndentPolicyFree
       let indentFourPlus = indentAmount >= 4
-      layoutLocalBinds binds >>= \case
+      callLayouter layout_localBinds binds >>= \case
         Nothing -> docLit $ Text.pack "let"
           -- i just tested the above, and it is indeed allowed. heh.
         Just (_, []) -> docLit $ Text.pack "let" -- this probably never happens
@@ -114,6 +112,6 @@ layoutStmt lstmt@(L _ stmt) = do
           (docLit (Text.pack "rec"))
           (docLines $ layoutStmt <$> stmts)
     BodyStmt NoExtField expr _ _ -> do
-      expDoc <- shareDoc $ layoutExpr expr
+      expDoc <- shareDoc $ callLayouter layout_expr expr
       docAddBaseY BrIndentRegular $ expDoc
     _ -> briDocByExactInlineOnly "some unknown statement" lstmt

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Stmt.hs-boot

@@ -1,11 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-
-module Language.Haskell.Brittany.Internal.ToBriDoc.Stmt where
-
-import GHC.Hs
-import Language.Haskell.Brittany.Internal.Types
-import Language.Haskell.Brittany.Internal.Components.BriDoc
-
-
-
-layoutStmt :: GuardLStmt GhcPs -> ToBriDocM BriDocNumbered

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Type.hs

@@ -17,14 +17,13 @@ import Language.Haskell.Brittany.Internal.Types
 import Language.Haskell.Brittany.Internal.Components.BriDoc
 import Language.Haskell.Brittany.Internal.Utils
   (FirstLastView(..), splitFirstLast)
-import Language.Haskell.Brittany.Internal.ToBriDoc.OpTree
 
 
 
 layoutSigType :: ToBriDoc HsSigType
 -- TODO92 we ignore an ann here
 layoutSigType (L _ (HsSig _ outerVarBind typ)) = case outerVarBind of
-  HsOuterImplicit _ -> layoutType typ
+  HsOuterImplicit _ -> callLayouter layout_type typ
   HsOuterExplicit _ bndrs -> do
     parts <- splitHsForallTypeFromBinders (map withoutSpecificity bndrs) typ
     joinSplitArrowType (hasAnyCommentsBelow typ) parts
@@ -264,8 +263,9 @@ layoutType ltype@(L _ typ) = docHandleComms ltype $ case typ of
             (docLines $ lines ++ [wrapEnd end])
         ]
   HsOpTy{} -> do
-    treeAndHasComms <- gatherOpTreeT False False id Nothing Nothing [] ltype
+    layouters <- mAsk
-    processOpTree treeAndHasComms
+    treeAndHasComms <- layout_gatherOpTreeT layouters False False id Nothing Nothing [] ltype
+    layout_opTree layouters treeAndHasComms
   -- HsOpTy typ1 opName typ2 -> do
   --   -- TODO: these need some proper fixing. precedences don't add up.
   --   --       maybe the parser just returns some trivial right recursion

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Type.hs-boot

@@ -1,10 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
-module Language.Haskell.Brittany.Internal.ToBriDoc.Type where
-
-import GHC.Hs
-
-import Language.Haskell.Brittany.Internal.Types
-
-layoutType :: ToBriDoc HsType

source/library/Language/Haskell/Brittany/Internal/Types.hs

@@ -13,6 +13,7 @@ import qualified Data.Data
 import qualified Data.Kind as Kind
 import qualified GHC.OldList as List
 import qualified Data.Text.Lazy.Builder as Text.Builder
+import qualified GHC
 import           GHC                            ( Anno
                                                 , DeltaPos
                                                   ( DifferentLine
@@ -152,10 +153,125 @@ ppmMoveToExactLoc = \case
 
 
 type ToBriDocM = MultiRWSS.MultiRWS
-  '[Config, TraceFunc] -- reader
+  '[Config, TraceFunc, Layouters] -- reader
   '[[BrittanyError], Seq String] -- writer
   '[NodeAllocIndex, CommentCounter] -- state
 
+data OpTree
+  = OpUnknown Bool -- Z paren?
+              (Maybe GHC.RealSrcLoc) -- paren open loc
+              (Maybe GHC.RealSrcLoc) -- paren close loc
+              OpTree -- left operand
+              [(BriDocNumbered, BriDocNumbered)] -- list of (next operand, symbol)
+  | OpKnown Bool     -- with paren?
+              (Maybe GHC.RealSrcLoc) -- paren open loc
+              (Maybe GHC.RealSrcLoc) -- paren close loc
+            GHC.Fixity   -- only Just after (successful!) lookup phase
+            OpTree
+            [(BriDocNumbered, OpTree)]
+  | OpLeaf BriDocNumbered
+
+data SortItemsFlag = ShouldSortItems | KeepItemsUnsorted
+
+data Layouters = Layouters
+  { layout_expr :: ToBriDoc GHC.HsExpr
+  , layout_lit :: GHC.HsLit GhcPs -> BriDocWrapped
+  , layout_overLit :: GHC.OverLitVal -> BriDocWrapped
+  , layout_type :: ToBriDoc GHC.HsType
+  , layout_sigType :: ToBriDoc GHC.HsSigType
+  , layout_stmt :: GHC.GuardLStmt GhcPs -> ToBriDocM BriDocNumbered
+  , layout_gatherOpTreeE
+    :: Bool
+    -> Bool
+    -> (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)
+    -> Maybe GHC.RealSrcLoc
+    -> Maybe GHC.RealSrcLoc
+    -> [(ToBriDocM BriDocNumbered, ToBriDocM BriDocNumbered)]
+    -> GHC.LHsExpr GhcPs
+    -> ToBriDocM (OpTree, Bool)
+  , layout_gatherOpTreeT
+    :: Bool
+    -> Bool
+    -> (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)
+    -> Maybe GHC.RealSrcLoc
+    -> Maybe GHC.RealSrcLoc
+    -> [(ToBriDocM BriDocNumbered, ToBriDocM BriDocNumbered)]
+    -> GHC.LHsType GhcPs
+    -> ToBriDocM (OpTree, Bool)
+  , layout_opTree :: (OpTree, Bool) -> ToBriDocM BriDocNumbered
+  , layout_grhs
+    :: GHC.LGRHS GhcPs (GHC.LHsExpr GhcPs)
+    -> ToBriDocM
+         ( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
+         , [BriDocNumbered]
+         , BriDocNumbered
+         )
+  , layout_pat :: GHC.LPat GhcPs -> ToBriDocM (Seq BriDocNumbered)
+  , layout_colsWrapPat :: Seq BriDocNumbered -> ToBriDocM BriDocNumbered
+  , layout_patternBind
+    :: Maybe Text
+    -> BriDocNumbered
+    -> GHC.LMatch GhcPs (GHC.LHsExpr GhcPs)
+    -> ToBriDocM BriDocNumbered
+  , layout_patternBindFinal
+    :: Maybe Text
+    -> BriDocNumbered
+    -> Maybe BriDocNumbered
+    -> Either (GHC.LHsExpr GhcPs) [GHC.LGRHS GhcPs (GHC.LHsExpr GhcPs)]
+    -> ( Maybe
+           ( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
+           , [BriDocNumbered]
+           )
+       )
+    -> Bool
+    -> ToBriDocM BriDocNumbered
+  , layout_localBinds
+    :: GHC.HsLocalBindsLR GhcPs GhcPs
+    -> ToBriDocM
+         ( Maybe
+             ( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
+             , [BriDocNumbered]
+             )
+         )
+  , layout_dataDecl
+    :: GHC.LTyClDecl GhcPs
+    -> GHC.EpAnn [GHC.AddEpAnn]
+    -> GHC.LIdP GhcPs
+    -> GHC.LHsQTyVars GhcPs
+    -> [GHC.LHsTypeArg GhcPs]
+    -> GHC.HsDataDefn GhcPs
+    -> ToBriDocM BriDocNumbered
+  , layout_tyVarBndrs
+    :: [GHC.LHsTyVarBndr () GhcPs]
+    -> ToBriDocM [(Text, Maybe (ToBriDocM BriDocNumbered))]
+  , layout_tyVarBndrsSingleline
+    :: [(Text, Maybe (ToBriDocM BriDocNumbered))] -> [ToBriDocM BriDocNumbered]
+  , layout_hsTyPats
+    :: [GHC.LHsTypeArg GhcPs] -> [ToBriDocM BriDocNumbered]
+  , layout_LLIEs
+    :: HasCallStack
+    => Bool
+    -> SortItemsFlag
+    -> GHC.LocatedL [GHC.LIE GhcPs]
+    -> ToBriDocM BriDocNumbered
+  , layout_annAndSepLLIEs
+    :: forall a
+    .  (Data.Data.Data a, HasCallStack)
+    => SortItemsFlag
+    -> a
+    -> [GHC.LIE GhcPs]
+    -> ToBriDocM [ToBriDocM BriDocNumbered]
+  }
+
+callLayouter
+  :: (Layouters -> a -> ToBriDocM r)
+  -> a
+  -> ToBriDocM r
+callLayouter lens x = do
+  layouters <- mAsk
+  lens layouters x
+
+
 type ToBriDoc (sym :: Kind.Type -> Kind.Type) = XRec GhcPs (sym GhcPs) -> ToBriDocM BriDocNumbered
 type ToBriDoc' sym            = XRec GhcPs (sym GhcPs)                 -> ToBriDocM BriDocNumbered
 type ToBriDocC sym c          = XRec GhcPs (sym GhcPs)                 -> ToBriDocM c
@@ -168,8 +284,8 @@ newtype CommentCounter = CommentCounter { unCommentCounter :: Int }
 
 -- Why does this live in types? As long as it does, you _have_
 -- to remember to call `docFlushRemaining` in combination with this!
-briDocMToPPM :: ToBriDocM a -> PPMLocal (a, Int)
+briDocMToPPM :: Layouters -> ToBriDocM a -> PPMLocal (a, Int)
-briDocMToPPM m = do
+briDocMToPPM layouters m = do
   readers   <- MultiRWSS.mGetRawR
   initCount <- MultiRWSS.mGet @CommentCounter
   let (((x, errs), debugs), commentCount) =
@@ -177,6 +293,7 @@ briDocMToPPM m = do
           $ MultiRWSS.runMultiRWSTNil
           $ MultiRWSS.withMultiStateAS initCount
           $ MultiRWSS.withMultiStateA (NodeAllocIndex 1)
+          $ MultiRWSS.withMultiReader layouters
           $ MultiRWSS.withMultiReaders readers
           $ MultiRWSS.withMultiWriterAW
           $ MultiRWSS.withMultiWriterAW