diff --git a/codebase2/util/src/U/Util/Monoid.hs b/codebase2/util/src/U/Util/Monoid.hs
index ab6b8d9e0..60c7999fa 100644
--- a/codebase2/util/src/U/Util/Monoid.hs
+++ b/codebase2/util/src/U/Util/Monoid.hs
@@ -1,6 +1,7 @@
 module U.Util.Monoid where
 
 import Control.Monad (foldM)
+import Control.Monad.Extra ((>=>))
 import Data.Foldable (toList)
 import Data.List (intersperse)
 
@@ -10,6 +11,9 @@ intercalateMap :: (Foldable t, Monoid a) => a -> (b -> a) -> t b -> a
 intercalateMap separator renderer elements =
   mconcat $ intersperse separator (renderer <$> toList elements)
 
+intercalateMapM :: (Traversable t, Monad m, Monoid a) => a -> (b -> m a) -> t b -> m a
+intercalateMapM separator renderer = traverse renderer >=> return . intercalateMap separator id
+
 fromMaybe :: Monoid a => Maybe a -> a
 fromMaybe Nothing = mempty
 fromMaybe (Just a) = a
@@ -24,4 +28,4 @@ isEmpty a = a == mempty
 nonEmpty = not . isEmpty
 
 foldMapM :: (Monad m, Foldable f, Monoid b) => (a -> m b) -> f a -> m b
-foldMapM f as = foldM (\b a -> fmap (b <>) (f a)) mempty as
+foldMapM f = foldM (\b a -> fmap (b <>) (f a)) mempty
diff --git a/lib/unison-pretty-printer/src/Unison/Util/Pretty.hs b/lib/unison-pretty-printer/src/Unison/Util/Pretty.hs
index c47ddfeff..48ca39d54 100644
--- a/lib/unison-pretty-printer/src/Unison/Util/Pretty.hs
+++ b/lib/unison-pretty-printer/src/Unison/Util/Pretty.hs
@@ -102,6 +102,7 @@ module Unison.Util.Pretty
     spaceIfNeeded,
     spaced,
     spacedMap,
+    spacedTraverse,
     spacesIfBreak,
     string,
     surroundCommas,
@@ -406,6 +407,9 @@ spaced = intercalateMap softbreak id
 spacedMap :: (Foldable f, IsString s) => (a -> Pretty s) -> f a -> Pretty s
 spacedMap f as = spaced . fmap f $ toList as
 
+spacedTraverse :: (Traversable f, IsString s, Applicative m) => (a -> m (Pretty s)) -> f a -> m (Pretty s)
+spacedTraverse f as = spaced <$> traverse f as
+
 commas :: (Foldable f, IsString s) => f (Pretty s) -> Pretty s
 commas = intercalateMap ("," <> softbreak) id
 
diff --git a/parser-typechecker/src/Unison/PrettyPrintEnv/MonadPretty.hs b/parser-typechecker/src/Unison/PrettyPrintEnv/MonadPretty.hs
new file mode 100644
index 000000000..f6660a123
--- /dev/null
+++ b/parser-typechecker/src/Unison/PrettyPrintEnv/MonadPretty.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE ConstraintKinds #-}
+
+module Unison.PrettyPrintEnv.MonadPretty where
+
+import Control.Lens (over, set, view, views, _1, _2)
+import Control.Monad.Reader (MonadReader, Reader, local, runReader)
+import qualified Data.Set as Set
+import Unison.Prelude (Set)
+import Unison.PrettyPrintEnv (PrettyPrintEnv)
+import Unison.Var (Var)
+
+type MonadPretty v m = (Var v, MonadReader (PrettyPrintEnv, Set v) m)
+
+getPPE :: MonadPretty v m => m PrettyPrintEnv
+getPPE = view _1
+
+-- | Run a computation with a modified PrettyPrintEnv, restoring the original
+withPPE :: MonadPretty v m => PrettyPrintEnv -> m a -> m a
+withPPE p = local (set _1 p)
+
+applyPPE :: MonadPretty v m => (PrettyPrintEnv -> a) -> m a
+applyPPE = views _1
+
+applyPPE2 :: MonadPretty v m => (PrettyPrintEnv -> a -> b) -> a -> m b
+applyPPE2 f a = views _1 (`f` a)
+
+applyPPE3 :: MonadPretty v m => (PrettyPrintEnv -> a -> b -> c) -> a -> b -> m c
+applyPPE3 f a b = views _1 (\ppe -> f ppe a b)
+
+-- | Run a computation with a modified PrettyPrintEnv, restoring the original
+modifyPPE :: MonadPretty v m => (PrettyPrintEnv -> PrettyPrintEnv) -> m a -> m a
+modifyPPE = local . over _1
+
+modifyTypeVars :: MonadPretty v m => (Set v -> Set v) -> m a -> m a
+modifyTypeVars = local . over _2
+
+-- | Add type variables to the set of variables that need to be avoided
+addTypeVars :: MonadPretty v m => [v] -> m a -> m a
+addTypeVars = modifyTypeVars . Set.union . Set.fromList
+
+-- | Check if a list of type variables contains any variables that need to be
+-- avoided
+willCapture :: MonadPretty v m => [v] -> m Bool
+willCapture vs = views _2 (not . Set.null . Set.intersection (Set.fromList vs))
+
+runPretty :: Var v => PrettyPrintEnv -> Reader (PrettyPrintEnv, Set v) a -> a
+runPretty ppe m = runReader m (ppe, mempty)
\ No newline at end of file
diff --git a/parser-typechecker/src/Unison/Syntax/DeclPrinter.hs b/parser-typechecker/src/Unison/Syntax/DeclPrinter.hs
index 499a822d8..b6b867271 100644
--- a/parser-typechecker/src/Unison/Syntax/DeclPrinter.hs
+++ b/parser-typechecker/src/Unison/Syntax/DeclPrinter.hs
@@ -17,6 +17,7 @@ import qualified Unison.Name as Name
 import Unison.Prelude
 import Unison.PrettyPrintEnv (PrettyPrintEnv)
 import qualified Unison.PrettyPrintEnv as PPE
+import Unison.PrettyPrintEnv.MonadPretty (runPretty)
 import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..))
 import Unison.Reference (Reference (DerivedId))
 import qualified Unison.Referent as Referent
@@ -73,9 +74,9 @@ prettyGADT env ctorType r name dd =
   where
     constructor (n, (_, _, t)) =
       prettyPattern env ctorType name (ConstructorReference r n)
-        <> (fmt S.TypeAscriptionColon " :")
-        `P.hang` TypePrinter.pretty0 env Map.empty (-1) t
-    header = prettyEffectHeader name (DD.EffectDeclaration dd) <> (fmt S.ControlKeyword " where")
+        <> fmt S.TypeAscriptionColon " :"
+        `P.hang` TypePrinter.prettySyntax env t
+    header = prettyEffectHeader name (DD.EffectDeclaration dd) <> fmt S.ControlKeyword " where"
 
 prettyPattern ::
   PrettyPrintEnv ->
@@ -86,7 +87,7 @@ prettyPattern ::
 prettyPattern env ctorType namespace ref =
   styleHashQualified''
     (fmt (S.TermReference conRef))
-    ( HQ.stripNamespace (fromMaybe "" $ Name.toText <$> HQ.toName namespace) $
+    ( HQ.stripNamespace (maybe "" Name.toText (HQ.toName namespace)) $
         PPE.termName env conRef
     )
   where
@@ -106,26 +107,26 @@ prettyDataDecl (PrettyPrintEnvDecl unsuffixifiedPPE suffixifiedPPE) r name dd =
         [0 ..]
         (DD.constructors' dd)
   where
-    constructor (n, (_, _, (Type.ForallsNamed' _ t))) = constructor' n t
+    constructor (n, (_, _, Type.ForallsNamed' _ t)) = constructor' n t
     constructor (n, (_, _, t)) = constructor' n t
     constructor' n t = case Type.unArrows t of
       Nothing -> prettyPattern suffixifiedPPE CT.Data name (ConstructorReference r n)
       Just ts -> case fieldNames unsuffixifiedPPE r name dd of
         Nothing ->
           P.group . P.hang' (prettyPattern suffixifiedPPE CT.Data name (ConstructorReference r n)) "      " $
-            P.spaced (TypePrinter.prettyRaw suffixifiedPPE Map.empty 10 <$> init ts)
+            P.spaced (runPretty suffixifiedPPE (traverse (TypePrinter.prettyRaw Map.empty 10) (init ts)))
         Just fs ->
           P.group $
-            (fmt S.DelimiterChar "{ ")
+            fmt S.DelimiterChar "{ "
               <> P.sep
-                ((fmt S.DelimiterChar ",") <> " " `P.orElse` "\n      ")
+                (fmt S.DelimiterChar "," <> " " `P.orElse` "\n      ")
                 (field <$> zip fs (init ts))
-              <> (fmt S.DelimiterChar " }")
+              <> fmt S.DelimiterChar " }"
     field (fname, typ) =
       P.group $
         styleHashQualified'' (fmt (S.TypeReference r)) fname
-          <> (fmt S.TypeAscriptionColon " :") `P.hang` TypePrinter.prettyRaw suffixifiedPPE Map.empty (-1) typ
-    header = prettyDataHeader name dd <> (fmt S.DelimiterChar (" = " `P.orElse` "\n  = "))
+          <> fmt S.TypeAscriptionColon " :" `P.hang` runPretty suffixifiedPPE (TypePrinter.prettyRaw Map.empty (-1) typ)
+    header = prettyDataHeader name dd <> fmt S.DelimiterChar (" = " `P.orElse` "\n  = ")
 
 -- Comes up with field names for a data declaration which has the form of a
 -- record, like `type Pt = { x : Int, y : Int }`. Works by generating the
diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs
index f4afd9d61..e82ab0ba6 100644
--- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs
+++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs
@@ -14,6 +14,7 @@ import Data.Text (unpack)
 import qualified Data.Text as Text
 import Data.Vector ()
 import qualified Text.Show.Unicode as U
+import U.Util.Monoid (foldMapM, intercalateMapM)
 import Unison.ABT (annotation, reannotateUp, pattern AbsN')
 import qualified Unison.ABT as ABT
 import qualified Unison.Blank as Blank
@@ -32,6 +33,7 @@ import Unison.Prelude
 import Unison.PrettyPrintEnv (PrettyPrintEnv)
 import qualified Unison.PrettyPrintEnv as PrettyPrintEnv
 import Unison.PrettyPrintEnv.FQN (Imports, Prefix, Suffix, elideFQN)
+import Unison.PrettyPrintEnv.MonadPretty
 import Unison.Reference (Reference)
 import qualified Unison.Reference as Reference
 import Unison.Referent (Referent)
@@ -40,7 +42,7 @@ import Unison.Syntax.Lexer (showEscapeChar, symbolyId)
 import Unison.Syntax.NamePrinter (styleHashQualified'')
 import qualified Unison.Syntax.TypePrinter as TypePrinter
 import Unison.Term
-import Unison.Type (Type)
+import Unison.Type (Type, pattern ForallsNamed')
 import qualified Unison.Type as Type
 import qualified Unison.Util.Bytes as Bytes
 import Unison.Util.Monoid (intercalateMap)
@@ -53,20 +55,21 @@ import qualified Unison.Var as Var
 type SyntaxText = S.SyntaxText' Reference
 
 pretty :: Var v => PrettyPrintEnv -> Term v a -> Pretty ColorText
-pretty env = PP.syntaxToColor . pretty0 env emptyAc . printAnnotate env
+pretty ppe tm =
+  PP.syntaxToColor . runPretty ppe $ pretty0 emptyAc $ printAnnotate ppe tm
 
 prettyBlock :: Var v => Bool -> PrettyPrintEnv -> Term v a -> Pretty ColorText
-prettyBlock elideUnit env = PP.syntaxToColor . prettyBlock' elideUnit env
+prettyBlock elideUnit ppe = PP.syntaxToColor . prettyBlock' elideUnit ppe
 
 prettyBlock' :: Var v => Bool -> PrettyPrintEnv -> Term v a -> Pretty SyntaxText
-prettyBlock' elideUnit env =
-  pretty0 env (emptyBlockAc {elideUnit = elideUnit}) . printAnnotate env
+prettyBlock' elideUnit ppe tm =
+  runPretty ppe . pretty0 (emptyBlockAc {elideUnit = elideUnit}) $ printAnnotate ppe tm
 
 pretty' :: Var v => Maybe Width -> PrettyPrintEnv -> Term v a -> ColorText
 pretty' (Just width) n t =
-  PP.render width $ PP.syntaxToColor $ pretty0 n emptyAc (printAnnotate n t)
+  PP.render width . PP.syntaxToColor . runPretty n $ pretty0 emptyAc (printAnnotate n t)
 pretty' Nothing n t =
-  PP.renderUnbroken $ PP.syntaxToColor $ pretty0 n emptyAc (printAnnotate n t)
+  PP.renderUnbroken . PP.syntaxToColor . runPretty n $ pretty0 emptyAc (printAnnotate n t)
 
 -- Information about the context in which a term appears, which affects how the
 -- term should be rendered.
@@ -159,14 +162,12 @@ data DocLiteralContext
 -}
 
 pretty0 ::
-  forall v.
-  Var v =>
-  PrettyPrintEnv ->
+  forall v m.
+  MonadPretty v m =>
   AmbientContext ->
   Term3 v PrintAnnotation ->
-  Pretty SyntaxText
+  m (Pretty SyntaxText)
 pretty0
-  n
   a@AmbientContext
     { precedence = p,
       blockContext = bc,
@@ -176,36 +177,36 @@ pretty0
       elideUnit = elideUnit
     }
   term =
-    -- Note: the set of places in this function that call calcImports has to be kept in sync
-    -- with the definition of immediateChildBlockTerms, otherwise `use` statements get
-    -- inserted at the wrong scope.
     specialCases term $ \case
-      Var' v -> parenIfInfix name ic $ styleHashQualified'' (fmt S.Var) name
+      Var' v -> pure . parenIfInfix name ic $ styleHashQualified'' (fmt S.Var) name
         where
           -- OK since all term vars are user specified, any freshening was just added during typechecking
           name = elideFQN im $ HQ.unsafeFromVar (Var.reset v)
-      Ref' r -> parenIfInfix name ic $ styleHashQualified'' (fmt $ S.TermReference (Referent.Ref r)) name
-        where
-          name = elideFQN im $ PrettyPrintEnv.termName n (Referent.Ref r)
-      TermLink' r ->
-        paren (p >= 10) $
+      Ref' r -> do
+        n <- getPPE
+        let name = elideFQN im $ PrettyPrintEnv.termName n (Referent.Ref r)
+        pure . parenIfInfix name ic $ styleHashQualified'' (fmt $ S.TermReference (Referent.Ref r)) name
+      TermLink' r -> do
+        n <- getPPE
+        let name = elideFQN im $ PrettyPrintEnv.termName n r
+        pure . paren (p >= 10) $
           fmt S.LinkKeyword "termLink "
-            <> (parenIfInfix name ic $ styleHashQualified'' (fmt $ S.TermReference r) name)
+            <> parenIfInfix name ic (styleHashQualified'' (fmt $ S.TermReference r) name)
         where
-          name = elideFQN im $ PrettyPrintEnv.termName n r
-      TypeLink' r ->
-        paren (p >= 10) $
+      TypeLink' r -> do
+        n <- getPPE
+        let name = elideFQN im $ PrettyPrintEnv.typeName n r
+        pure . paren (p >= 10) $
           fmt S.LinkKeyword "typeLink "
-            <> (parenIfInfix name ic $ styleHashQualified'' (fmt $ S.TypeReference r) name)
+            <> parenIfInfix name ic (styleHashQualified'' (fmt $ S.TypeReference r) name)
         where
-          name = elideFQN im $ PrettyPrintEnv.typeName n r
-      Ann' tm t ->
-        paren (p >= 0) $
-          pretty0 n (ac 10 Normal im doc) tm
-            <> PP.hang (fmt S.TypeAscriptionColon " :") (TypePrinter.pretty0 n im 0 t)
-      Int' i -> fmt S.NumericLiteral $ (if i >= 0 then l "+" else mempty) <> l (show i)
-      Nat' u -> fmt S.NumericLiteral $ l $ show u
-      Float' f -> fmt S.NumericLiteral $ l $ show f
+      Ann' tm t -> do
+        tm' <- pretty0 (ac 10 Normal im doc) tm
+        tp' <- TypePrinter.pretty0 im 0 t
+        pure . paren (p >= 0) $ tm' <> PP.hang (fmt S.TypeAscriptionColon " :") tp'
+      Int' i -> pure . fmt S.NumericLiteral $ (if i >= 0 then l "+" else mempty) <> l (show i)
+      Nat' u -> pure . fmt S.NumericLiteral . l $ show u
+      Float' f -> pure . fmt S.NumericLiteral . l $ show f
       -- TODO How to handle Infinity, -Infinity and NaN?  Parser cannot parse
       --      them.  Haskell doesn't have literals for them either.  Is this
       --      function only required to operate on terms produced by the parser?
@@ -213,53 +214,57 @@ pretty0
       --      on values produced by execution (or, one day, on terms produced by
       --      metaprograms), then it needs to be able to print them (and then the
       --      parser ought to be able to parse them, to maintain symmetry.)
-      Boolean' b -> fmt S.BooleanLiteral $ if b then l "true" else l "false"
-      Text' s -> fmt S.TextLiteral $ l $ U.ushow s
-      Char' c -> fmt S.CharLiteral $
-        l $ case showEscapeChar c of
+      Boolean' b -> pure . fmt S.BooleanLiteral $ if b then l "true" else l "false"
+      Text' s -> pure . fmt S.TextLiteral $ l $ U.ushow s
+      Char' c -> pure
+        . fmt S.CharLiteral
+        . l
+        $ case showEscapeChar c of
           Just c -> "?\\" ++ [c]
           Nothing -> '?' : [c]
-      Blank' id -> fmt S.Blank $ l "_" <> l (fromMaybe "" (Blank.nameb id))
-      Constructor' ref ->
-        styleHashQualified'' (fmt $ S.TermReference conRef) name
-        where
-          name = elideFQN im $ PrettyPrintEnv.termName n conRef
-          conRef = Referent.Con ref CT.Data
-      Request' ref ->
-        styleHashQualified'' (fmt $ S.TermReference conRef) name
-        where
-          name = elideFQN im $ PrettyPrintEnv.termName n conRef
-          conRef = Referent.Con ref CT.Effect
-      Handle' h body ->
-        paren (p >= 2) $
+      Blank' id -> pure $ fmt S.Blank $ l "_" <> l (fromMaybe "" (Blank.nameb id))
+      Constructor' ref -> do
+        n <- getPPE
+        let name = elideFQN im $ PrettyPrintEnv.termName n conRef
+            conRef = Referent.Con ref CT.Data
+        pure $ styleHashQualified'' (fmt $ S.TermReference conRef) name
+      Request' ref -> do
+        n <- getPPE
+        let name = elideFQN im $ PrettyPrintEnv.termName n conRef
+            conRef = Referent.Con ref CT.Effect
+        pure $ styleHashQualified'' (fmt $ S.TermReference conRef) name
+      Handle' h body -> do
+        pb <- pblock body
+        ph <- pblock h
+        pure . paren (p >= 2) $
           if PP.isMultiLine pb || PP.isMultiLine ph
             then
               PP.lines
-                [ (fmt S.ControlKeyword "handle") `PP.hang` pb,
-                  (fmt S.ControlKeyword "with") `PP.hang` ph
+                [ fmt S.ControlKeyword "handle" `PP.hang` pb,
+                  fmt S.ControlKeyword "with" `PP.hang` ph
                 ]
             else
               PP.spaced
-                [ (fmt S.ControlKeyword "handle") `PP.hang` pb
+                [ fmt S.ControlKeyword "handle" `PP.hang` pb
                     <> PP.softbreak
-                    <> (fmt S.ControlKeyword "with") `PP.hang` ph
+                    <> fmt S.ControlKeyword "with" `PP.hang` ph
                 ]
         where
-          pb = pblock body
-          ph = pblock h
           pblock tm =
             let (im', uses) = calcImports im tm
-             in uses $ [pretty0 n (ac 0 Block im' doc) tm]
-      App' x (Constructor' (ConstructorReference DD.UnitRef 0)) ->
-        paren (p >= 11 || isBlock x && p >= 3) $
-          fmt S.DelayForceChar (l "!")
-            <> pretty0 n (ac (if isBlock x then 0 else 10) Normal im doc) x
+             in uses <$> sequence [pretty0 (ac 0 Block im' doc) tm]
+      App' x (Constructor' (ConstructorReference DD.UnitRef 0)) -> do
+        px <- pretty0 (ac (if isBlock x then 0 else 10) Normal im doc) x
+        pure . paren (p >= 11 || isBlock x && p >= 3) $
+          fmt S.DelayForceChar (l "!") <> px
       Delay' x
-        | Lets' _ _ <- x ->
-          paren (p >= 3) $
-            fmt S.ControlKeyword "do" `PP.hang` pretty0 n (ac 0 Block im doc) x
-        | otherwise ->
-          paren (p >= 11 || isBlock x && p >= 3) $
+        | Lets' _ _ <- x -> do
+          px <- pretty0 (ac 0 Block im doc) x
+          pure . paren (p >= 3) $
+            fmt S.ControlKeyword "do" `PP.hang` px
+        | otherwise -> do
+          px <- pretty0 (ac 10 Normal im doc) x
+          pure . paren (p >= 11 || isBlock x && p >= 3) $
             fmt S.DelayForceChar (l "'")
               <> ( case x of
                      Lets' _ _ -> id
@@ -268,46 +273,49 @@ pretty0
                      -- in which case the arguments should be indented.
                      _ -> PP.indentAfterNewline "  "
                  )
-                (pretty0 n (ac 10 Normal im doc) x)
+                px
       List' xs ->
-        PP.group $
-          (fmt S.DelimiterChar $ l "[") <> optSpace
-            <> intercalateMap
-              ((fmt S.DelimiterChar $ l ",") <> PP.softbreak <> optSpace <> optSpace)
-              (PP.indentNAfterNewline 2 . pretty0 n (ac 0 Normal im doc))
-              xs
-            <> optSpace
-            <> (fmt S.DelimiterChar $ l "]")
+        PP.group <$> do
+          xs' <- traverse (pretty0 (ac 0 Normal im doc)) xs
+          pure $
+            fmt S.DelimiterChar (l "[") <> optSpace
+              <> intercalateMap
+                (fmt S.DelimiterChar (l ",") <> PP.softbreak <> optSpace <> optSpace)
+                (PP.indentNAfterNewline 2)
+                xs'
+              <> optSpace
+              <> fmt S.DelimiterChar (l "]")
         where
           optSpace = PP.orElse "" " "
       If' cond t f ->
-        paren (p >= 2) $
-          if PP.isMultiLine pcond
-            then
-              PP.lines
-                [ (fmt S.ControlKeyword "if") `PP.hang` pcond,
-                  (fmt S.ControlKeyword "then") `PP.hang` pt,
-                  (fmt S.ControlKeyword "else") `PP.hang` pf
-                ]
-            else
-              if PP.isMultiLine pt || PP.isMultiLine pf
-                then
-                  PP.lines
-                    [ (fmt S.ControlKeyword "if ") <> pcond <> (fmt S.ControlKeyword " then") `PP.hang` pt,
-                      (fmt S.ControlKeyword "else") `PP.hang` pf
-                    ]
-                else
-                  PP.spaced
-                    [ ((fmt S.ControlKeyword "if") `PP.hang` pcond) <> ((fmt S.ControlKeyword " then") `PP.hang` pt),
-                      (fmt S.ControlKeyword "else") `PP.hang` pf
-                    ]
+        do
+          pcond <- pretty0 (ac 2 Block im doc) cond
+          pt <- branch t
+          pf <- branch f
+          pure . paren (p >= 2) $
+            if PP.isMultiLine pcond
+              then
+                PP.lines
+                  [ fmt S.ControlKeyword "if" `PP.hang` pcond,
+                    fmt S.ControlKeyword "then" `PP.hang` pt,
+                    fmt S.ControlKeyword "else" `PP.hang` pf
+                  ]
+              else
+                if PP.isMultiLine pt || PP.isMultiLine pf
+                  then
+                    PP.lines
+                      [ fmt S.ControlKeyword "if " <> pcond <> fmt S.ControlKeyword " then" `PP.hang` pt,
+                        fmt S.ControlKeyword "else" `PP.hang` pf
+                      ]
+                  else
+                    PP.spaced
+                      [ (fmt S.ControlKeyword "if" `PP.hang` pcond) <> (fmt S.ControlKeyword " then" `PP.hang` pt),
+                        fmt S.ControlKeyword "else" `PP.hang` pf
+                      ]
         where
-          pcond = pretty0 n (ac 2 Block im doc) cond
-          pt = branch t
-          pf = branch f
           branch tm =
             let (im', uses) = calcImports im tm
-             in uses $ [pretty0 n (ac 0 Block im' doc) tm]
+             in uses <$> sequence [pretty0 (ac 0 Block im' doc) tm]
       LetBlock bs e ->
         let (im', uses) = calcImports im term
          in printLet elideUnit bc bs e im' uses
@@ -318,166 +326,196 @@ pretty0
       --   blah
       -- See `isDestructuringBind` definition.
       Match' scrutinee cs@[MatchCase pat guard (AbsN' vs body)]
-        | p < 1 && isDestructuringBind scrutinee cs ->
-          letIntro $
-            PP.lines
-              [ (lhs <> eq) `PP.hang` rhs,
-                pretty0 n (ac (-1) Block im doc) body
-              ]
-        where
-          letIntro = case bc of
-            Block -> id
-            Normal -> \x ->
-              -- We don't call calcImports here, because we can't easily do the
-              -- corequisite step in immediateChildBlockTerms (because it doesn't
-              -- know bc.)  So we'll fail to take advantage of any opportunity
-              -- this let block provides to add a use statement.  Not so bad.
-              fmt S.ControlKeyword "let" `PP.hang` x
-          lhs =
-            PP.group (fst (prettyPattern n (ac 0 Block im doc) 10 vs pat))
-              `PP.hang` printGuard guard
-          printGuard Nothing = mempty
-          printGuard (Just g') =
-            let (_, g) = ABT.unabs g'
-             in (fmt S.DelimiterChar "| ") <> pretty0 n (ac 2 Normal im doc) g
-          eq = fmt S.BindingEquals "="
-          rhs =
+        | p < 1 && isDestructuringBind scrutinee cs -> do
+          n <- getPPE
+          let letIntro = case bc of
+                Block -> id
+                Normal -> \x ->
+                  -- We don't call calcImports here, because we can't easily do the
+                  -- corequisite step in immediateChildBlockTerms (because it doesn't
+                  -- know bc.)  So we'll fail to take advantage of any opportunity
+                  -- this let block provides to add a use statement.  Not so bad.
+                  fmt S.ControlKeyword "let" `PP.hang` x
+          lhs <- do
+            let (lhs, _) = prettyPattern n (ac 0 Block im doc) 10 vs pat
+            guard' <- printGuard guard
+            pure $ PP.group lhs `PP.hang` guard'
+          let eq = fmt S.BindingEquals "="
+          rhs <- do
             let (im', uses) = calcImports im scrutinee
-             in uses $ [pretty0 n (ac (-1) Block im' doc) scrutinee]
-      Match' scrutinee branches ->
-        paren (p >= 2) $
-          if PP.isMultiLine ps
-            then
+            uses <$> sequence [pretty0 (ac (-1) Block im' doc) scrutinee]
+          letIntro <$> do
+            prettyBody <- pretty0 (ac (-1) Block im doc) body
+            pure $
               PP.lines
-                [ (fmt S.ControlKeyword "match ") `PP.hang` ps,
-                  (fmt S.ControlKeyword " with") `PP.hang` pbs
+                [ (lhs <> eq) `PP.hang` rhs,
+                  prettyBody
                 ]
-            else ((fmt S.ControlKeyword "match ") <> ps <> (fmt S.ControlKeyword " with")) `PP.hang` pbs
         where
-          ps = pretty0 n (ac 2 Normal im doc) scrutinee
-          pbs = printCase n im doc (arity1Branches branches) -- don't print with `cases` syntax
-      t -> l "error: " <> l (show t)
+          printGuard Nothing = pure mempty
+          printGuard (Just g') = do
+            let (_, g) = ABT.unabs g'
+            prettyg <- pretty0 (ac 2 Normal im doc) g
+            pure $ fmt S.DelimiterChar "| " <> prettyg
+      Match' scrutinee branches ->
+        do
+          ps <- pretty0 (ac 2 Normal im doc) scrutinee
+          pbs <- printCase im doc (arity1Branches branches) -- don't print with `cases` syntax
+          pure . paren (p >= 2) $
+            if PP.isMultiLine ps
+              then
+                PP.lines
+                  [ fmt S.ControlKeyword "match " `PP.hang` ps,
+                    fmt S.ControlKeyword " with" `PP.hang` pbs
+                  ]
+              else (fmt S.ControlKeyword "match " <> ps <> fmt S.ControlKeyword " with") `PP.hang` pbs
+      t -> pure $ l "error: " <> l (show t)
     where
-      goNormal prec tm = pretty0 n (ac prec Normal im doc) tm
-      specialCases term _go | Just p <- prettyDoc2 n a term = p
-      specialCases term go = case (term, binaryOpsPred) of
-        (DD.Doc, _)
-          | doc == MaybeDoc ->
-            if isDocLiteral term
-              then prettyDoc n im term
-              else pretty0 n (a {docContext = NoDoc}) term
-        (TupleTerm' [x], _) ->
-          let conRef = DD.pairCtorRef
-              name = elideFQN im $ PrettyPrintEnv.termName n conRef
-              pair = parenIfInfix name ic $ styleHashQualified'' (fmt (S.TermReference conRef)) name
-           in paren (p >= 10) $
-                pair
-                  `PP.hang` PP.spaced [pretty0 n (ac 10 Normal im doc) x, fmt (S.TermReference DD.unitCtorRef) "()"]
-        (TupleTerm' xs, _) ->
-          let tupleLink p = fmt (S.TypeReference DD.unitRef) p
-           in PP.group (tupleLink "(" <> commaList xs <> tupleLink ")")
-        (App' f@(Builtin' "Any.Any") arg, _) ->
-          paren (p >= 10) $ goNormal 9 f `PP.hang` goNormal 10 arg
-        (Apps' f@(Constructor' _) args, _) ->
-          paren (p >= 10) $ goNormal 9 f `PP.hang` PP.spacedMap (goNormal 10) args
-        {-
-        When a delayed computation block is passed to a function as the last argument
-        in a context where the ambient precedence is low enough, we can elide parentheses
-        around it and use a "soft hang" to put the `'let` on the same line as the function call.
-        This looks nice.
+      goNormal prec tm = pretty0 (ac prec Normal im doc) tm
+      specialCases term go = do
+        doc <- prettyDoc2 a term
+        case doc of
+          Just d -> pure d
+          Nothing -> notDoc go
+      notDoc go = do
+        n <- getPPE
+        let -- This predicate controls which binary functions we render as infix
+            -- operators. At the moment the policy is just to render symbolic
+            -- operators as infix.
+            binaryOpsPred :: Term3 v PrintAnnotation -> Bool
+            binaryOpsPred = \case
+              Ref' r -> isSymbolic $ PrettyPrintEnv.termName n (Referent.Ref r)
+              Var' v -> isSymbolic $ HQ.unsafeFromVar v
+              _ -> False
+        case (term, binaryOpsPred) of
+          (DD.Doc, _)
+            | doc == MaybeDoc ->
+              if isDocLiteral term
+                then applyPPE3 prettyDoc im term
+                else pretty0 (a {docContext = NoDoc}) term
+          (TupleTerm' [x], _) -> do
+            let conRef = DD.pairCtorRef
+            name <- elideFQN im <$> applyPPE2 PrettyPrintEnv.termName conRef
+            let pair = parenIfInfix name ic $ styleHashQualified'' (fmt (S.TermReference conRef)) name
+            x' <- pretty0 (ac 10 Normal im doc) x
+            pure . paren (p >= 10) $
+              pair
+                `PP.hang` PP.spaced [x', fmt (S.TermReference DD.unitCtorRef) "()"]
+          (TupleTerm' xs, _) -> do
+            clist <- commaList xs
+            let tupleLink p = fmt (S.TypeReference DD.unitRef) p
+            pure $ PP.group (tupleLink "(" <> clist <> tupleLink ")")
+          (App' f@(Builtin' "Any.Any") arg, _) ->
+            paren (p >= 10) <$> (PP.hang <$> goNormal 9 f <*> goNormal 10 arg)
+          (Apps' f@(Constructor' _) args, _) ->
+            paren (p >= 10) <$> (PP.hang <$> goNormal 9 f <*> PP.spacedTraverse (goNormal 10) args)
+          {-
+          When a delayed computation block is passed to a function as the last argument
+          in a context where the ambient precedence is low enough, we can elide parentheses
+          around it and use a "soft hang" to put the `'let` on the same line as the function call.
+          This looks nice.
 
-          forkAt usEast 'let
-            x = thing1
-            y = thing2
-            ...
-
-        instead of the ugly but effective
-
-          forkAt
-            usEast
-            ('let
+            forkAt usEast 'let
               x = thing1
               y = thing2
-              ...)
-        -}
-        (Apps' f (unsnoc -> Just (args, lastArg@(Delay' (Lets' _ _)))), _) ->
-          paren (p >= 3) $
-            goNormal 9 f `PP.softHang` (PP.spaced ((goNormal 10 <$> args) <> [goNormal 0 lastArg]))
-        (Bytes' bs, _) ->
-          fmt S.BytesLiteral "0xs" <> (PP.shown $ Bytes.fromWord8s (map fromIntegral bs))
-        BinaryAppsPred' apps lastArg ->
-          paren (p >= 3) $
-            binaryApps apps (pretty0 n (ac 3 Normal im doc) lastArg)
-        -- Note that && and || are at the same precedence, which can cause
-        -- confusion, so for clarity we do not want to elide the parentheses in a
-        -- case like `(x || y) && z`.
-        (Ands' xs lastArg, _) ->
-          paren (p >= 10) $
-            booleanOps (fmt S.ControlKeyword "&&") xs (pretty0 n (ac 10 Normal im doc) lastArg)
-        (Ors' xs lastArg, _) ->
-          paren (p >= 10) $
-            booleanOps (fmt S.ControlKeyword "||") xs (pretty0 n (ac 10 Normal im doc) lastArg)
-        _ -> case (term, nonForcePred) of
-          OverappliedBinaryAppPred' f a b r
-            | binaryOpsPred f ->
-              -- Special case for overapplied binary op
-              paren
-                True
-                ( binaryApps [(f, a)] (pretty0 n (ac 3 Normal im doc) b)
-                    `PP.hang` PP.spacedMap (pretty0 n (ac 10 Normal im doc)) r
-                )
-          AppsPred' f args ->
-            paren (p >= 10) $
-              pretty0 n (ac 10 Normal im doc) f
-                `PP.hang` PP.spacedMap (pretty0 n (ac 10 Normal im doc)) args
-          _ -> case (term, \v -> nonUnitArgPred v && not (isDelay term)) of
-            (LamsNamedMatch' [] branches, _) ->
-              paren (p >= 3) $
-                PP.group (fmt S.ControlKeyword "cases") `PP.hang` printCase n im doc branches
-            LamsNamedPred' vs body ->
-              paren (p >= 3) $
-                PP.group (varList vs <> fmt S.ControlKeyword " ->") `PP.hang` pretty0 n (ac 2 Block im doc) body
-            _ -> go term
+              ...
+
+          instead of the ugly but effective
+
+            forkAt
+              usEast
+              ('let
+                x = thing1
+                y = thing2
+                ...)
+          -}
+          (Apps' f (unsnoc -> Just (args, lastArg@(Delay' (Lets' _ _)))), _) -> do
+            fun <- goNormal 9 f
+            args' <- traverse (goNormal 10) args
+            lastArg' <- goNormal 0 lastArg
+            pure . paren (p >= 3) $ PP.softHang fun (PP.spaced (args' <> [lastArg']))
+          (Bytes' bs, _) ->
+            pure $ fmt S.BytesLiteral "0xs" <> PP.shown (Bytes.fromWord8s (map fromIntegral bs))
+          BinaryAppsPred' apps lastArg -> do
+            prettyLast <- pretty0 (ac 3 Normal im doc) lastArg
+            prettyApps <- binaryApps apps prettyLast
+            pure $ paren (p >= 3) prettyApps
+          -- Note that && and || are at the same precedence, which can cause
+          -- confusion, so for clarity we do not want to elide the parentheses in a
+          -- case like `(x || y) && z`.
+          (Ands' xs lastArg, _) ->
+            -- Old code, without monadic booleanOps:
+            -- paren (p >= 10)
+            --   . booleanOps (fmt S.ControlKeyword "&&") xs
+            --   <$> pretty0 (ac 10 Normal im doc) lastArg
+            -- New code, where booleanOps is monadic like pretty0:
+            paren (p >= 10) <$> do
+              lastArg' <- pretty0 (ac 10 Normal im doc) lastArg
+              booleanOps (fmt S.ControlKeyword "&&") xs lastArg'
+          (Ors' xs lastArg, _) ->
+            -- Old code:
+            -- paren (p >= 10)
+            --   . booleanOps (fmt S.ControlKeyword "||") xs
+            --   <$> pretty0 (ac 10 Normal im doc) lastArg
+            -- New code:
+            paren (p >= 10) <$> do
+              lastArg' <- pretty0 (ac 10 Normal im doc) lastArg
+              booleanOps (fmt S.ControlKeyword "||") xs lastArg'
+          _ -> case (term, nonForcePred) of
+            OverappliedBinaryAppPred' f a b r
+              | binaryOpsPred f ->
+                -- Special case for overapplied binary op
+                do
+                  prettyB <- pretty0 (ac 3 Normal im doc) b
+                  prettyR <- PP.spacedTraverse (pretty0 (ac 10 Normal im doc)) r
+                  prettyA <- binaryApps [(f, a)] prettyB
+                  pure $ paren True $ PP.hang prettyA prettyR
+            AppsPred' f args ->
+              paren (p >= 10) <$> do
+                f' <- pretty0 (ac 10 Normal im doc) f
+                args' <- PP.spacedTraverse (pretty0 (ac 10 Normal im doc)) args
+                pure $ f' `PP.hang` args'
+            _ -> case (term, \v -> nonUnitArgPred v && not (isDelay term)) of
+              (LamsNamedMatch' [] branches, _) -> do
+                pbs <- printCase im doc branches
+                pure . paren (p >= 3) $
+                  PP.group (fmt S.ControlKeyword "cases") `PP.hang` pbs
+              LamsNamedPred' vs body -> do
+                prettyBody <- pretty0 (ac 2 Block im doc) body
+                pure . paren (p >= 3) $
+                  PP.group (varList vs <> fmt S.ControlKeyword " ->") `PP.hang` prettyBody
+              _ -> go term
 
       isDelay (Delay' _) = True
       isDelay _ = False
-      sepList = sepList' (pretty0 n (ac 0 Normal im doc))
-      sepList' f sep xs = fold $ intersperse sep (map f xs)
-      varList = sepList' (PP.text . Var.name) PP.softbreak
+      sepList = sepList' (pretty0 (ac 0 Normal im doc))
+      sepList' f sep xs = fold . intersperse sep <$> traverse f xs
+      varList = runIdentity . sepList' (Identity . PP.text . Var.name) PP.softbreak
       commaList = sepList (fmt S.DelimiterChar (l ",") <> PP.softbreak)
 
       printLet ::
-        Var v =>
         Bool -> -- elideUnit
         BlockContext ->
         [(v, Term3 v PrintAnnotation)] ->
         Term3 v PrintAnnotation ->
         Imports ->
         ([Pretty SyntaxText] -> Pretty SyntaxText) ->
-        Pretty SyntaxText
+        m (Pretty SyntaxText)
       printLet elideUnit sc bs e im uses =
-        paren ((sc /= Block) && p >= 12) $
-          letIntro $
-            uses [PP.lines (map printBinding bs ++ body e)]
+        paren (sc /= Block && p >= 12)
+          . letIntro
+          . uses
+          <$> ((++) <$> traverse printBinding bs <*> body e)
         where
-          body (Constructor' (ConstructorReference DD.UnitRef 0)) | elideUnit = []
-          body e = [PP.group $ pretty0 n (ac 0 Normal im doc) e]
+          body (Constructor' (ConstructorReference DD.UnitRef 0)) | elideUnit = pure []
+          body e = (: []) <$> pretty0 (ac 0 Normal im doc) e
           printBinding (v, binding) =
             if isBlank $ Var.nameStr v
-              then pretty0 n (ac (-1) Normal im doc) binding
-              else prettyBinding0 n (ac (-1) Normal im doc) (HQ.unsafeFromVar v) binding
+              then pretty0 (ac (-1) Normal im doc) binding
+              else prettyBinding0 (ac (-1) Normal im doc) (HQ.unsafeFromVar v) binding
           letIntro = case sc of
             Block -> id
-            Normal -> \x -> (fmt S.ControlKeyword "let") `PP.hang` x
-
-      -- This predicate controls which binary functions we render as infix
-      -- operators. At the moment the policy is just to render symbolic
-      -- operators as infix.
-      binaryOpsPred :: Var v => Term3 v PrintAnnotation -> Bool
-      binaryOpsPred = \case
-        Ref' r -> isSymbolic $ PrettyPrintEnv.termName n (Referent.Ref r)
-        Var' v -> isSymbolic $ HQ.unsafeFromVar v
-        _ -> False
+            Normal -> \x -> fmt S.ControlKeyword "let" `PP.hang` x
 
       nonForcePred :: Term3 v PrintAnnotation -> Bool
       nonForcePred = \case
@@ -486,7 +524,7 @@ pretty0
         _ -> True
 
       nonUnitArgPred :: Var v => v -> Bool
-      nonUnitArgPred v = (Var.name v) /= "()"
+      nonUnitArgPred v = Var.name v /= "()"
 
       -- Render a binary infix operator sequence, like [(a2, f2), (a1, f1)],
       -- meaning (a1 `f1` a2) `f2` (a3 rendered by the caller), producing
@@ -494,48 +532,51 @@ pretty0
       -- produce any backticks.  We build the result out from the right,
       -- starting at `f2`.
       binaryApps ::
-        Var v =>
         [(Term3 v PrintAnnotation, Term3 v PrintAnnotation)] ->
         Pretty SyntaxText ->
-        Pretty SyntaxText
-      binaryApps xs last = unbroken `PP.orElse` broken
+        m (Pretty SyntaxText)
+      binaryApps xs last =
+        do
+          ps <- join <$> traverse (uncurry r) (reverse xs)
+          let unbroken = PP.spaced (ps <> [last])
+              broken = PP.hang (head ps) . PP.column2 . psCols $ tail ps <> [last]
+          pure (unbroken `PP.orElse` broken)
         where
-          unbroken = PP.spaced (ps ++ [last])
-          broken = PP.hang (head ps) . PP.column2 . psCols $ (tail ps ++ [last])
           psCols ps = case take 2 ps of
             [x, y] -> (x, y) : psCols (drop 2 ps)
             [x] -> [(x, "")]
             [] -> []
             _ -> undefined
-          ps = join $ [r a f | (a, f) <- reverse xs]
           r a f =
-            [ pretty0 n (ac (if isBlock a then 12 else 3) Normal im doc) a,
-              pretty0 n (AmbientContext 10 Normal Infix im doc False) f
-            ]
+            sequenceA
+              [ pretty0 (ac (if isBlock a then 12 else 3) Normal im doc) a,
+                pretty0 (AmbientContext 10 Normal Infix im doc False) f
+              ]
 
       -- Render sequence of infix &&s or ||s, like [x2, x1],
       -- meaning (x1 && x2) && (x3 rendered by the caller), producing
       -- "x1 && x2 &&". The result is built from the right.
       booleanOps ::
-        Var v =>
         Pretty SyntaxText ->
         [Term3 v PrintAnnotation] ->
         Pretty SyntaxText ->
-        Pretty SyntaxText
-      booleanOps op xs last = unbroken `PP.orElse` broken
+        m (Pretty SyntaxText)
+      booleanOps op xs last = do
+        ps <- join <$> traverse r (reverse xs)
+        let unbroken = PP.spaced (ps <> [last])
+            broken = PP.hang (head ps) . PP.column2 . psCols $ tail ps <> [last]
+        pure (unbroken `PP.orElse` broken)
         where
-          unbroken = PP.spaced (ps ++ [last])
-          broken = PP.hang (head ps) . PP.column2 . psCols $ (tail ps ++ [last])
           psCols ps = case take 2 ps of
             [x, y] -> (x, y) : psCols (drop 2 ps)
             [x] -> [(x, "")]
             [] -> []
             _ -> undefined
-          ps = r =<< reverse xs
           r a =
-            [ pretty0 n (ac (if isBlock a then 12 else 10) Normal im doc) a,
-              op
-            ]
+            sequence
+              [ pretty0 (ac (if isBlock a then 12 else 10) Normal im doc) a,
+                pure op
+              ]
 
 prettyPattern ::
   forall v loc.
@@ -549,7 +590,7 @@ prettyPattern ::
 -- vs is the list of pattern variables used by the pattern, plus possibly a
 -- tail of variables it doesn't use.  This tail is the second component of
 -- the return value.
-prettyPattern n c@(AmbientContext {imports = im}) p vs patt = case patt of
+prettyPattern n c@AmbientContext {imports = im} p vs patt = case patt of
   Pattern.Char _ c ->
     ( fmt S.CharLiteral $
         l $ case showEscapeChar c of
@@ -563,7 +604,7 @@ prettyPattern n c@(AmbientContext {imports = im}) p vs patt = case patt of
       (v : tail_vs) -> (fmt S.Var $ l $ Var.nameStr v, tail_vs)
       _ -> error "prettyPattern: Expected at least one var"
   Pattern.Boolean _ b -> (fmt S.BooleanLiteral $ if b then l "true" else l "false", vs)
-  Pattern.Int _ i -> (fmt S.NumericLiteral $ (if i >= 0 then l "+" else mempty) <> (l $ show i), vs)
+  Pattern.Int _ i -> (fmt S.NumericLiteral $ (if i >= 0 then l "+" else mempty) <> l (show i), vs)
   Pattern.Nat _ u -> (fmt S.NumericLiteral $ l $ show u, vs)
   Pattern.Float _ f -> (fmt S.NumericLiteral $ l $ show f, vs)
   Pattern.Text _ t -> (fmt S.TextLiteral $ l $ show t, vs)
@@ -589,7 +630,7 @@ prettyPattern n c@(AmbientContext {imports = im}) p vs patt = case patt of
     case vs of
       (v : tail_vs) ->
         let (printed, eventual_tail) = prettyPattern n c 11 tail_vs pat
-         in (paren (p >= 11) $ ((fmt S.Var $ l $ Var.nameStr v) <> (fmt S.DelimiterChar $ l "@") <> printed), eventual_tail)
+         in (paren (p >= 11) (fmt S.Var (l $ Var.nameStr v) <> fmt S.DelimiterChar (l "@") <> printed), eventual_tail)
       _ -> error "prettyPattern: Expected at least one var"
   Pattern.EffectPure _ pat ->
     let (printed, eventual_tail) = prettyPattern n c (-1) vs pat
@@ -602,7 +643,7 @@ prettyPattern n c@(AmbientContext {imports = im}) p vs patt = case patt of
      in ( PP.group
             ( fmt S.DelimiterChar "{"
                 <> ( PP.sep " " . PP.nonEmpty $
-                       [ styleHashQualified'' (fmt (S.TermReference conRef)) $ name,
+                       [ styleHashQualified'' (fmt (S.TermReference conRef)) name,
                          pats_printed,
                          fmt S.ControlKeyword "->",
                          k_pat_printed
@@ -614,11 +655,11 @@ prettyPattern n c@(AmbientContext {imports = im}) p vs patt = case patt of
         )
   Pattern.SequenceLiteral _ pats ->
     let (pats_printed, tail_vs) = patternsSep (-1) (fmt S.DelimiterChar ", ") vs pats
-     in ((fmt S.DelimiterChar "[") <> pats_printed <> (fmt S.DelimiterChar "]"), tail_vs)
+     in (fmt S.DelimiterChar "[" <> pats_printed <> fmt S.DelimiterChar "]", tail_vs)
   Pattern.SequenceOp _ l op r ->
     let (pl, lvs) = prettyPattern n c p vs l
         (pr, rvs) = prettyPattern n c (p + 1) lvs r
-        f i s = (paren (p >= i) (pl <> " " <> (fmt (S.Op op) s) <> " " <> pr), rvs)
+        f i s = (paren (p >= i) (pl <> " " <> fmt (S.Op op) s <> " " <> pr), rvs)
      in case op of
           Pattern.Cons -> f 0 "+:"
           Pattern.Snoc -> f 0 ":+"
@@ -663,13 +704,12 @@ groupCases ms = go0 ms
       | otherwise = (p0, vs0, reverse acc) : go0 ms
 
 printCase ::
-  Var v =>
-  PrettyPrintEnv ->
+  MonadPretty v m =>
   Imports ->
   DocLiteralContext ->
   [MatchCase' () (Term3 v PrintAnnotation)] ->
-  Pretty SyntaxText
-printCase env im doc ms0 = PP.lines $ alignGrid grid
+  m (Pretty SyntaxText)
+printCase im doc ms0 = PP.lines . alignGrid <$> grid
   where
     ms = groupCases ms0
     justify rows =
@@ -687,36 +727,40 @@ printCase env im doc ms0 = PP.lines $ alignGrid grid
           PP.lines $
             fmap (\(g, (a, b)) -> PP.hang (PP.group (g <> a)) b) justified
         justified = PP.leftJustify $ fmap (\(g, b) -> (g, (arrow, b))) gbs
-    grid = go <$> ms
-    patLhs vs pats = case pats of
-      [pat] -> PP.group (fst (prettyPattern env (ac 0 Block im doc) (-1) vs pat))
-      pats -> PP.group . PP.sep ("," <> PP.softbreak)
-        . (`evalState` vs)
-        . for pats
-        $ \pat -> do
-          vs <- State.get
-          let (p, rem) = prettyPattern env (ac 0 Block im doc) (-1) vs pat
-          State.put rem
-          pure p
+    grid = traverse go ms
+    patLhs env vs pats =
+      case pats of
+        [pat] -> PP.group (fst (prettyPattern env (ac 0 Block im doc) (-1) vs pat))
+        pats -> PP.group . PP.sep ("," <> PP.softbreak)
+          . (`evalState` vs)
+          . for pats
+          $ \pat -> do
+            vs <- State.get
+            let (p, rem) = prettyPattern env (ac 0 Block im doc) (-1) vs pat
+            State.put rem
+            pure p
     arrow = fmt S.ControlKeyword "->"
-    goBody im' uses body = uses [pretty0 env (ac 0 Block im' doc) body]
+    goBody im' uses body = uses <$> sequence [pretty0 (ac 0 Block im' doc) body]
     -- If there's multiple guarded cases for this pattern, prints as:
     -- MyPattern x y
     --   | guard 1        -> 1
     --   | otherguard x y -> 2
     --   | otherwise      -> 3
-    go (pats, vs, unzip -> (guards, bodies)) =
-      (patLhs vs pats, printGuard <$> guards, printBody <$> bodies)
+    go (pats, vs, unzip -> (guards, bodies)) = do
+      guards' <- traverse printGuard guards
+      bodies' <- traverse printBody bodies
+      ppe <- getPPE
+      pure (patLhs ppe vs pats, guards', bodies')
       where
         noGuards = all (== Nothing) guards
-        printGuard Nothing | noGuards = mempty
+        printGuard Nothing | noGuards = pure mempty
         printGuard Nothing =
-          fmt S.DelimiterChar "|" <> " " <> fmt S.ControlKeyword "otherwise"
+          pure $ fmt S.DelimiterChar "|" <> " " <> fmt S.ControlKeyword "otherwise"
         printGuard (Just (ABT.AbsN' _ g)) =
           -- strip off any Abs-chain around the guard, guard variables are rendered
           -- like any other variable, ex: case Foo x y | x < y -> ...
-          PP.spaceIfNeeded (fmt S.DelimiterChar "|") $
-            pretty0 env (ac 2 Normal im doc) g
+          PP.spaceIfNeeded (fmt S.DelimiterChar "|")
+            <$> pretty0 (ac 2 Normal im doc) g
         printBody b = let (im', uses) = calcImports im b in goBody im' uses b
 
 {- Render a binding, producing output of the form
@@ -734,69 +778,80 @@ a + b = ...
 
 -}
 prettyBinding ::
-  Var v =>
-  PrettyPrintEnv ->
+  MonadPretty v m =>
   HQ.HashQualified Name ->
   Term2 v at ap v a ->
-  Pretty SyntaxText
-prettyBinding n = prettyBinding0 n $ ac (-1) Block Map.empty MaybeDoc
+  m (Pretty SyntaxText)
+prettyBinding = prettyBinding0 $ ac (-1) Block Map.empty MaybeDoc
 
 prettyBinding' ::
-  Var v =>
+  MonadPretty v m =>
   Width ->
-  PrettyPrintEnv ->
   HQ.HashQualified Name ->
   Term v a ->
-  ColorText
-prettyBinding' width n v t =
-  PP.render width $ PP.syntaxToColor $ prettyBinding n v t
+  m ColorText
+prettyBinding' width v t =
+  PP.render width . PP.syntaxToColor <$> prettyBinding v t
 
 prettyBinding0 ::
-  Var v =>
-  PrettyPrintEnv ->
+  MonadPretty v m =>
   AmbientContext ->
   HQ.HashQualified Name ->
   Term2 v at ap v a ->
-  Pretty SyntaxText
-prettyBinding0 env a@AmbientContext {imports = im, docContext = doc} v term =
-  go
-    (symbolic && isBinary term)
-    term
+  m (Pretty SyntaxText)
+prettyBinding0 a@AmbientContext {imports = im, docContext = doc} v term =
+  go (symbolic && isBinary term) term
   where
-    go infix' = \case
-      Ann' tm tp ->
-        PP.lines
-          [ PP.group
-              ( renderName v
-                  <> PP.hang
-                    (fmt S.TypeAscriptionColon " :")
-                    (TypePrinter.pretty0 env im (-1) tp)
-              ),
-            PP.group (prettyBinding0 env a v tm)
-          ]
-      (printAnnotate env -> LamsNamedMatch' vs branches) ->
-        PP.group $
-          PP.group
-            ( defnLhs v vs <> fmt S.BindingEquals " =" <> " "
-                <> fmt
-                  S.ControlKeyword
-                  "cases"
-            )
-            `PP.hang` printCase env im doc branches
-      LamsNamedOrDelay' vs body ->
-        let (im', uses) = calcImports im body'
-            -- In the case where we're being called from inside `pretty0`, this
-            -- call to printAnnotate is unfortunately repeating work we've already
-            -- done.
-            body' = printAnnotate env body
-            -- Special case for 'let being on the same line
-            hang = case body' of
-              Delay' (Lets' _ _) -> PP.softHang
-              _ -> PP.hang
-         in PP.group $
-              PP.group (defnLhs v vs <> fmt S.BindingEquals " =")
-                `hang` uses [pretty0 env (ac (-1) Block im' doc) body']
-      t -> l "error: " <> l (show t)
+    go infix' binding = do
+      env <- getPPE
+      case binding of
+        Ann' tm tp -> do
+          -- If the term is an annotated function,
+          -- we want to print the type signature on the previous line.
+          -- The TypePrinter.pretty0 function prints the type, and uses a
+          -- Reader monad with (Set v) in it to track which type variables are
+          -- bound in the outer scope. We use that to determine if the type
+          -- printer should avoid capture of those variables.
+          let avoidCapture = case tp of
+                ForallsNamed' vs _ -> addTypeVars vs
+                _ -> id
+          tp' <- TypePrinter.pretty0 im (-1) tp
+          tm' <- avoidCapture (prettyBinding0 a v tm)
+          pure $
+            PP.lines
+              [ PP.group
+                  ( renderName v
+                      <> PP.hang
+                        (fmt S.TypeAscriptionColon " :")
+                        tp'
+                  ),
+                PP.group tm'
+              ]
+        (printAnnotate env -> LamsNamedMatch' vs branches) -> do
+          branches' <- printCase im doc branches
+          pure . PP.group $
+            PP.group
+              ( defnLhs v vs <> fmt S.BindingEquals " =" <> " "
+                  <> fmt
+                    S.ControlKeyword
+                    "cases"
+              )
+              `PP.hang` branches'
+        LamsNamedOrDelay' vs body -> do
+          -- In the case where we're being called from inside `pretty0`, this
+          -- call to printAnnotate is unfortunately repeating work we've already
+          -- done.
+          body' <- applyPPE2 printAnnotate body
+          let (im', uses) = calcImports im body'
+          prettyBody <- pretty0 (ac (-1) Block im' doc) body'
+          -- Special case for 'let being on the same line
+          let hang = case body' of
+                Delay' (Lets' _ _) -> PP.softHang
+                _ -> PP.hang
+          pure . PP.group $
+            PP.group (defnLhs v vs <> fmt S.BindingEquals " =")
+              `hang` uses [prettyBody]
+        t -> pure $ l "error: " <> l (show t)
       where
         defnLhs v vs
           | infix' = case vs of
@@ -847,9 +902,9 @@ prettyDoc n im term =
     go (DD.DocJoin segs) = foldMap go segs
     go (DD.DocBlob txt) = PP.paragraphyText (escaped txt)
     go (DD.DocLink (DD.LinkTerm (TermLink' r))) =
-      (fmt S.DocDelimiter $ l "@") <> ((fmt $ S.TermReference r) $ fmtTerm r)
+      fmt S.DocDelimiter (l "@") <> (fmt $ S.TermReference r) (fmtTerm r)
     go (DD.DocLink (DD.LinkType (TypeLink' r))) =
-      (fmt S.DocDelimiter $ l "@") <> ((fmt $ S.TypeReference r) $ fmtType r)
+      fmt S.DocDelimiter (l "@") <> (fmt $ S.TypeReference r) (fmtType r)
     go (DD.DocSource (DD.LinkTerm (TermLink' r))) =
       atKeyword "source" <> fmtTerm r
     go (DD.DocSource (DD.LinkType (TypeLink' r))) =
@@ -864,9 +919,9 @@ prettyDoc n im term =
     fmtTerm r = fmtName $ PrettyPrintEnv.termName n r
     fmtType r = fmtName $ PrettyPrintEnv.typeName n r
     atKeyword w =
-      (fmt S.DocDelimiter $ l "@[")
-        <> (fmt S.DocKeyword $ l w)
-        <> (fmt S.DocDelimiter $ l "] ")
+      fmt S.DocDelimiter (l "@[")
+        <> fmt S.DocKeyword (l w)
+        <> fmt S.DocDelimiter (l "] ")
     escaped = Text.replace "@" "\\@" . Text.replace ":]" "\\:]"
     spaceUnlessBroken = PP.orElse " " ""
 
@@ -895,7 +950,7 @@ isSymbolic' name = case symbolyId . Name.toString $ name of
   _ -> False
 
 isBlank :: String -> Bool
-isBlank ('_' : rest) | (isJust ((readMaybe rest) :: Maybe Int)) = True
+isBlank ('_' : rest) | isJust (readMaybe rest :: Maybe Int) = True
 isBlank _ = False
 
 emptyAc :: AmbientContext
@@ -907,7 +962,7 @@ emptyBlockAc = ac (-1) Block Map.empty MaybeDoc
 ac :: Int -> BlockContext -> Imports -> DocLiteralContext -> AmbientContext
 ac prec bc im doc = AmbientContext prec bc NonInfix im doc False
 
-fmt :: (S.Element r) -> Pretty (S.SyntaxText' r) -> Pretty (S.SyntaxText' r)
+fmt :: S.Element r -> Pretty (S.SyntaxText' r) -> Pretty (S.SyntaxText' r)
 fmt = PP.withSyntax
 
 {-
@@ -1036,7 +1091,7 @@ fmt = PP.withSyntax
    consider adding some features like this later.
 -}
 
-data PrintAnnotation = PrintAnnotation
+newtype PrintAnnotation = PrintAnnotation
   { -- For each suffix that appears in/under this term, the set of prefixes
     -- used with that suffix, and how many times each occurs.
     usages :: Map Suffix (Map Prefix Int)
@@ -1044,7 +1099,7 @@ data PrintAnnotation = PrintAnnotation
   deriving (Show)
 
 instance Semigroup PrintAnnotation where
-  (PrintAnnotation {usages = a}) <> (PrintAnnotation {usages = b}) =
+  PrintAnnotation {usages = a} <> PrintAnnotation {usages = b} =
     PrintAnnotation {usages = Map.unionWith f a b}
     where
       f a' b' = Map.unionWith (+) a' b'
@@ -1062,7 +1117,7 @@ suffixCounterTerm n = \case
   Ann' _ t -> countTypeUsages n t
   Match' _ bs ->
     let pat (MatchCase p _ _) = p
-     in foldMap ((countPatternUsages n) . pat) bs
+     in foldMap (countPatternUsages n . pat) bs
   _ -> mempty
 
 suffixCounterType :: Var v => PrettyPrintEnv -> Type v a -> PrintAnnotation
@@ -1082,7 +1137,7 @@ countTypeUsages :: (Var v, Ord v) => PrettyPrintEnv -> Type v a -> PrintAnnotati
 countTypeUsages n t = snd $ annotation $ reannotateUp (suffixCounterType n) t
 
 countPatternUsages :: PrettyPrintEnv -> Pattern loc -> PrintAnnotation
-countPatternUsages n p = Pattern.foldMap' f p
+countPatternUsages n = Pattern.foldMap' f
   where
     f = \case
       Pattern.Unbound _ -> mempty
@@ -1095,7 +1150,7 @@ countPatternUsages n p = Pattern.foldMap' f p
       Pattern.Char _ _ -> mempty
       Pattern.As _ _ -> mempty
       Pattern.SequenceLiteral _ _ -> mempty
-      Pattern.SequenceOp _ _ _ _ -> mempty
+      Pattern.SequenceOp {} -> mempty
       Pattern.EffectPure _ _ -> mempty
       Pattern.EffectBind _ r _ _ -> countHQ $ PrettyPrintEnv.patternName n r
       Pattern.Constructor _ r _ ->
@@ -1104,7 +1159,7 @@ countPatternUsages n p = Pattern.foldMap' f p
           else countHQ $ PrettyPrintEnv.patternName n r
 
 countHQ :: HQ.HashQualified Name -> PrintAnnotation
-countHQ hq = fold $ fmap countName (HQ.toName $ hq)
+countHQ hq = foldMap countName (HQ.toName hq)
 
 countName :: Name -> PrintAnnotation
 countName n =
@@ -1119,7 +1174,7 @@ joinName :: Prefix -> Suffix -> Name
 joinName p s = Name.unsafeFromText $ dotConcat $ p ++ [s]
 
 dotConcat :: [Text] -> Text
-dotConcat = Text.concat . (intersperse ".")
+dotConcat = Text.concat . intersperse "."
 
 -- This predicate is used to keep certain refs out of the FQN elision annotations,
 -- so that we don't get `use` statements for them.
@@ -1132,13 +1187,12 @@ dotConcat = Text.concat . (intersperse ".")
 -- unnecessary use statements above Doc literals and termLink/typeLink.
 noImportRefs :: Reference -> Bool
 noImportRefs r =
-  elem
-    r
-    [ DD.pairRef,
-      DD.unitRef,
-      DD.docRef,
-      DD.linkRef
-    ]
+  r
+    `elem` [ DD.pairRef,
+             DD.unitRef,
+             DD.docRef,
+             DD.linkRef
+           ]
 
 infixl 0 |>
 
@@ -1177,8 +1231,8 @@ calcImports im tm = (im', render $ getUses result)
     -- Keep only names P.S where there is no other Q with Q.S also used in this scope.
     uniqueness :: Map Suffix (Map Prefix Int) -> Map Suffix (Prefix, Int)
     uniqueness m =
-      m |> Map.filter (\ps -> (Map.size ps) == 1)
-        |> Map.map (\ps -> head $ Map.toList ps)
+      m |> Map.filter (\ps -> Map.size ps == 1)
+        |> Map.map (head . Map.toList)
     -- Keep only names where the number of usages in this scope
     --   - is > 1, or
     --   - is 1, and S is an infix operator.
@@ -1189,12 +1243,12 @@ calcImports im tm = (im', render $ getUses result)
 
     enoughUsages :: Map Suffix (Prefix, Int) -> Map Suffix (Prefix, Int)
     enoughUsages m =
-      (Map.keys m)
+      Map.keys m
         |> filter
           ( \s ->
               let (p, i) = lookupOrDie s m
                in (i > 1 || isRight (symbolyId (unpack s)))
-                    && (length p > 0)
+                    && not (null p)
           )
         |> map (\s -> (s, lookupOrDie s m))
         |> Map.fromList
@@ -1234,7 +1288,7 @@ calcImports im tm = (im', render $ getUses result)
     avoidRepeatsAndClashes :: Map Name (Prefix, Suffix, Int) -> Map Name (Prefix, Suffix, Int)
     avoidRepeatsAndClashes = Map.filterWithKey $
       \n (_, s', _) -> case Map.lookup n im of
-        Just s -> (Text.length s') < (Text.length s)
+        Just s -> Text.length s' < Text.length s
         Nothing -> True
     -- Is there a strictly smaller block term underneath this one, containing all the usages
     -- of some of the names?  Skip emitting `use` statements for those, so we can do it
@@ -1254,10 +1308,10 @@ calcImports im tm = (im', render $ getUses result)
       let uses =
             Map.mapWithKey
               ( \p ss ->
-                  (fmt S.UseKeyword $ l "use ")
-                    <> (fmt S.UsePrefix (intercalateMap (l ".") (l . unpack) p))
+                  fmt S.UseKeyword (l "use ")
+                    <> fmt S.UsePrefix (intercalateMap (l ".") (l . unpack) p)
                     <> l " "
-                    <> (fmt S.UseSuffix (intercalateMap (l " ") (l . unpack) (Set.toList ss)))
+                    <> fmt S.UseSuffix (intercalateMap (l " ") (l . unpack) (Set.toList ss))
               )
               m
               |> Map.toList
@@ -1287,22 +1341,7 @@ allInSubBlock tm p s i =
   let found = concat $ ABT.find finder tm
       result = any (/= tm) found
       tr =
-        const id $
-          trace
-            ( "\nallInSubBlock("
-                ++ show p
-                ++ ", "
-                ++ show s
-                ++ ", "
-                ++ show i
-                ++ "): returns "
-                ++ show result
-                ++ "\nInput:\n"
-                ++ show tm
-                ++ "\nFound: \n"
-                ++ show found
-                ++ "\n\n"
-            )
+        id
    in tr result
   where
     getUsages t =
@@ -1319,27 +1358,18 @@ allInSubBlock tm p s i =
                   then ABT.Prune
                   else
                     let found = filter hit $ immediateChildBlockTerms t
-                     in if (i' == i) && (not $ null found)
+                     in if i' == i && not (null found)
                           then ABT.Found found
                           else ABT.Continue
-          children =
-            concat
-              ( map (\t -> "child: " ++ show t ++ "\n") $
-                  immediateChildBlockTerms t
-              )
+          -- children =
+          --   concatMap
+          --     (\t -> "child: " ++ show t ++ "\n")
+          --     ( immediateChildBlockTerms t
+          --     )
           tr =
-            const id $
-              trace
-                ( "\nfinder: returns "
-                    ++ show result
-                    ++ "\n  children:"
-                    ++ children
-                    ++ "\n  input: \n"
-                    ++ show t
-                    ++ "\n\n"
-                )
-       in tr $ result
-    hit t = (getUsages t) == i
+            id
+       in tr result
+    hit t = getUsages t == i
 
 -- Return any blockterms at or immediately under this term. Has to match the
 -- places in the syntax that get a call to `calcImports` in `pretty0`.
@@ -1401,7 +1431,7 @@ isDestructuringBind _ _ = False
 isBlock :: Ord v => Term2 vt at ap v a -> Bool
 isBlock tm =
   case tm of
-    If' _ _ _ -> True
+    If' {} -> True
     Handle' _ _ -> True
     Match' _ _ -> True
     LetBlock _ _ -> True
@@ -1494,7 +1524,7 @@ unLamsMatch' t = case unLamsUntilDelay' t of
   Just (reverse -> (v1 : vs), Match' (Var' v1') branches)
     | -- if `v1'` is referenced in any of the branches, we can't use lambda case
       -- syntax as we need to keep the `v1'` name that was introduced
-      (v1 == v1') && Set.notMember v1' (Set.unions $ freeVars <$> branches) ->
+      v1 == v1' && Set.notMember v1' (Set.unions $ freeVars <$> branches) ->
       Just (reverse vs, [([p], guard, body) | MatchCase p guard body <- branches])
   -- x y z -> match (x,y,z) with (pat1, pat2, pat3) -> ...
   --   becomes
@@ -1511,7 +1541,7 @@ unLamsMatch' t = case unLamsUntilDelay' t of
       Just (reverse (drop len vs), branches')
     where
       isRightArity (MatchCase (TuplePattern ps) _ _) = length ps == len
-      isRightArity (MatchCase {}) = False
+      isRightArity MatchCase {} = False
       len = length scrutes
       fvs = Set.unions $ freeVars <$> branches
       notFree v = Set.notMember v fvs
@@ -1524,8 +1554,8 @@ unLamsMatch' t = case unLamsUntilDelay' t of
     multiway (h : t) (Var' h2 : t2) | h == h2 = multiway t t2
     multiway _ _ = False
     freeVars (MatchCase _ g rhs) =
-      let guardVars = (fromMaybe Set.empty $ ABT.freeVars <$> g)
-          rhsVars = (ABT.freeVars rhs)
+      let guardVars = maybe Set.empty ABT.freeVars g
+          rhsVars = ABT.freeVars rhs
        in Set.union guardVars rhsVars
 
 pattern Bytes' :: [Word64] -> Term3 v PrintAnnotation
@@ -1540,137 +1570,159 @@ toBytes (App' (Builtin' "Bytes.fromList") (List' bs)) =
 toBytes _ = Nothing
 
 prettyDoc2 ::
-  forall v.
-  Var v =>
-  PrettyPrintEnv ->
+  forall v m.
+  MonadPretty v m =>
   AmbientContext ->
   Term3 v PrintAnnotation ->
-  Maybe (Pretty SyntaxText)
-prettyDoc2 ppe ac tm = case tm of
-  -- these patterns can introduce a {{ .. }} block
-  (toDocUntitledSection ppe -> Just _) -> Just . brace $ go 1 tm
-  (toDocSection ppe -> Just _) -> Just . brace $ go 1 tm
-  (toDocParagraph ppe -> Just _) -> Just . brace $ go 1 tm
-  _ -> Nothing
-  where
-    brace p =
-      fmt S.DocDelimiter "{{" <> PP.softbreak <> p <> PP.softbreak
-        <> fmt
-          S.DocDelimiter
-          "}}"
-    bail tm = brace (pretty0 ppe ac tm)
-    -- Finds the longest run of a character and return one bigger than that
-    longestRun c s =
-      case filter (\s -> take 2 s == [c, c]) $
-        group (PP.toPlainUnbroken $ PP.syntaxToColor s) of
-        [] -> 2
-        x -> 1 + (maximum $ map length x)
-    oneMore c inner = replicate (longestRun c inner) c
-    makeFence inner = PP.string $ replicate (max 3 $ longestRun '`' inner) '`'
-    go :: Width -> Term3 v PrintAnnotation -> Pretty SyntaxText
-    go hdr = \case
-      (toDocTransclude ppe -> Just d) ->
-        bail d
-      (toDocUntitledSection ppe -> Just ds) ->
-        sepBlankline ds
-      (toDocSection ppe -> Just (title, ds)) ->
-        PP.lines
-          [ PP.text (Text.replicate (PP.widthToInt hdr) "#") <> " " <> rec title,
-            "",
-            PP.indentN (hdr + 1) $ intercalateMap "\n\n" (go (hdr + 1)) ds
-          ]
-      (toDocParagraph ppe -> Just ds) ->
-        PP.wrap (mconcat (rec <$> ds))
-      (toDocBulletedList ppe -> Just ds) ->
-        PP.lines (item <$> ds)
-        where
-          item d = "* " <> (PP.indentAfterNewline "  " $ rec d)
-      (toDocNumberedList ppe -> Just (n, ds)) ->
-        PP.column2 (item <$> (zip [n ..] ds))
-        where
-          item (n, d) = (PP.group (PP.shown n <> "."), rec d)
-      (toDocWord ppe -> Just t) ->
-        PP.text t
-      (toDocCode ppe -> Just d) ->
-        let inner = rec d
-            quotes = PP.string $ oneMore '\'' inner
-         in PP.group $ quotes <> inner <> quotes
-      (toDocJoin ppe -> Just ds) ->
-        foldMap rec ds
-      (toDocItalic ppe -> Just d) ->
-        let inner = rec d
-            underscores = PP.string $ oneMore '_' inner
-         in PP.group $ underscores <> inner <> underscores
-      (toDocBold ppe -> Just d) ->
-        let inner = rec d
-            stars = PP.string $ oneMore '*' inner
-         in PP.group $ stars <> inner <> stars
-      (toDocStrikethrough ppe -> Just d) ->
-        let inner = rec d
-            quotes = PP.string $ oneMore '~' inner
-         in PP.group $ quotes <> inner <> quotes
-      (toDocGroup ppe -> Just d) ->
-        PP.group $ rec d
-      (toDocColumn ppe -> Just ds) ->
-        PP.lines (rec <$> ds)
-      (toDocNamedLink ppe -> Just (name, target)) ->
-        PP.group $ "[" <> rec name <> "](" <> rec target <> ")"
-      (toDocLink ppe -> Just e) -> PP.group $ case e of
-        Left r -> "{type " <> tyName r <> "}"
-        Right r -> "{" <> tmName r <> "}"
-      (toDocEval ppe -> Just tm) ->
-        let inner = pretty0 ppe ac tm
-            fence = makeFence inner
-         in PP.lines [fence, inner, fence]
-      (toDocEvalInline ppe -> Just tm) ->
-        "@eval{" <> pretty0 ppe ac tm <> "}"
-      (toDocExample ppe -> Just tm) ->
-        PP.group $ "``" <> pretty0 ppe ac tm <> "``"
-      (toDocExampleBlock ppe -> Just tm) ->
-        let inner = pretty0 ppe ac' tm
-            fence = makeFence inner
-         in PP.lines ["@typecheck " <> fence, inner, fence]
-        where
-          ac' = ac {elideUnit = True}
-      (toDocSource ppe -> Just es) ->
-        PP.group $ "    @source{" <> intercalateMap ", " go es <> "}"
-        where
-          go (Left r, _anns) = "type " <> tyName r
-          go (Right r, _anns) = tmName r
-      (toDocFoldedSource ppe -> Just es) ->
-        PP.group $ "    @foldedSource{" <> intercalateMap ", " go es <> "}"
-        where
-          go (Left r, _anns) = "type " <> tyName r
-          go (Right r, _anns) = tmName r
-      (toDocSignatureInline ppe -> Just tm) ->
-        PP.group $ "@inlineSignature{" <> tmName tm <> "}"
-      (toDocSignature ppe -> Just tms) ->
-        let name = if length tms == 1 then "@signature" else "@signatures"
-         in PP.group $ "    " <> name <> "{" <> intercalateMap ", " tmName tms <> "}"
-      (toDocCodeBlock ppe -> Just (typ, txt)) ->
-        let txt' = PP.text txt
-            fence = makeFence txt'
-         in PP.group $
+  m (Maybe (Pretty SyntaxText))
+prettyDoc2 ac tm = do
+  ppe <- getPPE
+  let brace p =
+        fmt S.DocDelimiter "{{" <> PP.softbreak <> p <> PP.softbreak
+          <> fmt
+            S.DocDelimiter
+            "}}"
+      bail tm = brace <$> pretty0 ac tm
+      -- Finds the longest run of a character and return one bigger than that
+      longestRun c s =
+        case filter (\s -> take 2 s == [c, c]) $
+          group (PP.toPlainUnbroken $ PP.syntaxToColor s) of
+          [] -> 2
+          x -> 1 + maximum (map length x)
+      oneMore c inner = replicate (longestRun c inner) c
+      makeFence inner = PP.string $ replicate (max 3 $ longestRun '`' inner) '`'
+      go :: Width -> Term3 v PrintAnnotation -> m (Pretty SyntaxText)
+      go hdr = \case
+        (toDocTransclude ppe -> Just d) ->
+          bail d
+        (toDocUntitledSection ppe -> Just ds) ->
+          sepBlankline ds
+        (toDocSection ppe -> Just (title, ds)) -> do
+          prettyTitle <- rec title
+          prettyDs <- intercalateMapM "\n\n" (go (hdr + 1)) ds
+          pure $
+            PP.lines
+              [ PP.text (Text.replicate (PP.widthToInt hdr) "#") <> " " <> prettyTitle,
+                "",
+                PP.indentN (hdr + 1) prettyDs
+              ]
+        (toDocParagraph ppe -> Just ds) ->
+          PP.wrap . mconcat <$> traverse rec ds
+        (toDocBulletedList ppe -> Just ds) -> do
+          PP.lines <$> traverse item ds
+          where
+            item d = ("* " <>) . PP.indentAfterNewline "  " <$> rec d
+        (toDocNumberedList ppe -> Just (n, ds)) ->
+          PP.column2 <$> traverse item (zip [n ..] ds)
+          where
+            item (n, d) = (PP.group (PP.shown n <> "."),) <$> rec d
+        (toDocWord ppe -> Just t) ->
+          pure $ PP.text t
+        (toDocCode ppe -> Just d) -> do
+          inner <- rec d
+          let quotes = PP.string $ oneMore '\'' inner
+          pure $ PP.group $ quotes <> inner <> quotes
+        (toDocJoin ppe -> Just ds) -> foldMapM rec ds
+        (toDocItalic ppe -> Just d) -> do
+          inner <- rec d
+          let underscores = PP.string $ oneMore '_' inner
+          pure $ PP.group $ underscores <> inner <> underscores
+        (toDocBold ppe -> Just d) -> do
+          inner <- rec d
+          let stars = PP.string $ oneMore '*' inner
+          pure $ PP.group $ stars <> inner <> stars
+        (toDocStrikethrough ppe -> Just d) -> do
+          inner <- rec d
+          let quotes = PP.string $ oneMore '~' inner
+          pure $ PP.group $ quotes <> inner <> quotes
+        (toDocGroup ppe -> Just d) ->
+          PP.group <$> rec d
+        (toDocColumn ppe -> Just ds) ->
+          PP.lines <$> traverse rec ds
+        (toDocNamedLink ppe -> Just (name, target)) ->
+          do
+            name' <- rec name
+            target' <- rec target
+            pure $ PP.group $ "[" <> name' <> "](" <> target' <> ")"
+        (toDocLink ppe -> Just e) -> pure . PP.group $ case e of
+          Left r -> "{type " <> tyName r <> "}"
+          Right r -> "{" <> tmName r <> "}"
+        (toDocEval ppe -> Just tm) ->
+          -- Old code:
+          -- let inner = ac tm
+          --     fence = makeFence inner
+          --  in PP.lines [fence, inner, fence]
+          -- New code:
+          do
+            inner <- rec tm
+            let fence = makeFence inner
+            pure $ PP.lines [fence, inner, fence]
+        (toDocEvalInline ppe -> Just tm) ->
+          do
+            inner <- pretty0 ac tm
+            pure $ "@eval{" <> inner <> "}"
+        (toDocExample ppe -> Just tm) ->
+          -- PP.group $ "``" <> pretty0 ac tm <> "``"
+          do
+            inner <- pretty0 ac tm
+            pure $ "``" <> inner <> "``"
+        (toDocExampleBlock ppe -> Just tm) ->
+          -- let inner = pretty0 ac' tm
+          --     fence = makeFence inner
+          --  in PP.lines ["@typecheck " <> fence, inner, fence]
+          do
+            inner <- pretty0 ac' tm
+            let fence = makeFence inner
+            pure $ PP.lines ["@typecheck " <> fence, inner, fence]
+          where
+            ac' = ac {elideUnit = True}
+        (toDocSource ppe -> Just es) ->
+          pure . PP.group $ "    @source{" <> intercalateMap ", " go es <> "}"
+          where
+            go (Left r, _anns) = "type " <> tyName r
+            go (Right r, _anns) = tmName r
+        (toDocFoldedSource ppe -> Just es) ->
+          pure . PP.group $ "    @foldedSource{" <> intercalateMap ", " go es <> "}"
+          where
+            go (Left r, _anns) = "type " <> tyName r
+            go (Right r, _anns) = tmName r
+        (toDocSignatureInline ppe -> Just tm) ->
+          pure . PP.group $ "@inlineSignature{" <> tmName tm <> "}"
+        (toDocSignature ppe -> Just tms) ->
+          let name = if length tms == 1 then "@signature" else "@signatures"
+           in pure . PP.group $ "    " <> name <> "{" <> intercalateMap ", " tmName tms <> "}"
+        (toDocCodeBlock ppe -> Just (typ, txt)) ->
+          pure $
+            let txt' = PP.text txt
+                fence = makeFence txt'
+             in PP.group $
+                  PP.lines
+                    [ fence <> " " <> PP.text typ,
+                      PP.group txt',
+                      fence
+                    ]
+        (toDocVerbatim ppe -> Just txt) ->
+          pure $
+            PP.group $
               PP.lines
-                [ fence <> " " <> PP.text typ,
-                  PP.group txt',
-                  fence
+                [ "'''",
+                  PP.group $ PP.text txt,
+                  "'''"
                 ]
-      (toDocVerbatim ppe -> Just txt) ->
-        PP.group $
-          PP.lines
-            [ "'''",
-              PP.group $ PP.text txt,
-              "'''"
-            ]
-      -- todo : emit fewer gratuitous columns, maybe a wrapIfMany combinator
-      tm -> bail tm
-      where
-        im = imports ac
-        tyName r = styleHashQualified'' (fmt $ S.TypeReference r) . elideFQN im $ PrettyPrintEnv.typeName ppe r
-        tmName r = styleHashQualified'' (fmt $ S.TermReference r) . elideFQN im $ PrettyPrintEnv.termName ppe r
-        rec = go hdr
-        sepBlankline = intercalateMap "\n\n" rec
+        -- todo : emit fewer gratuitous columns, maybe a wrapIfMany combinator
+        tm -> bail tm
+        where
+          im = imports ac
+          tyName r = styleHashQualified'' (fmt $ S.TypeReference r) . elideFQN im $ PrettyPrintEnv.typeName ppe r
+          tmName r = styleHashQualified'' (fmt $ S.TermReference r) . elideFQN im $ PrettyPrintEnv.termName ppe r
+          rec = go hdr
+          sepBlankline = intercalateMapM "\n\n" rec
+  case tm of
+    -- these patterns can introduce a {{ .. }} block
+    (toDocUntitledSection ppe -> Just _) -> Just . brace <$> go 1 tm
+    (toDocSection ppe -> Just _) -> Just . brace <$> go 1 tm
+    (toDocParagraph ppe -> Just _) -> Just . brace <$> go 1 tm
+    _ -> pure Nothing
 
 toDocJoin :: PrettyPrintEnv -> Term3 v PrintAnnotation -> Maybe [Term3 v PrintAnnotation]
 toDocJoin ppe (App' (Ref' r) (List' tms))
@@ -1805,8 +1857,8 @@ toDocSourceElement ppe (Apps' (Ref' r) [tm, toDocSourceAnnotations ppe -> Just a
     (,annotations) <$> ok tm
   where
     ok tm =
-      (Right <$> toDocEmbedTermLink ppe tm)
-        <|> (Left <$> toDocEmbedTypeLink ppe tm)
+      Right <$> toDocEmbedTermLink ppe tm
+        <|> Left <$> toDocEmbedTypeLink ppe tm
 toDocSourceElement _ _ = Nothing
 
 toDocSource' ::
diff --git a/parser-typechecker/src/Unison/Syntax/TypePrinter.hs b/parser-typechecker/src/Unison/Syntax/TypePrinter.hs
index 88a80aa75..19272baba 100644
--- a/parser-typechecker/src/Unison/Syntax/TypePrinter.hs
+++ b/parser-typechecker/src/Unison/Syntax/TypePrinter.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Unison.Syntax.TypePrinter
   ( pretty,
@@ -23,6 +24,7 @@ import Unison.Prelude
 import Unison.PrettyPrintEnv (PrettyPrintEnv)
 import qualified Unison.PrettyPrintEnv as PrettyPrintEnv
 import Unison.PrettyPrintEnv.FQN (Imports, elideFQN)
+import Unison.PrettyPrintEnv.MonadPretty (MonadPretty, getPPE, runPretty, willCapture)
 import Unison.Reference (Reference, pattern Builtin)
 import Unison.Referent (Referent)
 import Unison.Syntax.NamePrinter (styleHashQualified'')
@@ -36,17 +38,17 @@ import qualified Unison.Var as Var
 
 type SyntaxText = S.SyntaxText' Reference
 
-pretty :: forall v a. (Var v) => PrettyPrintEnv -> Type v a -> Pretty ColorText
-pretty ppe = PP.syntaxToColor . prettySyntax ppe
+pretty :: Var v => PrettyPrintEnv -> Type v a -> Pretty ColorText
+pretty ppe t = PP.syntaxToColor $ prettySyntax ppe t
 
-prettySyntax :: forall v a. (Var v) => PrettyPrintEnv -> Type v a -> Pretty SyntaxText
-prettySyntax ppe = pretty0 ppe mempty (-1)
+prettySyntax :: Var v => PrettyPrintEnv -> Type v a -> Pretty SyntaxText
+prettySyntax ppe = runPretty ppe . pretty0 Map.empty (-1)
 
 prettyStr :: Var v => Maybe Width -> PrettyPrintEnv -> Type v a -> String
-prettyStr (Just width) n t =
-  toPlain $ PP.render width $ PP.syntaxToColor $ pretty0 n Map.empty (-1) t
-prettyStr Nothing n t =
-  toPlain $ PP.render maxBound $ PP.syntaxToColor $ pretty0 n Map.empty (-1) t
+prettyStr (Just width) ppe t =
+  toPlain . PP.render width . PP.syntaxToColor . runPretty ppe $ pretty0 Map.empty (-1) t
+prettyStr Nothing ppe t =
+  toPlain . PP.render maxBound . PP.syntaxToColor . runPretty ppe $ pretty0 Map.empty (-1) t
 
 {- Explanation of precedence handling
 
@@ -71,90 +73,103 @@ prettyStr Nothing n t =
 -}
 
 pretty0 ::
-  forall v a.
-  (Var v) =>
-  PrettyPrintEnv ->
+  forall v a m.
+  MonadPretty v m =>
   Imports ->
   Int ->
   Type v a ->
-  Pretty SyntaxText
-pretty0 n im p tp = prettyRaw n im p (cleanup (removePureEffects tp))
+  m (Pretty SyntaxText)
+pretty0 im p tp = prettyRaw im p (cleanup (removePureEffects tp))
 
 prettyRaw ::
-  forall v a.
-  (Var v) =>
-  PrettyPrintEnv ->
+  forall v a m.
+  MonadPretty v m =>
   Imports ->
   Int ->
   Type v a ->
-  Pretty SyntaxText
+  m (Pretty SyntaxText)
 -- p is the operator precedence of the enclosing context (a number from 0 to
 -- 11, or -1 to avoid outer parentheses unconditionally).  Function
 -- application has precedence 10.
-prettyRaw n im p tp = go n im p tp
+prettyRaw im p tp = go im p tp
   where
-    go :: PrettyPrintEnv -> Imports -> Int -> Type v a -> Pretty SyntaxText
-    go n im p tp = case stripIntroOuters tp of
-      Var' v -> fmt S.Var $ PP.text (Var.name v)
-      DD.TupleType' xs | length xs /= 1 -> PP.parenthesizeCommas $ map (go n im 0) xs
+    go :: Imports -> Int -> Type v a -> m (Pretty SyntaxText)
+    go im p tp = case stripIntroOuters tp of
+      Var' v -> pure . fmt S.Var $ PP.text (Var.name v)
+      DD.TupleType' xs | length xs /= 1 -> PP.parenthesizeCommas <$> traverse (go im 0) xs
       -- Would be nice to use a different SyntaxHighlights color if the reference is an ability.
-      Ref' r -> styleHashQualified'' (fmt $ S.TypeReference r) $ elideFQN im (PrettyPrintEnv.typeName n r)
-      Cycle' _ _ -> fromString "error: TypeParser does not currently emit Cycle"
-      Abs' _ -> fromString "error: TypeParser does not currently emit Abs"
-      Ann' _ _ -> fromString "error: TypeParser does not currently emit Ann"
-      App' (Ref' (Builtin "Sequence")) x ->
-        PP.group $ (fmt S.DelimiterChar "[") <> go n im (-1) x <> (fmt S.DelimiterChar "]")
+      Ref' r -> do
+        n <- getPPE
+        pure $ styleHashQualified'' (fmt $ S.TypeReference r) $ elideFQN im (PrettyPrintEnv.typeName n r)
+      Cycle' _ _ -> pure $ fromString "bug: TypeParser does not currently emit Cycle"
+      Abs' _ -> pure $ fromString "bug: TypeParser does not currently emit Abs"
+      Ann' _ _ -> pure $ fromString "bug: TypeParser does not currently emit Ann"
+      App' (Ref' (Builtin "Sequence")) x -> do
+        x' <- go im (-1) x
+        pure $ PP.group $ fmt S.DelimiterChar "[" <> x' <> fmt S.DelimiterChar "]"
       Apps' f xs ->
-        PP.parenthesizeIf (p >= 10) $
-          go n im 9 f
-            `PP.hang` PP.spaced
-              (go n im 10 <$> xs)
+        PP.parenthesizeIf (p >= 10)
+          <$> ( PP.hang <$> go im 9 f <*> (PP.spaced <$> traverse (go im 10) xs)
+              )
       Effect1' e t ->
-        PP.parenthesizeIf (p >= 10) $ go n im 9 e <> " " <> go n im 10 t
+        PP.parenthesizeIf (p >= 10) <$> ((\x y -> x <> " " <> y) <$> go im 9 e <*> go im 10 t)
       Effects' es -> effects (Just es)
       ForallsNamed' vs' body ->
         let vs = filter (\v -> Var.name v /= "()") vs'
-         in if p < 0 && all Var.universallyQuantifyIfFree vs
-              then go n im p body
-              else
-                paren (p >= 0) $
-                  let vformatted = PP.sep " " (fmt S.Var . PP.text . Var.name <$> vs)
-                   in (fmt S.TypeOperator "∀ " <> vformatted <> fmt S.TypeOperator ".")
-                        `PP.hang` go n im (-1) body
+            prettyForall p = do
+              let vformatted = PP.sep " " (fmt S.Var . PP.text . Var.name <$> vs)
+              PP.hang (fmt S.TypeOperator "∀ " <> vformatted <> fmt S.TypeOperator ".") <$> go im p body
+         in -- if we're printing a type signature, and all the type variables
+            -- are universally quantified, then we can omit the `forall` keyword
+            -- only if the type variables are not bound in an outer scope
+            if p < 0 && all Var.universallyQuantifyIfFree vs
+              then ifM (willCapture vs) (prettyForall p) (go im p body)
+              else paren (p >= 0) <$> prettyForall (-1)
       t@(Arrow' _ _) -> case t of
         EffectfulArrows' (Ref' DD.UnitRef) rest ->
-          PP.parenthesizeIf (p >= 10) $ arrows True True rest
+          PP.parenthesizeIf (p >= 10) <$> arrows True True rest
         EffectfulArrows' fst rest ->
           case fst of
             Var' v
               | Var.name v == "()" ->
-                PP.parenthesizeIf (p >= 10) $ arrows True True rest
+                PP.parenthesizeIf (p >= 10) <$> arrows True True rest
             _ ->
-              PP.parenthesizeIf (p >= 0) $
-                go n im 0 fst <> arrows False False rest
-        _ -> "error"
-      _ -> "error"
-    effects Nothing = mempty
-    effects (Just es) = PP.group $ fmt S.AbilityBraces "{" <> PP.commas (go n im 0 <$> es) <> (fmt S.AbilityBraces "}")
+              PP.parenthesizeIf (p >= 0)
+                <$> ((<>) <$> go im 0 fst <*> arrows False False rest)
+        _ -> pure . fromString $ "bug: unexpected Arrow form in prettyRaw: " <> show t
+      _ -> pure . fromString $ "bug: unexpected form in prettyRaw: " <> show tp
+    effects Nothing = pure mempty
+    effects (Just es) =
+      PP.group . (fmt S.AbilityBraces "{" <>) . (<> fmt S.AbilityBraces "}")
+        <$> (PP.commas <$> traverse (go im 0) es)
     -- `first`: is this the first argument?
     -- `mes`: list of effects
-    arrow delay first mes =
-      (if first then mempty else PP.softbreak <> fmt S.TypeOperator "->")
-        <> (if delay then (if first then fmt S.DelayForceChar "'" else fmt S.DelayForceChar " '") else mempty)
-        <> effects mes
-        <> if isJust mes || not delay && not first then " " else mempty
+    arrow delay first mes = do
+      es <- effects mes
+      pure $
+        (if first then mempty else PP.softbreak <> fmt S.TypeOperator "->")
+          <> (if delay then (if first then fmt S.DelayForceChar "'" else fmt S.DelayForceChar " '") else mempty)
+          <> es
+          <> if isJust mes || not delay && not first then " " else mempty
 
-    arrows delay first [(mes, Ref' DD.UnitRef)] = arrow delay first mes <> fmt S.Unit "()"
-    arrows delay first ((mes, Ref' DD.UnitRef) : rest) =
-      arrow delay first mes <> parenNoGroup delay (arrows True True rest)
-    arrows delay first ((mes, arg) : rest) =
-      arrow delay first mes
-        <> parenNoGroup
-          (delay && not (null rest))
-          (go n im 0 arg <> arrows False False rest)
-    arrows False False [] = mempty
-    arrows False True [] = mempty -- not reachable
-    arrows True _ [] = mempty -- not reachable
+    arrows ::
+      Bool ->
+      Bool ->
+      [(Maybe [Type v a], Type v a)] ->
+      m (Pretty SyntaxText)
+    arrows delay first [(mes, Ref' DD.UnitRef)] = (<> fmt S.Unit "()") <$> arrow delay first mes
+    arrows delay first ((mes, Ref' DD.UnitRef) : rest) = do
+      es <- arrow delay first mes
+      rest' <- arrows True True rest
+      pure $ es <> parenNoGroup delay rest'
+    arrows delay first ((mes, arg) : rest) = do
+      es <- arrow delay first mes
+      arg' <- go im 0 arg
+      rest' <- arrows False False rest
+      pure $ es <> parenNoGroup (delay && not (null rest)) (arg' <> rest')
+    arrows False False [] = pure mempty
+    arrows False True [] = pure mempty -- not reachable
+    arrows True _ [] = pure mempty -- not reachable
     paren True s = PP.group $ fmt S.Parenthesis "(" <> s <> fmt S.Parenthesis ")"
     paren False s = PP.group s
 
@@ -166,61 +181,62 @@ fmt = PP.withSyntax
 
 -- todo: provide sample output in comment
 prettySignaturesCT ::
-  Var v =>
-  PrettyPrintEnv ->
+  MonadPretty v m =>
   [(Referent, HashQualified Name, Type v a)] ->
-  [Pretty ColorText]
-prettySignaturesCT env ts = map PP.syntaxToColor $ prettySignaturesST env ts
+  m [Pretty ColorText]
+prettySignaturesCT ts = map PP.syntaxToColor <$> prettySignaturesST ts
 
 prettySignaturesCTCollapsed ::
-  Var v =>
-  PrettyPrintEnv ->
+  MonadPretty v m =>
   [(Referent, HashQualified Name, Type v a)] ->
-  Pretty ColorText
-prettySignaturesCTCollapsed env ts =
-  PP.lines $
-    PP.group <$> prettySignaturesCT env ts
+  m (Pretty ColorText)
+prettySignaturesCTCollapsed ts =
+  PP.lines
+    . map PP.group
+    <$> prettySignaturesCT ts
 
 prettySignaturesST ::
-  Var v =>
-  PrettyPrintEnv ->
+  MonadPretty v m =>
   [(Referent, HashQualified Name, Type v a)] ->
-  [Pretty SyntaxText]
-prettySignaturesST env ts =
-  PP.align [(name r hq, sig typ) | (r, hq, typ) <- ts]
+  m [Pretty SyntaxText]
+prettySignaturesST ts =
+  PP.align <$> traverse (\(r, hq, typ) -> (name r hq,) <$> sig typ) ts
   where
     name r hq =
       styleHashQualified'' (fmt $ S.TermReference r) hq
-    sig typ =
-      (fmt S.TypeAscriptionColon ": " <> pretty0 env Map.empty (-1) typ)
-        `PP.orElse` (fmt S.TypeAscriptionColon ": " <> PP.indentNAfterNewline 2 (pretty0 env Map.empty (-1) typ))
+    sig typ = do
+      t <- pretty0 Map.empty (-1) typ
+      let col = fmt S.TypeAscriptionColon ": "
+      pure $ (col <> t) `PP.orElse` (col <> PP.indentNAfterNewline 2 t)
 
 -- todo: provide sample output in comment; different from prettySignatures'
 prettySignaturesAlt' ::
-  Var v =>
-  PrettyPrintEnv ->
+  forall a v m.
+  MonadPretty v m =>
   [([HashQualified Name], Type v a)] ->
-  [Pretty ColorText]
-prettySignaturesAlt' env ts =
-  map PP.syntaxToColor $
-    PP.align
-      [ ( PP.commas . fmap (\name -> styleHashQualified'' (fmt $ S.HashQualifier name) name) $ names,
-          (fmt S.TypeAscriptionColon ": " <> pretty0 env Map.empty (-1) typ)
-            `PP.orElse` ( fmt S.TypeAscriptionColon ": "
-                            <> PP.indentNAfterNewline 2 (pretty0 env Map.empty (-1) typ)
-                        )
+  m [Pretty ColorText]
+prettySignaturesAlt' ts =
+  do
+    ts' <- traverse f ts
+    pure $ map PP.syntaxToColor $ PP.align ts'
+  where
+    f :: ([HashQualified Name], Type v a) -> m (Pretty SyntaxText, Pretty SyntaxText)
+    f (names, typ) = do
+      typ' <- pretty0 Map.empty (-1) typ
+      let col = fmt S.TypeAscriptionColon ": "
+      pure
+        ( PP.commas . fmap (\name -> styleHashQualified'' (fmt $ S.HashQualifier name) name) $ names,
+          (col <> typ') `PP.orElse` (col <> PP.indentNAfterNewline 2 typ')
         )
-        | (names, typ) <- ts
-      ]
 
--- prettySignatures'' :: Var v => PrettyPrintEnv -> [(Name, Type v a)] -> [Pretty ColorText]
+-- prettySignatures'' :: Var v => [(Name, Type v a)] -> [Pretty ColorText]
 -- prettySignatures'' env ts = prettySignatures' env (first HQ.fromName <$> ts)
 
 prettySignaturesAlt ::
-  Var v =>
-  PrettyPrintEnv ->
+  MonadPretty v m =>
   [([HashQualified Name], Type v a)] ->
-  Pretty ColorText
-prettySignaturesAlt env ts =
-  PP.lines $
-    PP.group <$> prettySignaturesAlt' env ts
+  m (Pretty ColorText)
+prettySignaturesAlt ts =
+  PP.lines
+    . map PP.group
+    <$> prettySignaturesAlt' ts
diff --git a/parser-typechecker/src/Unison/Typechecker/Context.hs b/parser-typechecker/src/Unison/Typechecker/Context.hs
index 527f388f6..65685e385 100644
--- a/parser-typechecker/src/Unison/Typechecker/Context.hs
+++ b/parser-typechecker/src/Unison/Typechecker/Context.hs
@@ -326,13 +326,13 @@ removeSyntheticTypeVars typ =
     go v
       | Var.User _ <- Var.typeOf v = pure v -- user-provided type variables left alone
       | otherwise = do
-          (used, curMappings) <- get
-          case Map.lookup v curMappings of
-            Nothing -> do
-              let v' = pickName used (Var.typeOf v)
-              put (Set.insert v' used, Map.insert v v' curMappings)
-              pure v'
-            Just v' -> pure v'
+        (used, curMappings) <- get
+        case Map.lookup v curMappings of
+          Nothing -> do
+            let v' = pickName used (Var.typeOf v)
+            put (Set.insert v' used, Map.insert v v' curMappings)
+            pure v'
+          Just v' -> pure v'
     pickName used vt = ABT.freshIn used . Var.named $ case vt of
       -- for each type of variable, we have some preferred variable
       -- names that we like, if they aren't already being used
@@ -671,21 +671,21 @@ extend' e c@(Context ctx) = Context . (: ctx) . (e,) <$> i'
         | Set.member v vs -> crash $ "variable " <> show v <> " already defined in the context"
         | not (wellformedType c t) -> crash $ "type " <> show t <> " is not well-formed wrt the context"
         | otherwise ->
-            pure $
-              Info (Set.insert v es) (Map.insert v sa ses) us uas (Set.insert v vs) pvs
+          pure $
+            Info (Set.insert v es) (Map.insert v sa ses) us uas (Set.insert v vs) pvs
       -- VarCtx - ensure `v` is fresh, and annotation is well-formed wrt the context
       Ann v t
         | Set.member v vs -> crash $ "variable " <> show v <> " already defined in the context"
         | not (wellformedType c t) -> crash $ "type " <> show t <> " is not well-formed wrt the context"
         | otherwise ->
-            pure $
-              Info
-                es
-                ses
-                us
-                (Map.insert v t uas)
-                (Set.insert v vs)
-                ((if Set.null (Type.freeVars t) then Set.insert v else id) pvs)
+          pure $
+            Info
+              es
+              ses
+              us
+              (Map.insert v t uas)
+              (Set.insert v vs)
+              ((if Set.null (Type.freeVars t) then Set.insert v else id) pvs)
       -- MarkerCtx - note that since a Marker is always the first mention of a variable, suffices to
       -- just check that `v` is not previously mentioned
       Marker v ->
@@ -874,7 +874,7 @@ synthesizeApp ::
   M v loc (Type v loc, Wanted v loc)
 synthesizeApp _ ft arg
   | debugEnabled && traceShow ("synthesizeApp" :: String, ft, arg) False =
-      undefined
+    undefined
 synthesizeApp fun (Type.stripIntroOuters -> Type.Effect'' es ft) argp@(arg, argNum) =
   scope (InSynthesizeApp ft arg argNum) $ do
     (t, w) <- go ft
@@ -1051,10 +1051,10 @@ synthesizeWanted (Term.Ann' (Term.Ref' _) t)
   --
   -- Top level references don't have their own effects.
   | Set.null s = do
-      t <- existentializeArrows t
-      -- See note about ungeneralizing above in the Var case.
-      t <- ungeneralize t
-      pure (discard t, [])
+    t <- existentializeArrows t
+    -- See note about ungeneralizing above in the Var case.
+    t <- ungeneralize t
+    pure (discard t, [])
   | otherwise = compilerCrash $ FreeVarsInTypeAnnotation s
   where
     s = ABT.freeVars t
@@ -1158,59 +1158,59 @@ synthesizeWanted e
   | Term.TermLink' _ <- e = pure (Type.termLink l, [])
   | Term.TypeLink' _ <- e = pure (Type.typeLink l, [])
   | Term.Blank' blank <- e = do
-      v <- freshenVar Var.blank
-      appendContext [Var (TypeVar.Existential blank v)]
-      pure (existential' l blank v, [])
+    v <- freshenVar Var.blank
+    appendContext [Var (TypeVar.Existential blank v)]
+    pure (existential' l blank v, [])
   | Term.List' v <- e = do
-      ft <- vectorConstructorOfArity l (Foldable.length v)
-      case Foldable.toList v of
-        [] -> pure (ft, [])
-        v1 : _ ->
-          scope (InVectorApp (ABT.annotation v1)) $
-            synthesizeApps e ft v
+    ft <- vectorConstructorOfArity l (Foldable.length v)
+    case Foldable.toList v of
+      [] -> pure (ft, [])
+      v1 : _ ->
+        scope (InVectorApp (ABT.annotation v1)) $
+          synthesizeApps e ft v
 
   -- ->I=> (Full Damas Milner rule)
   | Term.Lam' body <- e = do
-      -- arya: are there more meaningful locations we could put into and
-      -- pull out of the abschain?)
-      [arg, i, e, o] <-
-        sequence
-          [ ABT.freshen body freshenVar,
-            freshenVar (ABT.variable body),
-            freshenVar Var.inferAbility,
-            freshenVar Var.inferOutput
-          ]
-      let it = existential' l B.Blank i
-          ot = existential' l B.Blank o
-          et = existential' l B.Blank e
-      appendContext $
-        [existential i, existential e, existential o, Ann arg it]
-      body' <- pure $ ABT.bindInheritAnnotation body (Term.var () arg)
-      if Term.isLam body'
-        then checkWithAbilities [] body' ot
-        else checkWithAbilities [et] body' ot
-      ctx <- getContext
-      let t = apply ctx $ Type.arrow l it (Type.effect l [et] ot)
-      pure (t, [])
+    -- arya: are there more meaningful locations we could put into and
+    -- pull out of the abschain?)
+    [arg, i, e, o] <-
+      sequence
+        [ ABT.freshen body freshenVar,
+          freshenVar (ABT.variable body),
+          freshenVar Var.inferAbility,
+          freshenVar Var.inferOutput
+        ]
+    let it = existential' l B.Blank i
+        ot = existential' l B.Blank o
+        et = existential' l B.Blank e
+    appendContext $
+      [existential i, existential e, existential o, Ann arg it]
+    body' <- pure $ ABT.bindInheritAnnotation body (Term.var () arg)
+    if Term.isLam body'
+      then checkWithAbilities [] body' ot
+      else checkWithAbilities [et] body' ot
+    ctx <- getContext
+    let t = apply ctx $ Type.arrow l it (Type.effect l [et] ot)
+    pure (t, [])
   | Term.If' cond t f <- e = do
-      cwant <- scope InIfCond $ check cond (Type.boolean l)
-      (ty, bwant) <-
-        scope (InIfBody $ ABT.annotation t) $
-          synthesizeApps e (Type.iff2 l) [t, f]
-      (ty,) <$> coalesceWanted bwant cwant
+    cwant <- scope InIfCond $ check cond (Type.boolean l)
+    (ty, bwant) <-
+      scope (InIfBody $ ABT.annotation t) $
+        synthesizeApps e (Type.iff2 l) [t, f]
+    (ty,) <$> coalesceWanted bwant cwant
   | Term.And' a b <- e =
-      scope InAndApp $ synthesizeApps e (Type.andor' l) [a, b]
+    scope InAndApp $ synthesizeApps e (Type.andor' l) [a, b]
   | Term.Or' a b <- e =
-      scope InOrApp $ synthesizeApps e (Type.andor' l) [a, b]
+    scope InOrApp $ synthesizeApps e (Type.andor' l) [a, b]
   | Term.Match' scrutinee cases <- e = do
-      (scrutineeType, swant) <- synthesize scrutinee
-      outputTypev <- freshenVar (Var.named "match-output")
-      let outputType = existential' l B.Blank outputTypev
-      appendContext [existential outputTypev]
-      cwant <- checkCases scrutineeType outputType cases
-      want <- coalesceWanted cwant swant
-      ctx <- getContext
-      pure $ (apply ctx outputType, want)
+    (scrutineeType, swant) <- synthesize scrutinee
+    outputTypev <- freshenVar (Var.named "match-output")
+    let outputType = existential' l B.Blank outputTypev
+    appendContext [existential outputTypev]
+    cwant <- checkCases scrutineeType outputType cases
+    want <- coalesceWanted cwant swant
+    ctx <- getContext
+    pure $ (apply ctx outputType, want)
   where
     l = loc e
 synthesizeWanted _e = compilerCrash PatternMatchFailure
@@ -1427,17 +1427,17 @@ checkPattern scrutineeType p =
       -- 'otherwise' still needs to be covered for exhaustivity, however.
       | Type.Apps' (Type.Ref' req) [_, r] <- scrutineeType,
         req == Type.effectRef ->
-          checkPattern r p
+        checkPattern r p
       | otherwise -> do
-          vt <- lift $ do
-            v <- freshenVar Var.inferPatternPureV
-            e <- freshenVar Var.inferPatternPureE
-            let vt = existentialp loc v
-            let et = existentialp loc e
-            appendContext [existential v, existential e]
-            subtype (Type.effectV loc (loc, et) (loc, vt)) scrutineeType
-            applyM vt
-          checkPattern vt p
+        vt <- lift $ do
+          v <- freshenVar Var.inferPatternPureV
+          e <- freshenVar Var.inferPatternPureE
+          let vt = existentialp loc v
+          let et = existentialp loc e
+          appendContext [existential v, existential e]
+          subtype (Type.effectV loc (loc, et) (loc, vt)) scrutineeType
+          applyM vt
+        checkPattern vt p
     -- ex: { Stream.emit x -> k } -> ...
     Pattern.EffectBind loc ref args k -> do
       -- scrutineeType should be a supertype of `Effect e vt`
@@ -1460,15 +1460,15 @@ checkPattern scrutineeType p =
         Type.Effect'' [et] it
           -- expecting scrutineeType to be `Effect et vt`
           | Type.Apps' _ [eff, vt] <- st -> do
-              -- ensure that the variables in `et` unify with those from
-              -- the scrutinee.
-              lift $ abilityCheck' [eff] [et]
-              let kt =
-                    Type.arrow
-                      (Pattern.loc k)
-                      it
-                      (Type.effect (Pattern.loc k) [eff] vt)
-              (vs ++) <$> checkPattern kt k
+            -- ensure that the variables in `et` unify with those from
+            -- the scrutinee.
+            lift $ abilityCheck' [eff] [et]
+            let kt =
+                  Type.arrow
+                    (Pattern.loc k)
+                    it
+                    (Type.effect (Pattern.loc k) [eff] vt)
+            (vs ++) <$> checkPattern kt k
           | otherwise -> lift . compilerCrash $ PatternMatchFailure
         _ ->
           lift . compilerCrash $
@@ -1646,12 +1646,12 @@ tweakEffects ::
   M v loc ([v], Type v loc)
 tweakEffects v0 t0
   | isEffectVar v0 t0 && isVariant v0 t0 =
-      rewrite (Just False) t0 >>= \case
-        ([], ty) ->
-          freshenTypeVar v0 >>= \out -> finish [out] ty
-        (vs, ty) -> finish vs ty
+    rewrite (Just False) t0 >>= \case
+      ([], ty) ->
+        freshenTypeVar v0 >>= \out -> finish [out] ty
+      (vs, ty) -> finish vs ty
   | otherwise =
-      freshenTypeVar v0 >>= \out -> finish [out] t0
+    freshenTypeVar v0 >>= \out -> finish [out] t0
   where
     negative = fromMaybe False
 
@@ -1665,27 +1665,27 @@ tweakEffects v0 t0
     rewrite p ty
       | Type.ForallNamed' v t <- ty,
         v0 /= v =
-          second (Type.forall a v) <$> rewrite p t
+        second (Type.forall a v) <$> rewrite p t
       | Type.Arrow' i o <- ty = do
-          (vis, i) <- rewrite (not <$> p) i
-          (vos, o) <- rewrite p o
-          pure (vis ++ vos, Type.arrow a i o)
+        (vis, i) <- rewrite (not <$> p) i
+        (vos, o) <- rewrite p o
+        pure (vis ++ vos, Type.arrow a i o)
       | Type.Effect1' e t <- ty = do
-          (ves, e) <- rewrite p e
-          (vts, t) <- rewrite p t
-          pure (ves ++ vts, Type.effect1 a e t)
+        (ves, e) <- rewrite p e
+        (vts, t) <- rewrite p t
+        pure (ves ++ vts, Type.effect1 a e t)
       | Type.Effects' es <- ty = do
-          ess <- traverse (rewrite p) es
-          let es = snd <$> ess; ves = fst =<< ess
-          pure (ves, Type.effects a es)
+        ess <- traverse (rewrite p) es
+        let es = snd <$> ess; ves = fst =<< ess
+        pure (ves, Type.effects a es)
       | Type.Var' v <- ty,
         v0 == v && negative p = do
-          u <- freshenTypeVar v0
-          pure ([u], existential' (loc ty) B.Blank u)
+        u <- freshenTypeVar v0
+        pure ([u], existential' (loc ty) B.Blank u)
       | Type.App' f x <- ty = do
-          (vfs, f) <- rewrite p f
-          (vxs, x) <- rewrite Nothing x
-          pure (vfs ++ vxs, Type.app (loc ty) f x)
+        (vfs, f) <- rewrite p f
+        (vxs, x) <- rewrite Nothing x
+        pure (vfs ++ vxs, Type.app (loc ty) f x)
       | otherwise = pure ([], ty)
       where
         a = loc ty
@@ -1759,7 +1759,7 @@ generalizeExistentials ctx ty0 = generalizeP pred ctx ty
     pred e
       | pe@(Just (tv, _)) <- existentialP e,
         tv `Set.member` fvs =
-          pe
+        pe
       | otherwise = Nothing
 
 generalizeP ::
@@ -1775,13 +1775,13 @@ generalizeP p ctx0 ty = foldr gen (applyCtx ctx0 ty) ctx
 
     gen (tv, v) t
       | tv `ABT.isFreeIn` t =
-          -- location of the forall is just the location of the input type
-          -- and the location of each quantified variable is just inherited
-          -- from its source location
-          Type.forall
-            (loc t)
-            (TypeVar.Universal v)
-            (ABT.substInheritAnnotation tv (universal' () v) t)
+        -- location of the forall is just the location of the input type
+        -- and the location of each quantified variable is just inherited
+        -- from its source location
+        Type.forall
+          (loc t)
+          (TypeVar.Universal v)
+          (ABT.substInheritAnnotation tv (universal' () v) t)
       -- don't bother introducing a forall if type variable is unused
       | otherwise = t
 
@@ -1867,20 +1867,20 @@ coalesceWanted' ::
 coalesceWanted' _ [] old = pure old
 coalesceWanted' keep ((loc, n) : new) old
   | Just (_, o) <- find (headMatch n . snd) old = do
-      equate n o
-      coalesceWanted new old
+    equate n o
+    coalesceWanted new old
   | Type.Var' u <- n = do
-      (new, old) <-
-        -- Only add existential variables to the wanted list if they
-        -- occur in a type we're trying to infer in the context. If
-        -- they don't, they were added as instantiations of polymorphic
-        -- types that might as well just be instantiated to {}.
-        if keep u
-          then pure (new, (loc, n) : old)
-          else do
-            defaultAbility n
-            pure (new, old)
-      coalesceWanted new old
+    (new, old) <-
+      -- Only add existential variables to the wanted list if they
+      -- occur in a type we're trying to infer in the context. If
+      -- they don't, they were added as instantiations of polymorphic
+      -- types that might as well just be instantiated to {}.
+      if keep u
+        then pure (new, (loc, n) : old)
+        else do
+          defaultAbility n
+          pure (new, old)
+    coalesceWanted new old
   | otherwise = coalesceWanted' keep new ((loc, n) : old)
 
 -- Wrapper for coalesceWanted' that ensures both lists are fully
@@ -1922,10 +1922,10 @@ pruneWanted ::
 pruneWanted acc [] _ = pure acc
 pruneWanted acc ((loc, w) : want) handled
   | Just h <- find (headMatch w) handled = do
-      subtype w h
-      want <- expandWanted want
-      handled <- expandAbilities handled
-      pruneWanted acc want handled
+    subtype w h
+    want <- expandWanted want
+    handled <- expandAbilities handled
+    pruneWanted acc want handled
   | otherwise = pruneWanted ((loc, w) : acc) want handled
 
 -- | Processes wanted effects with respect to a portion of context
@@ -1947,7 +1947,7 @@ substAndDefaultWanted want ctx
   | want <- (fmap . fmap) (applyCtx ctx) want,
     want <- filter q want,
     repush <- filter keep ctx =
-      appendContext repush *> coalesceWanted want []
+    appendContext repush *> coalesceWanted want []
   where
     isExistential TypeVar.Existential {} = True
     isExistential _ = False
@@ -2064,14 +2064,14 @@ relax t = relax' True v t
 relax' :: Var v => Ord loc => Bool -> v -> Type v loc -> Type v loc
 relax' nonArrow v t
   | Type.Arrow' i o <- t =
-      Type.arrow (ABT.annotation t) i $ relax' nonArrow v o
+    Type.arrow (ABT.annotation t) i $ relax' nonArrow v o
   | Type.ForallsNamed' vs b <- t =
-      Type.foralls loc vs $ relax' nonArrow v b
+    Type.foralls loc vs $ relax' nonArrow v b
   | Type.Effect' es r <- t,
     Type.Arrow' i o <- r =
-      Type.effect loc es . Type.arrow (ABT.annotation t) i $ relax' nonArrow v o
+    Type.effect loc es . Type.arrow (ABT.annotation t) i $ relax' nonArrow v o
   | Type.Effect' es r <- t =
-      if any open es then t else Type.effect loc (tv : es) r
+    if any open es then t else Type.effect loc (tv : es) r
   | nonArrow = Type.effect loc [tv] t
   | otherwise = t
   where
@@ -2165,11 +2165,11 @@ check m0 t0 = scope (InCheck m0 t0) $ do
     Left m -> failWith $ DuplicateDefinitions m
     Right m
       | not (wellformedType ctx t0) ->
-          failWith $ IllFormedType ctx
+        failWith $ IllFormedType ctx
       | Type.Var' TypeVar.Existential {} <- t0 ->
-          applyM t0 >>= checkWanted [] m
+        applyM t0 >>= checkWanted [] m
       | otherwise ->
-          checkWanted [] m (Type.stripIntroOuters t0)
+        checkWanted [] m (Type.stripIntroOuters t0)
 
 -- | `subtype ctx t1 t2` returns successfully if `t1` is a subtype of `t2`.
 -- This may have the effect of altering the context.
@@ -2184,10 +2184,10 @@ subtype tx ty = scope (InSubtype tx ty) $ do
     go _ (Type.Ref' r) (Type.Ref' r2) | r == r2 = pure () -- `Unit`
     go ctx t1@(Type.Var' (TypeVar.Universal v1)) t2@(Type.Var' (TypeVar.Universal v2)) -- `Var`
       | v1 == v2 && wellformedType ctx t1 && wellformedType ctx t2 =
-          pure ()
+        pure ()
     go ctx t1@(Type.Var' (TypeVar.Existential _ v1)) t2@(Type.Var' (TypeVar.Existential _ v2)) -- `Exvar`
       | v1 == v2 && wellformedType ctx t1 && wellformedType ctx t2 =
-          pure ()
+        pure ()
     go _ (Type.Arrow' i1 o1) (Type.Arrow' i2 o2) = do
       -- `-->`
       subtype i2 i1
@@ -2226,13 +2226,13 @@ subtype tx ty = scope (InSubtype tx ty) $ do
     go ctx (Type.Var' (TypeVar.Existential b v)) t -- `InstantiateL`
       | Set.member v (existentials ctx)
           && notMember v (Type.freeVars t) = do
-          e <- extendExistential Var.inferAbility
-          instantiateL b v (relax' False e t)
+        e <- extendExistential Var.inferAbility
+        instantiateL b v (relax' False e t)
     go ctx t (Type.Var' (TypeVar.Existential b v)) -- `InstantiateR`
       | Set.member v (existentials ctx)
           && notMember v (Type.freeVars t) = do
-          e <- extendExistential Var.inferAbility
-          instantiateR (relax' False e t) b v
+        e <- extendExistential Var.inferAbility
+        instantiateR (relax' False e t) b v
     go _ (Type.Effects' es1) (Type.Effects' es2) =
       subAbilities ((,) Nothing <$> es1) es2
     go _ t t2@(Type.Effects' _) | expand t = subtype (Type.effects (loc t) [t]) t2
@@ -2255,7 +2255,7 @@ equate t1 t2 = scope (InEquate t1 t2) $ do
   where
     guardWF ctx t@(Type.Var' _)
       | not $ wellformedType ctx t =
-          failWith (TypeMismatch ctx)
+        failWith (TypeMismatch ctx)
     guardWF _ _ = pure ()
 
 equate0 ::
@@ -2269,20 +2269,20 @@ equate0 t1@(Type.Var' tv1) t2@(Type.Var' tv2)
   | TypeVar.Universal v1 <- tv1,
     TypeVar.Universal v2 <- tv2,
     v1 == v2 =
-      pure ()
+    pure ()
   | TypeVar.Existential b1 v1 <- tv1,
     TypeVar.Existential b2 v2 <- tv2 =
-      if v1 == v2
-        then pure ()
-        else do
-          ctx <- getContext
-          if ordered ctx v1 v2
-            then instantiateL b2 v2 t1
-            else instantiateL b1 v1 t2
+    if v1 == v2
+      then pure ()
+      else do
+        ctx <- getContext
+        if ordered ctx v1 v2
+          then instantiateL b2 v2 t1
+          else instantiateL b1 v1 t2
   | TypeVar.Existential b v1 <- tv1 =
-      instantiateL b v1 t2
+    instantiateL b v1 t2
   | TypeVar.Existential b v2 <- tv2 =
-      instantiateL b v2 t1
+    instantiateL b v2 t1
 equate0 (Type.Forall' t01) (Type.Forall' t02) = do
   v <- ABT.freshen t02 freshenTypeVar
   markThenRetract0 v $ do
@@ -2307,12 +2307,12 @@ equate0 (Type.Effect1' e1 a1) (Type.Effect1' e2 a2) = do
   equate a1 a2
 equate0 (Type.Var' (TypeVar.Existential b v)) t
   | notMember v (Type.freeVars t) =
-      -- subtyping relaxes here, should equality
-      instantiateL b v t
+    -- subtyping relaxes here, should equality
+    instantiateL b v t
 equate0 t (Type.Var' (TypeVar.Existential b v))
   | notMember v (Type.freeVars t) =
-      -- subtyping relaxes here, should equality
-      instantiateL b v t
+    -- subtyping relaxes here, should equality
+    instantiateL b v t
 equate0 (Type.Effects' es1) (Type.Effects' es2) =
   equateAbilities es1 es2
 equate0 y1 y2 = do
@@ -2340,8 +2340,8 @@ instantiateL blank v (Type.stripIntroOuters -> t) =
     go ctx = case t of
       Type.Var' (TypeVar.Existential _ v2)
         | ordered ctx v v2 -> -- InstLReach (both are existential, set v2 = v)
-            solve ctx v2 (Type.Monotype (existentialp (loc t) v))
-              >>= maybe (failWith $ TypeMismatch ctx) setContext
+          solve ctx v2 (Type.Monotype (existentialp (loc t) v))
+            >>= maybe (failWith $ TypeMismatch ctx) setContext
       Type.Arrow' i o -> do
         -- InstLArr
         [i', o'] <- traverse freshenVar [nameFrom Var.inferInput i, nameFrom Var.inferOutput o]
@@ -2431,18 +2431,18 @@ refineEffectVar _ [] _ _ _ = pure ()
 refineEffectVar l es blank v tv
   | ev <- TypeVar.Existential blank v,
     any (\e -> ev `Set.member` Type.freeVars e) es =
-      getContext >>= failWith . AbilityCheckFailure [tv] es
+    getContext >>= failWith . AbilityCheckFailure [tv] es
   | otherwise = do
-      slack <- freshenVar Var.inferAbility
-      evs <- traverse (\e -> freshenVar (nameFrom Var.inferAbility e)) es
-      let locs = loc <$> es
-          es' = zipWith existentialp locs evs
-          t' = Type.effects l (existentialp l slack : es')
-          s = Solved blank v (Type.Monotype t')
-          vs = existential slack : fmap existential evs
-      replaceContext (existential v) (vs ++ [s])
-      Foldable.for_ (es `zip` evs) $ \(e, ev) ->
-        getContext >>= \ctx -> instantiateR (apply ctx e) B.Blank ev
+    slack <- freshenVar Var.inferAbility
+    evs <- traverse (\e -> freshenVar (nameFrom Var.inferAbility e)) es
+    let locs = loc <$> es
+        es' = zipWith existentialp locs evs
+        t' = Type.effects l (existentialp l slack : es')
+        s = Solved blank v (Type.Monotype t')
+        vs = existential slack : fmap existential evs
+    replaceContext (existential v) (vs ++ [s])
+    Foldable.for_ (es `zip` evs) $ \(e, ev) ->
+      getContext >>= \ctx -> instantiateR (apply ctx e) B.Blank ev
 
 -- | Instantiate the given existential such that it is
 -- a supertype of the given type, updating the context
@@ -2461,8 +2461,8 @@ instantiateR (Type.stripIntroOuters -> t) blank v =
     go ctx = case t of
       Type.Var' (TypeVar.Existential _ v2)
         | ordered ctx v v2 -> -- InstRReach (both are existential, set v2 = v)
-            solve ctx v2 (Type.Monotype (existentialp (loc t) v))
-              >>= maybe (failWith $ TypeMismatch ctx) setContext
+          solve ctx v2 (Type.Monotype (existentialp (loc t) v))
+            >>= maybe (failWith $ TypeMismatch ctx) setContext
       Type.Arrow' i o -> do
         -- InstRArrow
         [i', o'] <- traverse freshenVar [nameFrom Var.inferInput i, nameFrom Var.inferOutput o]
@@ -2570,15 +2570,15 @@ matchConcrete ::
 matchConcrete common acc [] _ = pure (reverse acc, common)
 matchConcrete common acc (l : ls) rs
   | Just v <- find (headMatch l) common = do
-      equate v l
-      ls <- expandAbilities ls
-      rs <- expandAbilities rs
-      matchConcrete common acc ls rs
+    equate v l
+    ls <- expandAbilities ls
+    rs <- expandAbilities rs
+    matchConcrete common acc ls rs
   | Just v <- find (headMatch l) rs = do
-      equate v l
-      ls <- expandAbilities ls
-      rs <- expandAbilities rs
-      matchConcrete (l : common) acc ls rs
+    equate v l
+    ls <- expandAbilities ls
+    rs <- expandAbilities rs
+    matchConcrete (l : common) acc ls rs
   | otherwise = matchConcrete common (l : acc) ls rs
 
 pruneConcrete ::
@@ -2592,10 +2592,10 @@ pruneConcrete ::
 pruneConcrete _ acc [] _ = pure (reverse acc)
 pruneConcrete missing acc ((loc, w) : ws) have
   | Just v <- find (headMatch w) have = do
-      subtype v w `orElse` missing loc w
-      ws <- expandWanted ws
-      have <- expandAbilities have
-      pruneConcrete missing acc ws have
+    subtype v w `orElse` missing loc w
+    ws <- expandWanted ws
+    have <- expandAbilities have
+    pruneConcrete missing acc ws have
   | otherwise = pruneConcrete missing ((loc, w) : acc) ws have
 
 matchVariables ::
@@ -2608,7 +2608,7 @@ matchVariables ::
   ([Type v loc], [Type v loc], [Type v loc])
 matchVariables com acc (l : ls) rs
   | isExistential l && any (== l) rs =
-      matchVariables (l : com) acc (filter (/= l) ls) (filter (/= l) rs)
+    matchVariables (l : com) acc (filter (/= l) ls) (filter (/= l) rs)
   | otherwise = matchVariables com (l : acc) ls rs
   where
     isExistential (Type.Var' TypeVar.Existential {}) = True
@@ -2693,11 +2693,11 @@ equateAbilities ls rs =
         (vrs, crs) = partition isExistential rs
         mlSlack
           | [t@(Type.Var' (TypeVar.Existential b v))] <- vls =
-              Just (loc t, b, v)
+            Just (loc t, b, v)
           | otherwise = Nothing
         mrSlack
           | [t@(Type.Var' (TypeVar.Existential b v))] <- vrs =
-              Just (loc t, b, v)
+            Just (loc t, b, v)
           | otherwise = Nothing
      in case liftA2 (,) mlSlack mrSlack of
           Just ((ll, bl, lSlack), (lr, br, rSlack)) ->
@@ -2706,7 +2706,7 @@ equateAbilities ls rs =
             | [t@(Type.Var' (TypeVar.Existential bc cv))] <- com,
               null vls,
               null vrs ->
-                refine True [(loc t, bc, cv)] [cls ++ crs]
+              refine True [(loc t, bc, cv)] [cls ++ crs]
             | [] <- com, null rs, null cls -> for_ vls defaultAbility
             | [] <- com, null ls, null crs -> for_ vrs defaultAbility
             | [] <- com, Just pl <- mlSlack, null cls -> refine False [pl] [rs]
@@ -2738,7 +2738,8 @@ equateAbilities ls rs =
           | u == v = EQ
           | ordered ctx u v = LT
           | otherwise = GT
-        cn | common = [Var.inferAbility] | otherwise = []
+        cn | common = [Var.inferAbility]
+          | otherwise = []
 
 subAbilities ::
   Var v =>
@@ -2787,10 +2788,10 @@ subAmbient ::
 subAmbient die ambient r
   -- find unsolved existential, 'e, that appears in ambient
   | (b, e') : _ <- unsolveds = do
-      -- introduce fresh existential 'e2 to context
-      e2' <- extendExistential e'
-      let et2 = Type.effects (loc r) [r, existentialp (loc r) e2']
-      instantiateR et2 b e' `orElse` die
+    -- introduce fresh existential 'e2 to context
+    e2' <- extendExistential e'
+    let et2 = Type.effects (loc r) [r, existentialp (loc r) e2']
+    instantiateR et2 b e' `orElse` die
   | otherwise = die
   where
     unsolveds = (ambient >>= Type.flattenEffects >>= vars)
@@ -2811,19 +2812,19 @@ abilityCheckSingle die ambient r
   --   Ex: given `a`, where there's an exact variable
   -- If yes for `a` in ambient, do `subtype a r` and done.
   | Just a <- find (headMatch r) ambient =
-      subtype a r `orElse` die
+    subtype a r `orElse` die
   -- It's an unsolved existential, instantiate it to all of ambient
   | Type.Var' tv@(TypeVar.Existential b v) <- r =
-      let et2 = Type.effects (loc r) ambient
-          acyclic
-            | Set.member tv (Type.freeVars et2) =
-                -- just need to trigger `orElse` in this case
-                getContext >>= failWith . TypeMismatch
-            | otherwise = instantiateR et2 b v
-       in -- instantiate it to `{}` if can't cover all of ambient
-          acyclic
-            `orElse` instantiateR (Type.effects (loc r) []) b v
-            `orElse` die
+    let et2 = Type.effects (loc r) ambient
+        acyclic
+          | Set.member tv (Type.freeVars et2) =
+            -- just need to trigger `orElse` in this case
+            getContext >>= failWith . TypeMismatch
+          | otherwise = instantiateR et2 b v
+     in -- instantiate it to `{}` if can't cover all of ambient
+        acyclic
+          `orElse` instantiateR (Type.effects (loc r) []) b v
+          `orElse` die
   | otherwise = subAmbient die ambient r
 
 headMatch :: Var v => Ord loc => Type v loc -> Type v loc -> Bool
diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal
index ac0200463..60739117d 100644
--- a/parser-typechecker/unison-parser-typechecker.cabal
+++ b/parser-typechecker/unison-parser-typechecker.cabal
@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.34.4.
+-- This file has been generated from package.yaml by hpack version 0.35.0.
 --
 -- see: https://github.com/sol/hpack
 
@@ -93,6 +93,7 @@ library
       Unison.Parsers
       Unison.PrettyPrintEnv
       Unison.PrettyPrintEnv.FQN
+      Unison.PrettyPrintEnv.MonadPretty
       Unison.PrettyPrintEnv.Names
       Unison.PrettyPrintEnv.Util
       Unison.PrettyPrintEnvDecl
@@ -298,9 +299,9 @@ library
     , x509-system
     , yaml
     , zlib
+  default-language: Haskell2010
   if flag(optimized)
     ghc-options: -funbox-strict-fields -O2
-  default-language: Haskell2010
 
 test-suite parser-typechecker-tests
   type: exitcode-stdio-1.0
@@ -486,6 +487,6 @@ test-suite parser-typechecker-tests
     , x509-system
     , yaml
     , zlib
+  default-language: Haskell2010
   if flag(optimized)
     ghc-options: -funbox-strict-fields -O2
-  default-language: Haskell2010
diff --git a/unison-cli/src/Unison/CommandLine/DisplayValues.hs b/unison-cli/src/Unison/CommandLine/DisplayValues.hs
index fd30d8721..e63360370 100644
--- a/unison-cli/src/Unison/CommandLine/DisplayValues.hs
+++ b/unison-cli/src/Unison/CommandLine/DisplayValues.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ViewPatterns #-}
 
 module Unison.CommandLine.DisplayValues where
@@ -17,6 +16,7 @@ import qualified Unison.ConstructorType as CT
 import qualified Unison.DataDeclaration as DD
 import Unison.Prelude
 import qualified Unison.PrettyPrintEnv as PPE
+import Unison.PrettyPrintEnv.MonadPretty (runPretty)
 import qualified Unison.PrettyPrintEnv.Util as PPE
 import qualified Unison.PrettyPrintEnvDecl as PPE
 import Unison.Reference (Reference)
@@ -246,10 +246,9 @@ displayPretty pped terms typeOf eval types tm = go tm
       typeOf r >>= \case
         Nothing -> pure $ termName (PPE.suffixifiedPPE pped) r
         Just typ ->
-          pure . P.group $
-            TypePrinter.prettySignaturesCTCollapsed
-              (PPE.suffixifiedPPE pped)
-              [(r, PPE.termName (PPE.suffixifiedPPE pped) r, typ)]
+          pure . P.group
+            . runPretty (PPE.suffixifiedPPE pped)
+            $ TypePrinter.prettySignaturesCTCollapsed [(r, PPE.termName (PPE.suffixifiedPPE pped) r, typ)]
 
     goColor c = case c of
       DD.AnsiColorBlack -> P.black
@@ -311,9 +310,8 @@ displayDoc pped terms typeOf evaluated types = go
       typeOf r >>= \case
         Nothing -> pure $ termName (PPE.unsuffixifiedPPE pped) r
         Just typ ->
-          pure . P.group $
+          pure . P.group . runPretty (PPE.suffixifiedPPE pped) $
             TypePrinter.prettySignaturesCTCollapsed
-              (PPE.suffixifiedPPE pped)
               [(r, PPE.termName (PPE.unsuffixifiedPPE pped) r, typ)]
     prettyEval terms r = case r of
       Referent.Ref (Reference.Builtin n) -> pure . P.syntaxToColor $ P.text n
@@ -329,7 +327,7 @@ displayDoc pped terms typeOf evaluated types = go
         let ppe = PPE.declarationPPE pped ref
          in terms ref >>= \case
               Nothing -> pure $ "😶  Missing term source for: " <> termName ppe r
-              Just tm -> pure . P.syntaxToColor $ P.group $ TP.prettyBinding ppe (PPE.termName ppe r) tm
+              Just tm -> pure . P.syntaxToColor . P.group . runPretty ppe $ TP.prettyBinding (PPE.termName ppe r) tm
       Referent.Con (ConstructorReference r _) _ -> prettyType r
     prettyType r =
       let ppe = PPE.declarationPPE pped r
diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs
index f514b25d8..643432726 100644
--- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs
+++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs
@@ -102,6 +102,7 @@ import qualified Unison.NamesWithHistory as Names
 import Unison.Parser.Ann (Ann, startingLine)
 import Unison.Prelude
 import qualified Unison.PrettyPrintEnv as PPE
+import Unison.PrettyPrintEnv.MonadPretty (runPretty)
 import qualified Unison.PrettyPrintEnv.Util as PPE
 import qualified Unison.PrettyPrintEnvDecl as PPED
 import Unison.PrettyTerminal
@@ -299,21 +300,20 @@ notifyNumbered o = case o of
       else
         first
           ( \p ->
-              ( P.lines
-                  [ P.wrap $
-                      "The changes summarized below are available for you to review,"
-                        <> "using the following command:",
-                    "",
-                    P.indentN 2 $
-                      IP.makeExampleNoBackticks
-                        IP.loadPullRequest
-                        [ (prettyReadRemoteNamespace baseRepo),
-                          (prettyReadRemoteNamespace headRepo)
-                        ],
-                    "",
-                    p
-                  ]
-              )
+              P.lines
+                [ P.wrap $
+                    "The changes summarized below are available for you to review,"
+                      <> "using the following command:",
+                  "",
+                  P.indentN 2 $
+                    IP.makeExampleNoBackticks
+                      IP.loadPullRequest
+                      [ prettyReadRemoteNamespace baseRepo,
+                        prettyReadRemoteNamespace headRepo
+                      ],
+                  "",
+                  p
+                ]
           )
           (showDiffNamespace HideNumbers ppe (absPathToBranchId Path.absoluteEmpty) (absPathToBranchId Path.absoluteEmpty) diff)
   -- todo: these numbers aren't going to work,
@@ -689,7 +689,7 @@ notifyUser dir o = case o of
   TestIncrementalOutputStart ppe (n, total) r _src -> do
     putPretty' $
       P.shown (total - n) <> " tests left to run, current test: "
-        <> (P.syntaxToColor $ prettyHashQualified (PPE.termName ppe $ Referent.Ref r))
+        <> P.syntaxToColor (prettyHashQualified (PPE.termName ppe $ Referent.Ref r))
     pure mempty
   TestIncrementalOutputEnd _ppe (_n, _total) _r result -> do
     clearCurrentLine
@@ -1039,7 +1039,7 @@ notifyUser dir o = case o of
               P.bracket . P.lines $
                 P.wrap "The watch expression(s) reference these definitions:" :
                 "" :
-                  [ (P.syntaxToColor $ TermPrinter.prettyBinding ppe (HQ.unsafeFromVar v) b)
+                  [ P.syntaxToColor . runPretty ppe $ TermPrinter.prettyBinding (HQ.unsafeFromVar v) b
                     | (v, b) <- bindings
                   ]
             prettyWatches =
@@ -1815,7 +1815,7 @@ notifyUser dir o = case o of
     let referenceText = P.text . Reference.toText . Cv.reference2to1
     pure $
       P.columnNHeader
-        ["Kind", "Name",  "Change", "Ref"]
+        ["Kind", "Name", "Change", "Ref"]
         ( (termNameAdds <&> \(n, ref) -> ["Term", prettyName n, "Added", referentText ref])
             <> (termNameRemovals <&> \(n, ref) -> ["Term", prettyName n, "Removed", referentText ref])
             <> (typeNameAdds <&> \(n, ref) -> ["Type", prettyName n, "Added", referenceText ref])
@@ -1976,7 +1976,7 @@ displayDefinitions' ppe0 types terms = P.syntaxToColor $ P.sep "\n\n" (prettyTyp
           P.hang
             ("builtin " <> prettyHashQualified n <> " :")
             (TypePrinter.prettySyntax (ppeBody r) typ)
-        UserObject tm -> TermPrinter.prettyBinding (ppeBody r) n tm
+        UserObject tm -> runPretty (ppeBody r) $ TermPrinter.prettyBinding n tm
     go2 ((n, r), dt) =
       case dt of
         MissingObject r -> missing n r
@@ -2081,7 +2081,7 @@ displayDefinitions outputLoc ppe types terms =
               P.hang
                 ("builtin " <> prettyHashQualified n <> " :")
                 (TypePrinter.prettySyntax (ppeBody n r) typ)
-            UserObject tm -> TermPrinter.prettyBinding (ppeBody n r) n tm
+            UserObject tm -> runPretty (ppeBody n r) $ TermPrinter.prettyBinding n tm
         go2 ((n, r), dt) =
           case dt of
             MissingObject r -> missing n r
@@ -2148,7 +2148,7 @@ unsafePrettyTermResultSig' ::
   Pretty
 unsafePrettyTermResultSig' ppe = \case
   SR'.TermResult' name (Just typ) r _aliases ->
-    head (TypePrinter.prettySignaturesCT ppe [(r, name, typ)])
+    head (runPretty ppe $ TypePrinter.prettySignaturesCT [(r, name, typ)])
   _ -> error "Don't pass Nothing"
 
 -- produces:
@@ -2165,7 +2165,7 @@ unsafePrettyTermResultSigFull' ppe = \case
       [ P.hiBlack "-- " <> greyHash (HQ.fromReferent r),
         P.group $
           P.commas (fmap greyHash $ hq : map HQ'.toHQ (toList aliases)) <> " : "
-            <> (P.syntaxToColor $ TypePrinter.pretty0 ppe mempty (-1) typ),
+            <> P.syntaxToColor (TypePrinter.prettySyntax ppe typ),
         mempty
       ]
   _ -> error "Don't pass Nothing"
@@ -2396,7 +2396,7 @@ todoOutput ppe todo = runNumbered do
       termNumbers <- for filteredTerms \(ref, _, _) -> do
         n <- addNumberedArg (HQ.toString $ PPE.termName ppeu ref)
         pure $ formatNum n
-      let formattedTerms = TypePrinter.prettySignaturesCT ppes filteredTerms
+      let formattedTerms = runPretty ppes $ TypePrinter.prettySignaturesCT filteredTerms
           numberedTerms = zipWith (<>) termNumbers formattedTerms
       pure $
         Monoid.unlessM (TO.noEdits todo) . P.callout "🚧" . P.sep "\n\n" . P.nonEmpty $
@@ -2407,7 +2407,7 @@ todoOutput ppe todo = runNumbered do
               ),
             P.indentN 2 . P.lines $
               ( (prettyDeclPair ppeu <$> toList frontierTypes)
-                  ++ TypePrinter.prettySignaturesCT ppes (goodTerms frontierTerms)
+                  ++ runPretty ppes (TypePrinter.prettySignaturesCT (goodTerms frontierTerms))
               ),
             P.wrap "I recommend working on them in the following order:",
             P.lines $ numberedTypes ++ numberedTerms,
diff --git a/unison-share-api/src/Unison/Server/Backend.hs b/unison-share-api/src/Unison/Server/Backend.hs
index 50d7f4072..3d6e165ff 100644
--- a/unison-share-api/src/Unison/Server/Backend.hs
+++ b/unison-share-api/src/Unison/Server/Backend.hs
@@ -73,6 +73,7 @@ import qualified Unison.NamesWithHistory as NamesWithHistory
 import Unison.Parser.Ann (Ann)
 import Unison.Prelude
 import qualified Unison.PrettyPrintEnv as PPE
+import Unison.PrettyPrintEnv.MonadPretty (runPretty)
 import qualified Unison.PrettyPrintEnv.Util as PPE
 import qualified Unison.PrettyPrintEnvDecl as PPED
 import qualified Unison.PrettyPrintEnvDecl.Names as PPED
@@ -144,7 +145,7 @@ data BackendError
   | MissingSignatureForTerm Reference
   | NoSuchDefinition (HQ.HashQualified Name)
 
-data BackendEnv = BackendEnv
+newtype BackendEnv = BackendEnv
   { -- | Whether to use the sqlite name-lookup table to generate Names objects rather than building Names from the root branch.
     useNamesIndex :: Bool
   }
@@ -265,7 +266,7 @@ termEntryDisplayName :: TermEntry v a -> Text
 termEntryDisplayName = HQ'.toText . termEntryHQName
 
 termEntryHQName :: TermEntry v a -> HQ'.HashQualified NameSegment
-termEntryHQName (TermEntry {termEntryName, termEntryConflicted, termEntryHash}) =
+termEntryHQName TermEntry {termEntryName, termEntryConflicted, termEntryHash} =
   if termEntryConflicted
     then HQ'.HashQualified termEntryName termEntryHash
     else HQ'.NameOnly termEntryName
@@ -283,7 +284,7 @@ typeEntryDisplayName :: TypeEntry -> Text
 typeEntryDisplayName = HQ'.toText . typeEntryHQName
 
 typeEntryHQName :: TypeEntry -> HQ'.HashQualified NameSegment
-typeEntryHQName (TypeEntry {typeEntryName, typeEntryConflicted, typeEntryReference}) =
+typeEntryHQName TypeEntry {typeEntryName, typeEntryConflicted, typeEntryReference} =
   if typeEntryConflicted
     then HQ'.HashQualified typeEntryName (Reference.toShortHash typeEntryReference)
     else HQ'.NameOnly typeEntryName
@@ -528,7 +529,7 @@ formatTypeName' ppe r =
 
 termEntryToNamedTerm ::
   Var v => PPE.PrettyPrintEnv -> Maybe Width -> TermEntry v a -> NamedTerm
-termEntryToNamedTerm ppe typeWidth te@(TermEntry {termEntryType = mayType, termEntryTag = tag, termEntryHash}) =
+termEntryToNamedTerm ppe typeWidth te@TermEntry {termEntryType = mayType, termEntryTag = tag, termEntryHash} =
   NamedTerm
     { termName = termEntryHQName te,
       termHash = termEntryHash,
@@ -537,7 +538,7 @@ termEntryToNamedTerm ppe typeWidth te@(TermEntry {termEntryType = mayType, termE
     }
 
 typeEntryToNamedType :: TypeEntry -> NamedType
-typeEntryToNamedType te@(TypeEntry {typeEntryTag, typeEntryHash}) =
+typeEntryToNamedType te@TypeEntry {typeEntryTag, typeEntryHash} =
   NamedType
     { typeName = typeEntryHQName $ te,
       typeHash = typeEntryHash,
@@ -672,7 +673,7 @@ makeTypeSearch :: Int -> NamesWithHistory -> Search Reference
 makeTypeSearch len names =
   Search
     { lookupNames = \ref -> NamesWithHistory.typeName len ref names,
-      lookupRelativeHQRefs' = \name -> NamesWithHistory.lookupRelativeHQType' name names,
+      lookupRelativeHQRefs' = (`NamesWithHistory.lookupRelativeHQType'` names),
       matchesNamedRef = HQ'.matchesNamedReference,
       makeResult = SR.typeResult
     }
@@ -682,7 +683,7 @@ makeTermSearch :: Int -> NamesWithHistory -> Search Referent
 makeTermSearch len names =
   Search
     { lookupNames = \ref -> NamesWithHistory.termName len ref names,
-      lookupRelativeHQRefs' = \name -> NamesWithHistory.lookupRelativeHQTerm' name names,
+      lookupRelativeHQRefs' = (`NamesWithHistory.lookupRelativeHQTerm'` names),
       matchesNamedRef = HQ'.matchesNamedReferent,
       makeResult = SR.termResult
     }
@@ -721,7 +722,7 @@ hqNameQuery ::
   NameSearch ->
   [HQ.HashQualified Name] ->
   m QueryResult
-hqNameQuery codebase (NameSearch {typeSearch, termSearch}) hqs = do
+hqNameQuery codebase NameSearch {typeSearch, termSearch} hqs = do
   -- Split the query into hash-only and hash-qualified-name queries.
   let (hashes, hqnames) = partitionEithers (map HQ'.fromHQ2 hqs)
   -- Find the terms with those hashes.
@@ -747,8 +748,12 @@ hqNameQuery codebase (NameSearch {typeSearch, termSearch}) hqs = do
       -- Now do the actual name query
       resultss = map (\name -> applySearch typeSearch name <> applySearch termSearch name) hqnames
       (misses, hits) =
-        zip hqnames resultss
-          & map (\(hqname, results) -> if null results then Left hqname else Right results)
+        zipWith
+          ( \hqname results ->
+              (if null results then Left hqname else Right results)
+          )
+          hqnames
+          resultss
           & partitionEithers
       -- Handle query misses correctly
       missingRefs =
@@ -776,7 +781,7 @@ data DefinitionResults v = DefinitionResults
   }
 
 expandShortBranchHash ::
-  Monad m => Codebase m v a -> ShortBranchHash -> Backend m (Branch.CausalHash)
+  Monad m => Codebase m v a -> ShortBranchHash -> Backend m Branch.CausalHash
 expandShortBranchHash codebase hash = do
   hashSet <- lift $ Codebase.branchHashesByPrefix codebase hash
   len <- lift $ Codebase.branchHashLength codebase
@@ -787,18 +792,17 @@ expandShortBranchHash codebase hash = do
       throwError . AmbiguousBranchHash hash $ Set.map (SBH.fromHash len) hashSet
 
 -- | Efficiently resolve a root hash and path to a shallow branch's causal.
-getShallowCausalAtPathFromRootHash :: Monad m => Codebase m v a -> Maybe (Branch.CausalHash) -> Path -> Backend m (V2Branch.CausalBranch m)
+getShallowCausalAtPathFromRootHash :: Monad m => Codebase m v a -> Maybe Branch.CausalHash -> Path -> Backend m (V2Branch.CausalBranch m)
 getShallowCausalAtPathFromRootHash codebase mayRootHash path = do
   shallowRoot <- case mayRootHash of
     Nothing -> lift (Codebase.getShallowRootCausal codebase)
     Just h -> do
       lift $ Codebase.getShallowCausalForHash codebase (Cv.causalHash1to2 h)
-  causal <- lift $ Codebase.getShallowCausalAtPath codebase path (Just shallowRoot)
-  pure causal
+  lift $ Codebase.getShallowCausalAtPath codebase path (Just shallowRoot)
 
 formatType' :: Var v => PPE.PrettyPrintEnv -> Width -> Type v a -> SyntaxText
 formatType' ppe w =
-  Pretty.render w . TypePrinter.pretty0 ppe mempty (-1)
+  Pretty.render w . TypePrinter.prettySyntax ppe
 
 formatType :: Var v => PPE.PrettyPrintEnv -> Width -> Type v a -> Syntax.SyntaxText
 formatType ppe w = mungeSyntaxText . formatType' ppe w
@@ -822,7 +826,7 @@ prettyDefinitionsForHQName ::
   -- this path.
   Path ->
   -- | The root branch to use
-  Maybe (Branch.CausalHash) ->
+  Maybe Branch.CausalHash ->
   Maybe Width ->
   -- | Whether to suffixify bindings in the rendered syntax
   Suffixify ->
@@ -995,7 +999,7 @@ docsInBranchToHtmlFiles runtime codebase root currentPath directory = do
   let currentBranch = Branch.getAt' currentPath root
   let allTerms = (R.toList . Branch.deepTerms . Branch.head) currentBranch
   -- ignores docs inside lib namespace, recursively
-  let notLib (_, name) = all (/= "lib") (Name.segments name)
+  let notLib (_, name) = "lib" `notElem` Name.segments name
   docTermsWithNames <- filterM (isDoc codebase . fst) (filter notLib allTerms)
   let docNamesByRef = Map.fromList docTermsWithNames
   hqLength <- Codebase.hashLength codebase
@@ -1069,7 +1073,8 @@ bestNameForTerm ppe width =
   Text.pack
     . Pretty.render width
     . fmap UST.toPlain
-    . TermPrinter.pretty0 @v ppe TermPrinter.emptyAc
+    . runPretty ppe
+    . TermPrinter.pretty0 @v TermPrinter.emptyAc
     . Term.fromReferent mempty
 
 bestNameForType ::
@@ -1078,7 +1083,7 @@ bestNameForType ppe width =
   Text.pack
     . Pretty.render width
     . fmap UST.toPlain
-    . TypePrinter.pretty0 @v ppe mempty (-1)
+    . TypePrinter.prettySyntax @v ppe
     . Type.ref ()
 
 -- | Returns (parse, pretty, local, ppe) where:
@@ -1096,9 +1101,9 @@ scopedNamesForBranchHash codebase mbh path = do
     Nothing
       | shouldUseNamesIndex -> indexNames
       | otherwise -> do
-          rootBranch <- lift $ Codebase.getRootBranch codebase
-          let (parseNames, _prettyNames, localNames) = namesForBranch rootBranch (AllNames path)
-          pure (parseNames, localNames)
+        rootBranch <- lift $ Codebase.getRootBranch codebase
+        let (parseNames, _prettyNames, localNames) = namesForBranch rootBranch (AllNames path)
+        pure (parseNames, localNames)
     Just rootCausal -> do
       let ch = V2Causal.causalHash rootCausal
       let v1CausalHash = Cv.causalHash2to1 ch
@@ -1255,8 +1260,8 @@ termsToSyntax suff width ppe0 terms =
       DisplayObject.UserObject tm ->
         DisplayObject.UserObject
           . Pretty.render width
-          . TermPrinter.prettyBinding (ppeBody r) n
-          $ tm
+          . runPretty (ppeBody r)
+          $ TermPrinter.prettyBinding n tm
 
 typesToSyntax ::
   Var v =>
@@ -1296,8 +1301,8 @@ typesToSyntax suff width ppe0 types =
 typeToSyntaxHeader ::
   Width ->
   HQ.HashQualified Name ->
-  (DisplayObject () (DD.Decl Symbol Ann)) ->
-  (DisplayObject SyntaxText SyntaxText)
+  DisplayObject () (DD.Decl Symbol Ann) ->
+  DisplayObject SyntaxText SyntaxText
 typeToSyntaxHeader width hqName obj =
   case obj of
     BuiltinObject _ ->
diff --git a/unison-share-api/src/Unison/Server/Doc.hs b/unison-share-api/src/Unison/Server/Doc.hs
index ffc190206..48acd7d27 100644
--- a/unison-share-api/src/Unison/Server/Doc.hs
+++ b/unison-share-api/src/Unison/Server/Doc.hs
@@ -1,6 +1,4 @@
 {-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -32,6 +30,7 @@ import qualified Unison.Codebase.Editor.DisplayObject as DO
 import qualified Unison.ConstructorReference as ConstructorReference
 import qualified Unison.DataDeclaration as DD
 import qualified Unison.PrettyPrintEnv as PPE
+import Unison.PrettyPrintEnv.MonadPretty (runPretty)
 import qualified Unison.PrettyPrintEnvDecl as PPE
 import Unison.Reference (Reference)
 import qualified Unison.Reference as Reference
@@ -183,16 +182,15 @@ renderDoc pped terms typeOf eval types tm =
     formatPrettyType ppe typ = formatPretty (TypePrinter.prettySyntax ppe typ)
 
     source :: Term v () -> m SyntaxText
-    source tm = (pure . formatPretty . TermPrinter.prettyBlock' True (PPE.suffixifiedPPE pped)) tm
+    source tm = pure . formatPretty $ TermPrinter.prettyBlock' True (PPE.suffixifiedPPE pped) tm
 
     goSignatures :: [Referent] -> m [P.Pretty SSyntaxText]
     goSignatures rs =
       runMaybeT (traverse (MaybeT . typeOf) rs) >>= \case
         Nothing -> pure ["🆘  codebase is missing type signature for these definitions"]
         Just types ->
-          pure . fmap P.group $
+          pure . fmap P.group . runPretty (PPE.suffixifiedPPE pped) $
             TypePrinter.prettySignaturesST
-              (PPE.suffixifiedPPE pped)
               [(r, PPE.termName (PPE.suffixifiedPPE pped) r, ty) | (r, ty) <- zip rs types]
 
     goSpecial :: Term v () -> m SpecialForm
@@ -314,12 +312,12 @@ renderDoc pped terms typeOf eval types tm =
                               typ <- fromMaybe (Type.builtin () "unknown") <$> typeOf (Referent.Ref ref)
                               let name = PPE.termName ppe (Referent.Ref ref)
                               let folded =
-                                    formatPretty . P.lines $
-                                      TypePrinter.prettySignaturesST ppe [(Referent.Ref ref, name, typ)]
+                                    formatPretty . P.lines . runPretty ppe $
+                                      TypePrinter.prettySignaturesST [(Referent.Ref ref, name, typ)]
                               let full tm@(Term.Ann' _ _) _ =
-                                    formatPretty (TermPrinter.prettyBinding ppe name tm)
+                                    formatPretty (runPretty ppe $ TermPrinter.prettyBinding name tm)
                                   full tm typ =
-                                    formatPretty (TermPrinter.prettyBinding ppe name (Term.ann () tm typ))
+                                    formatPretty (runPretty ppe $ TermPrinter.prettyBinding name (Term.ann () tm typ))
                               pure (DO.UserObject (Src folded (full tm typ)))
                   Term.RequestOrCtor' (view ConstructorReference.reference_ -> r) | Set.notMember r seen -> (: acc) <$> goType r
                   _ -> pure acc