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.
2023-04-18 16:46:01 +00:00 · 2023-04-18 16:46:01 +00:00 · ebe85a5949
parent 736c2a8d46
commit ebe85a5949
18 changed files with 275 additions and 158 deletions
--- a/brittany.cabal
+++ b/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
--- a/source/library/Language/Haskell/Brittany/Internal/Components/OpTree.hs
+++ b/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 ->
--- a/source/library/Language/Haskell/Brittany/Internal/StepOrchestrate.hs
+++ b/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
--- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc.hs
+++ b/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
+  }
--- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/DataDecl.hs
+++ b/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
-  HsTypeArg _l ty -> docSeq [docLit $ Text.pack "@", layoutType ty]
+  HsValArg tm -> callLayouter layout_type tm
+  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
-  tRDocs <- tR `forM` (shareDoc . layoutType)
+  t1Doc <- shareDoc $ callLayouter layout_type t1
+  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
--- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Decl.hs
+++ b/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
-    mWhereDocs <- layoutLocalBinds $ whereBinds
+    patDocs <- callLayouter layout_colsWrapPat =<< callLayouter layout_pat pat
+    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
-  bodyDoc <- layoutExpr body
+    _  -> docFlushCommsPost False posArrow $ callLayouter layout_stmt `mapM` guards
+  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 ->
-    layoutDataDecl ltycl epAnn name tyVars [] dataDefn
+  DataDecl epAnn name tyVars _ dataDefn -> do
+    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
--- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs
+++ b/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
-      e <- shareDoc $ layoutExpr exp1
+      t <- shareDoc $ callLayouter layout_type ty1
+      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
-      processOpTree treeAndHasComms
+      layouters <- mAsk
+      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
-      processOpTree treeAndHasComms
+      layouters <- mAsk
+      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
-                                binderDoc
-                                Nothing
-                                (Right cases)
-                                Nothing
-                                hasComments
+        (layout_patternBindFinal layouters
+                                 Nothing
+                                 binderDoc
+                                 Nothing
+                                 (Right cases)
+                                 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
-      typDoc <- shareDoc $ layoutSigType typ1
+      expDoc <- shareDoc $ callLayouter layout_expr exp1
+      typDoc <- shareDoc $ callLayouter layout_sigType typ1
      docSeq [appSep expDoc, appSep $ docLit $ Text.pack "::", typDoc]
    ArithSeq _ Nothing info -> case info of
      From e1 -> do
--- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs-boot
+++ b/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
--- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/IE.hs
+++ b/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.
--- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Import.hs
+++ b/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
--- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Module.hs
+++ b/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"
            ]
--- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/OpTree.hs
+++ b/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
--- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Pattern.hs
+++ b/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
--- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Stmt.hs
+++ b/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
-      expDoc <- shareDoc $ layoutExpr expr
+      patDoc <- fmap return
+        $ 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
--- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Stmt.hs-boot
+++ b/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
--- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Type.hs
+++ b/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
-    processOpTree treeAndHasComms
+    layouters <- mAsk
+    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
--- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Type.hs-boot
+++ b/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
--- a/source/library/Language/Haskell/Brittany/Internal/Types.hs
+++ b/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 m = do
+briDocMToPPM :: Layouters -> ToBriDocM a -> PPMLocal (a, Int)
+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