From de4708010e8f617db742961a524261753de18356 Mon Sep 17 00:00:00 2001
From: Brent Yorgey <byorgey@gmail.com>
Date: Tue, 31 Oct 2023 10:11:06 -0500
Subject: [PATCH 1/5] WIP: converting to prettyprinter

---
 disco.cabal                       |  2 +-
 src/Disco/AST/Core.hs             |  2 +-
 src/Disco/AST/Surface.hs          | 14 +++---
 src/Disco/Error.hs                | 20 ++++-----
 src/Disco/Eval.hs                 | 22 ++++-----
 src/Disco/Interactive/Commands.hs | 50 ++++++++++-----------
 src/Disco/Messages.hs             | 20 ++++-----
 src/Disco/Pretty.hs               | 18 +++-----
 src/Disco/Pretty/DSL.hs           | 74 +++++++++++++++----------------
 src/Disco/Property.hs             | 10 ++---
 src/Disco/Subst.hs                |  2 +-
 src/Disco/Typecheck.hs            | 12 ++---
 src/Disco/Typecheck/Solve.hs      | 16 +++----
 src/Disco/Typecheck/Util.hs       |  5 +--
 src/Disco/Value.hs                | 14 +++---
 15 files changed, 131 insertions(+), 150 deletions(-)

diff --git a/disco.cabal b/disco.cabal
index ea8031b1..0fd7885d 100644
--- a/disco.cabal
+++ b/disco.cabal
@@ -460,7 +460,7 @@ library
                        mtl >=2.2 && <2.4,
                        megaparsec >= 6.1.1 && < 9.6,
                        parser-combinators >= 1.0.0 && < 1.4,
-                       pretty >=1.1 && <1.2,
+                       prettyprinter >=1.7 && < 1.8,
                        split >= 0.2 && < 0.3,
                        transformers >= 0.4 && < 0.7,
                        containers >=0.5 && <0.7,
diff --git a/src/Disco/AST/Core.hs b/src/Disco/AST/Core.hs
index e8178646..7cc8c107 100644
--- a/src/Disco/AST/Core.hs
+++ b/src/Disco/AST/Core.hs
@@ -318,7 +318,7 @@ instance Pretty Core where
 toTuple :: [Core] -> Core
 toTuple = foldr CPair CUnit
 
-prettyTestVars :: Members '[Reader PA, LFresh] r => [(String, Type, Name Core)] -> Sem r Doc
+prettyTestVars :: Members '[Reader PA, LFresh] r => [(String, Type, Name Core)] -> Sem r (Doc ann)
 prettyTestVars = brackets . intercalate "," . map prettyTestVar
  where
   prettyTestVar (s, ty, n) = parens (intercalate "," [text s, pretty ty, pretty n])
diff --git a/src/Disco/AST/Surface.hs b/src/Disco/AST/Surface.hs
index c15c43e8..7646e8d9 100644
--- a/src/Disco/AST/Surface.hs
+++ b/src/Disco/AST/Surface.hs
@@ -2,10 +2,6 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE UndecidableInstances #-}
 
------------------------------------------------------------------------------
-
------------------------------------------------------------------------------
-
 -- |
 -- Module      :  Disco.AST.Surface
 -- Copyright   :  disco team and contributors
@@ -236,7 +232,7 @@ instance Pretty (Name a, Bind [Pattern] Term) where
     pretty x <> hcat (map prettyPatternP ps) <+> text "=" <+> setPA initPA (pretty t)
 
 -- | Pretty-print a type declaration.
-prettyTyDecl :: Members '[Reader PA, LFresh] r => Name t -> Type -> Sem r Doc
+prettyTyDecl :: Members '[Reader PA, LFresh] r => Name t -> Type -> Sem r (Doc ann)
 prettyTyDecl x ty = hsep [pretty x, text ":", pretty ty]
 
 ------------------------------------------------------------
@@ -526,7 +522,7 @@ pattern PNonlinear p x <- PNonlinear_ (unembed -> p) x
 -- term (e.g. via the :doc REPL command).
 
 -- | Pretty-print a term with guaranteed parentheses.
-prettyTermP :: Members '[LFresh, Reader PA] r => Term -> Sem r Doc
+prettyTermP :: Members '[LFresh, Reader PA] r => Term -> Sem r (Doc ann)
 prettyTermP t@TTup {} = setPA initPA $ pretty t
 -- prettyTermP t@TContainer{} = setPA initPA $ "" <+> prettyTerm t
 prettyTermP t = withPA initPA $ pretty t
@@ -630,12 +626,12 @@ instance Pretty Term where
     TWild -> text "_"
 
 -- | Print appropriate delimiters for a container literal.
-containerDelims :: Member (Reader PA) r => Container -> (Sem r Doc -> Sem r Doc)
+containerDelims :: Member (Reader PA) r => Container -> (Sem r (Doc ann) -> Sem r (Doc ann))
 containerDelims ListContainer = brackets
 containerDelims BagContainer = bag
 containerDelims SetContainer = braces
 
-prettyBranches :: Members '[Reader PA, LFresh] r => [Branch] -> Sem r Doc
+prettyBranches :: Members '[Reader PA, LFresh] r => [Branch] -> Sem r (Doc ann)
 prettyBranches = \case
   [] -> error "Empty branches are disallowed."
   b : bs ->
@@ -681,7 +677,7 @@ instance Pretty Qual where
     QGuard (unembed -> t) -> pretty t
 
 -- | Pretty-print a pattern with guaranteed parentheses.
-prettyPatternP :: Members '[LFresh, Reader PA] r => Pattern -> Sem r Doc
+prettyPatternP :: Members '[LFresh, Reader PA] r => Pattern -> Sem r (Doc ann)
 prettyPatternP p@PTup {} = setPA initPA $ pretty p
 prettyPatternP p = withPA initPA $ pretty p
 
diff --git a/src/Disco/Error.hs b/src/Disco/Error.hs
index 6282d0eb..423c69e0 100644
--- a/src/Disco/Error.hs
+++ b/src/Disco/Error.hs
@@ -82,7 +82,7 @@ deriving instance Show EvalError
 panic :: Member (Error DiscoError) r => String -> Sem r a
 panic = throw . Panic
 
-outputDiscoErrors :: Member (Output Message) r => Sem (Error DiscoError ': r) () -> Sem r ()
+outputDiscoErrors :: Member (Output (Message ann)) r => Sem (Error DiscoError ': r) () -> Sem r ()
 outputDiscoErrors m = do
   e <- runError m
   either (err . pretty') return e
@@ -105,23 +105,23 @@ instance Pretty DiscoError where
         , "Please report this as a bug at https://github.com/disco-lang/disco/issues/ ."
         ]
 
-rtd :: String -> Sem r Doc
+rtd :: String -> Sem r (Doc ann)
 rtd page = "https://disco-lang.readthedocs.io/en/latest/reference/" <> text page <> ".html"
 
-issue :: Int -> Sem r Doc
+issue :: Int -> Sem r (Doc ann)
 issue n = "See https://github.com/disco-lang/disco/issues/" <> text (show n)
 
 cyclicImportError ::
   Members '[Reader PA, LFresh] r =>
   [ModuleName] ->
-  Sem r Doc
+  Sem r (Doc ann)
 cyclicImportError ms =
   vcat
     [ "Error: module imports form a cycle:"
     , nest 2 $ intercalate " ->" (map pretty ms)
     ]
 
-prettyEvalError :: Members '[Reader PA, LFresh] r => EvalError -> Sem r Doc
+prettyEvalError :: Members '[Reader PA, LFresh] r => EvalError -> Sem r (Doc ann)
 prettyEvalError = \case
   UnboundPanic x ->
     ("Bug! No variable found named" <+> pretty' x <> ".")
@@ -138,7 +138,7 @@ prettyEvalError = \case
 -- [ ] Step 3: improve error messages according to notes below
 -- [ ] Step 4: get it to return multiple error messages
 -- [ ] Step 5: save parse locations, display with errors
-prettyTCError :: Members '[Reader PA, LFresh] r => TCError -> Sem r Doc
+prettyTCError :: Members '[Reader PA, LFresh] r => TCError -> Sem r (Doc ann)
 prettyTCError = \case
   -- XXX include some potential misspellings along with Unbound
   --   see https://github.com/disco-lang/disco/issues/180
@@ -267,7 +267,7 @@ prettyTCError = \case
       ]
   NoError -> empty
 
-conWord :: Con -> Sem r Doc
+conWord :: Con -> Sem r (Doc ann)
 conWord = \case
   CArr -> "function"
   CProd -> "pair"
@@ -280,7 +280,7 @@ conWord = \case
   CGraph -> "graph"
   CUser s -> text s
 
-prettySolveError :: Members '[Reader PA, LFresh] r => SolveError -> Sem r Doc
+prettySolveError :: Members '[Reader PA, LFresh] r => SolveError -> Sem r (Doc ann)
 prettySolveError = \case
   -- XXX say which types!
   NoWeakUnifier ->
@@ -311,12 +311,12 @@ prettySolveError = \case
       , rtd "qual-skolem"
       ]
 
-qualPhrase :: Bool -> Qualifier -> Sem r Doc
+qualPhrase :: Bool -> Qualifier -> Sem r (Doc ann)
 qualPhrase b q
   | q `elem` [QBool, QBasic, QSimple] = "are" <+> (if b then empty else "not") <+> qualAction q
   | otherwise = "can" <> (if b then empty else "not") <+> "be" <+> qualAction q
 
-qualAction :: Qualifier -> Sem r Doc
+qualAction :: Qualifier -> Sem r (Doc ann)
 qualAction = \case
   QNum -> "added and multiplied"
   QSub -> "subtracted"
diff --git a/src/Disco/Eval.hs b/src/Disco/Eval.hs
index b246dbd0..b5ddd356 100644
--- a/src/Disco/Eval.hs
+++ b/src/Disco/Eval.hs
@@ -2,10 +2,6 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
------------------------------------------------------------------------------
-
------------------------------------------------------------------------------
-
 -- |
 -- Module      :  Disco.Eval
 -- Copyright   :  disco team and contributors
@@ -164,10 +160,10 @@ type family AppendEffects (r :: EffectRow) (s :: EffectRow) :: EffectRow where
 -- However, just manually implementing it here seems easier.
 
 -- | Effects needed at the top level.
-type TopEffects = '[Error DiscoError, State TopInfo, Output Message, Embed IO, Final (H.InputT IO)]
+type TopEffects = '[Error DiscoError, State TopInfo, Output (Message ()), Embed IO, Final (H.InputT IO)]
 
 -- | Effects needed for evaluation.
-type EvalEffects = [Error EvalError, Random, LFresh, Output Message, State Mem]
+type EvalEffects = [Error EvalError, Random, LFresh, Output (Message ()), State Mem]
 
 -- XXX write about order.
 -- memory, counter etc. should not be reset by errors.
@@ -296,7 +292,7 @@ typecheckTop tcm = do
 --   The 'Resolver' argument specifies where to look for imported
 --   modules.
 loadDiscoModule ::
-  Members '[State TopInfo, Output Message, Random, State Mem, Error DiscoError, Embed IO] r =>
+  Members '[State TopInfo, Output (Message ann), Random, State Mem, Error DiscoError, Embed IO] r =>
   Bool ->
   Resolver ->
   FilePath ->
@@ -310,7 +306,7 @@ loadDiscoModule quiet resolver =
 --   module loaded from disk).  Used for e.g. blocks/modules entered
 --   at the REPL prompt.
 loadParsedDiscoModule ::
-  Members '[State TopInfo, Output Message, Random, State Mem, Error DiscoError, Embed IO] r =>
+  Members '[State TopInfo, Output (Message ann), Random, State Mem, Error DiscoError, Embed IO] r =>
   Bool ->
   Resolver ->
   ModuleName ->
@@ -324,7 +320,7 @@ loadParsedDiscoModule quiet resolver =
 --   any imported module more than once. Resolve the module, load and
 --   parse it, then call 'loadParsedDiscoModule''.
 loadDiscoModule' ::
-  Members '[State TopInfo, Output Message, Random, State Mem, Error DiscoError, Embed IO] r =>
+  Members '[State TopInfo, Output (Message ann), Random, State Mem, Error DiscoError, Embed IO] r =>
   Bool ->
   Resolver ->
   [ModuleName] ->
@@ -356,7 +352,7 @@ stdLib = ["list", "container"]
 --   'LoadingMode' parameter is 'REPL'.  Recursively load all its
 --   imports, then typecheck it.
 loadParsedDiscoModule' ::
-  Members '[State TopInfo, Output Message, Random, State Mem, Error DiscoError, Embed IO] r =>
+  Members '[State TopInfo, Output (Message ann), Random, State Mem, Error DiscoError, Embed IO] r =>
   Bool ->
   LoadingMode ->
   Resolver ->
@@ -398,7 +394,7 @@ loadParsedDiscoModule' quiet mode resolver inProcess name cm@(Module _ mns _ _ _
 
 -- | Try loading the contents of a file from the filesystem, emitting
 --   an error if it's not found.
-loadFile :: Members '[Output Message, Embed IO] r => FilePath -> Sem r (Maybe String)
+loadFile :: Members '[Output (Message ann), Embed IO] r => FilePath -> Sem r (Maybe String)
 loadFile file = do
   res <- liftIO $ handle @SomeException (return . Left) (Right <$> readFile file)
   case res of
@@ -408,7 +404,7 @@ loadFile file = do
 -- | Add things from the given module to the set of currently loaded
 --   things.
 addToREPLModule ::
-  Members '[Error DiscoError, State TopInfo, Random, State Mem, Output Message] r =>
+  Members '[Error DiscoError, State TopInfo, Random, State Mem, Output (Message ann)] r =>
   ModuleInfo ->
   Sem r ()
 addToREPLModule mi = modify @TopInfo (replModInfo <>~ mi)
@@ -418,7 +414,7 @@ addToREPLModule mi = modify @TopInfo (replModInfo <>~ mi)
 --   term definitions, documentation, types, and type definitions.
 --   Replaces any previously loaded module.
 setREPLModule ::
-  Members '[State TopInfo, Random, Error EvalError, State Mem, Output Message] r =>
+  Members '[State TopInfo, Random, Error EvalError, State Mem, Output (Message ann)] r =>
   ModuleInfo ->
   Sem r ()
 setREPLModule mi = do
diff --git a/src/Disco/Interactive/Commands.hs b/src/Disco/Interactive/Commands.hs
index acf10c38..47174f90 100644
--- a/src/Disco/Interactive/Commands.hs
+++ b/src/Disco/Interactive/Commands.hs
@@ -303,7 +303,7 @@ annCmd =
     }
 
 handleAnn ::
-  Members '[Error DiscoError, Input TopInfo, Output Message] r =>
+  Members '[Error DiscoError, Input TopInfo, Output (Message ann)] r =>
   REPLExpr 'CAnn ->
   Sem r ()
 handleAnn (Ann t) = do
@@ -326,7 +326,7 @@ compileCmd =
     }
 
 handleCompile ::
-  Members '[Error DiscoError, Input TopInfo, Output Message] r =>
+  Members '[Error DiscoError, Input TopInfo, Output (Message ann)] r =>
   REPLExpr 'CCompile ->
   Sem r ()
 handleCompile (Compile t) = do
@@ -349,7 +349,7 @@ desugarCmd =
     }
 
 handleDesugar ::
-  Members '[Error DiscoError, Input TopInfo, LFresh, Output Message] r =>
+  Members '[Error DiscoError, Input TopInfo, LFresh, Output (Message ann)] r =>
   REPLExpr 'CDesugar ->
   Sem r ()
 handleDesugar (Desugar t) = do
@@ -383,7 +383,7 @@ parseDoc =
     <|> (DocOther <$> (sc *> many (anySingleBut ' ')))
 
 handleDoc ::
-  Members '[Error DiscoError, Input TopInfo, LFresh, Output Message] r =>
+  Members '[Error DiscoError, Input TopInfo, LFresh, Output (Message ann)] r =>
   REPLExpr 'CDoc ->
   Sem r ()
 handleDoc (Doc (DocTerm (TBool _))) = handleDocBool
@@ -396,26 +396,26 @@ handleDoc (Doc (DocTerm _)) =
 handleDoc (Doc (DocPrim p)) = handleDocPrim p
 handleDoc (Doc (DocOther s)) = handleDocOther s
 
-handleDocBool :: Members '[Output Message] r => Sem r ()
+handleDocBool :: Members '[Output (Message ann)] r => Sem r ()
 handleDocBool =
   info $
     "true and false (also written True and False) are the two possible values of type Boolean."
       $+$ mkReference "bool"
 
-handleDocUnit :: Members '[Output Message] r => Sem r ()
+handleDocUnit :: Members '[Output (Message ann)] r => Sem r ()
 handleDocUnit =
   info $
     "The unit value, i.e. the single value of type Unit."
       $+$ mkReference "unit"
 
-handleDocWild :: Members '[Output Message] r => Sem r ()
+handleDocWild :: Members '[Output (Message ann)] r => Sem r ()
 handleDocWild =
   info $
     "A wildcard pattern."
       $+$ mkReference "wild-pattern"
 
 handleDocVar ::
-  Members '[Error DiscoError, Input TopInfo, LFresh, Output Message] r =>
+  Members '[Error DiscoError, Input TopInfo, LFresh, Output (Message ann)] r =>
   Name Term ->
   Sem r ()
 handleDocVar x = do
@@ -456,7 +456,7 @@ handleDocVar x = do
           _ -> Pretty.empty
 
 handleDocPrim ::
-  Members '[Error DiscoError, Input TopInfo, LFresh, Output Message] r =>
+  Members '[Error DiscoError, Input TopInfo, LFresh, Output (Message ann)] r =>
   Prim ->
   Sem r ()
 handleDocPrim prim = do
@@ -500,7 +500,7 @@ mkReference p =
   "https://disco-lang.readthedocs.io/en/latest/reference/" <> text p <> ".html"
 
 handleDocOther ::
-  Members '[Error DiscoError, Input TopInfo, LFresh, Output Message] r =>
+  Members '[Error DiscoError, Input TopInfo, LFresh, Output (Message ann)] r =>
   String ->
   Sem r ()
 handleDocOther s =
@@ -526,7 +526,7 @@ evalCmd =
     }
 
 handleEval ::
-  Members (Error DiscoError ': State TopInfo ': Output Message ': Embed IO ': EvalEffects) r =>
+  Members (Error DiscoError ': State TopInfo ': Output (Message ann) ': Embed IO ': EvalEffects) r =>
   REPLExpr 'CEval ->
   Sem r ()
 handleEval (Eval m) = do
@@ -537,7 +537,7 @@ handleEval (Eval m) = do
 -- garbageCollect?
 
 -- First argument = should the value be printed?
-evalTerm :: Members (Error EvalError ': State TopInfo ': Output Message ': EvalEffects) r => Bool -> ATerm -> Sem r Value
+evalTerm :: Members (Error EvalError ': State TopInfo ': Output (Message ann) ': EvalEffects) r => Bool -> ATerm -> Sem r Value
 evalTerm pr at = do
   env <- use @TopInfo topEnv
   v <- runInputConst env $ eval (compileTerm at)
@@ -567,7 +567,7 @@ helpCmd =
     , parser = return Help
     }
 
-handleHelp :: Member (Output Message) r => REPLExpr 'CHelp -> Sem r ()
+handleHelp :: Member (Output (Message ann)) r => REPLExpr 'CHelp -> Sem r ()
 handleHelp Help =
   info $
     vcat
@@ -606,13 +606,13 @@ loadCmd =
 --   in the parent module are executed.
 --   Disco.Interactive.CmdLine uses a version of this function that returns a Bool.
 handleLoadWrapper ::
-  Members (Error DiscoError ': State TopInfo ': Output Message ': Embed IO ': EvalEffects) r =>
+  Members (Error DiscoError ': State TopInfo ': Output (Message ann) ': Embed IO ': EvalEffects) r =>
   REPLExpr 'CLoad ->
   Sem r ()
 handleLoadWrapper (Load fp) = void (handleLoad fp)
 
 handleLoad ::
-  Members (Error DiscoError ': State TopInfo ': Output Message ': Embed IO ': EvalEffects) r =>
+  Members (Error DiscoError ': State TopInfo ': Output (Message ann) ': Embed IO ': EvalEffects) r =>
   FilePath ->
   Sem r Bool
 handleLoad fp = do
@@ -640,7 +640,7 @@ handleLoad fp = do
 
 -- XXX Return a structured summary of the results, not a Bool; & move
 -- this somewhere else?
-runAllTests :: Members (Output Message ': Input TopInfo ': EvalEffects) r => [QName Term] -> Ctx ATerm [AProperty] -> Sem r Bool -- (Ctx ATerm [TestResult])
+runAllTests :: Members (Output (Message ann) ': Input TopInfo ': EvalEffects) r => [QName Term] -> Ctx ATerm [AProperty] -> Sem r Bool -- (Ctx ATerm [TestResult])
 runAllTests declNames aprops
   | Ctx.null aprops = return True
   | otherwise = do
@@ -650,7 +650,7 @@ runAllTests declNames aprops
  where
   numSamples :: Int
   numSamples = 50 -- XXX make this configurable somehow
-  runTests :: Members (Output Message ': Input TopInfo ': EvalEffects) r => QName Term -> [AProperty] -> Sem r Bool
+  runTests :: Members (Output (Message ann) ': Input TopInfo ': EvalEffects) r => QName Term -> [AProperty] -> Sem r Bool
   runTests (QName _ n) props = do
     results <- inputTopEnv $ traverse (sequenceA . (id &&& runTest numSamples)) props
     let failures = P.filter (not . testIsOk . snd) results
@@ -684,7 +684,7 @@ namesCmd =
 
 -- | Show names and types for each item in the top-level context.
 handleNames ::
-  Members '[Input TopInfo, LFresh, Output Message] r =>
+  Members '[Input TopInfo, LFresh, Output (Message ann)] r =>
   REPLExpr 'CNames ->
   Sem r ()
 handleNames Names = do
@@ -729,7 +729,7 @@ parseCmd =
     , parser = Parse <$> term
     }
 
-handleParse :: Member (Output Message) r => REPLExpr 'CParse -> Sem r ()
+handleParse :: Member (Output (Message ann)) r => REPLExpr 'CParse -> Sem r ()
 handleParse (Parse t) = info (text (show t))
 
 ------------------------------------------------------------
@@ -747,7 +747,7 @@ prettyCmd =
     , parser = Pretty <$> term
     }
 
-handlePretty :: Members '[LFresh, Output Message] r => REPLExpr 'CPretty -> Sem r ()
+handlePretty :: Members '[LFresh, Output (Message ann)] r => REPLExpr 'CPretty -> Sem r ()
 handlePretty (Pretty t) = info $ pretty' t
 
 ------------------------------------------------------------
@@ -765,7 +765,7 @@ printCmd =
     , parser = Print <$> term
     }
 
-handlePrint :: Members (Error DiscoError ': State TopInfo ': Output Message ': EvalEffects) r => REPLExpr 'CPrint -> Sem r ()
+handlePrint :: Members (Error DiscoError ': State TopInfo ': Output (Message ann) ': EvalEffects) r => REPLExpr 'CPrint -> Sem r ()
 handlePrint (Print t) = do
   at <- inputToState . typecheckTop $ checkTop t (toPolyType TyString)
   v <- mapError EvalErr . evalTerm False $ at
@@ -787,7 +787,7 @@ reloadCmd =
     }
 
 handleReload ::
-  Members (Error DiscoError ': State TopInfo ': Output Message ': Embed IO ': EvalEffects) r =>
+  Members (Error DiscoError ': State TopInfo ': Output (Message ann) ': Embed IO ': EvalEffects) r =>
   REPLExpr 'CReload ->
   Sem r ()
 handleReload Reload = do
@@ -812,7 +812,7 @@ showDefnCmd =
     }
 
 handleShowDefn ::
-  Members '[Input TopInfo, LFresh, Output Message] r =>
+  Members '[Input TopInfo, LFresh, Output (Message ann)] r =>
   REPLExpr 'CShowDefn ->
   Sem r ()
 handleShowDefn (ShowDefn x) = do
@@ -845,7 +845,7 @@ testPropCmd =
     }
 
 handleTest ::
-  Members (Error DiscoError ': State TopInfo ': Output Message ': EvalEffects) r =>
+  Members (Error DiscoError ': State TopInfo ': Output (Message ann) ': EvalEffects) r =>
   REPLExpr 'CTestProp ->
   Sem r ()
 handleTest (TestProp t) = do
@@ -871,7 +871,7 @@ typeCheckCmd =
     }
 
 handleTypeCheck ::
-  Members '[Error DiscoError, Input TopInfo, LFresh, Output Message] r =>
+  Members '[Error DiscoError, Input TopInfo, LFresh, Output (Message ann)] r =>
   REPLExpr 'CTypeCheck ->
   Sem r ()
 handleTypeCheck (TypeCheck t) = do
diff --git a/src/Disco/Messages.hs b/src/Disco/Messages.hs
index 4e5ea677..afacd7d1 100644
--- a/src/Disco/Messages.hs
+++ b/src/Disco/Messages.hs
@@ -30,34 +30,34 @@ data MessageType
   | Debug
   deriving (Show, Read, Eq, Ord, Enum, Bounded)
 
-data Message = Message {_messageType :: MessageType, _message :: Doc}
+data Message ann = Message {_messageType :: MessageType, _message :: (Doc ann)}
   deriving (Show)
 
 makeLenses ''Message
 
-handleMsg :: Member (Embed IO) r => (Message -> Bool) -> Message -> Sem r ()
+handleMsg :: Member (Embed IO) r => (Message ann -> Bool) -> Message ann -> Sem r ()
 handleMsg p m = when (p m) $ printMsg m
 
-printMsg :: Member (Embed IO) r => Message -> Sem r ()
+printMsg :: Member (Embed IO) r => Message ann -> Sem r ()
 printMsg (Message _ m) = embed $ putStrLn (renderDoc' m)
 
-msg :: Member (Output Message) r => MessageType -> Sem r Doc -> Sem r ()
+msg :: Member (Output (Message ann)) r => MessageType -> Sem r (Doc ann) -> Sem r ()
 msg typ m = m >>= output . Message typ
 
-info :: Member (Output Message) r => Sem r Doc -> Sem r ()
+info :: Member (Output (Message ann)) r => Sem r (Doc ann) -> Sem r ()
 info = msg Info
 
-infoPretty :: (Member (Output Message) r, Pretty t) => t -> Sem r ()
+infoPretty :: (Member (Output (Message ann)) r, Pretty t) => t -> Sem r ()
 infoPretty = info . pretty'
 
-warn :: Member (Output Message) r => Sem r Doc -> Sem r ()
+warn :: Member (Output (Message ann)) r => Sem r (Doc ann) -> Sem r ()
 warn = msg Warning
 
-debug :: Member (Output Message) r => Sem r Doc -> Sem r ()
+debug :: Member (Output (Message ann)) r => Sem r (Doc ann) -> Sem r ()
 debug = msg Debug
 
-debugPretty :: (Member (Output Message) r, Pretty t) => t -> Sem r ()
+debugPretty :: (Member (Output (Message ann)) r, Pretty t) => t -> Sem r ()
 debugPretty = debug . pretty'
 
-err :: Member (Output Message) r => Sem r Doc -> Sem r ()
+err :: Member (Output (Message ann)) r => Sem r (Doc ann) -> Sem r ()
 err = msg ErrMsg
diff --git a/src/Disco/Pretty.hs b/src/Disco/Pretty.hs
index 981b869e..522e4b71 100644
--- a/src/Disco/Pretty.hs
+++ b/src/Disco/Pretty.hs
@@ -33,15 +33,11 @@ import qualified Data.Map as M
 import Data.Ratio
 import Data.Set (Set)
 import qualified Data.Set as S
-
 import Disco.Effects.LFresh
 import Polysemy
-
 import Polysemy.Reader
-
-import Text.PrettyPrint (Doc)
 import Unbound.Generics.LocallyNameless (Name)
-
+import Prettyprinter (Doc)
 import Disco.Pretty.DSL
 import Disco.Pretty.Prec
 import Disco.Syntax.Operators
@@ -54,7 +50,7 @@ import Disco.Syntax.Operators
 --   associativity of a term is, and optionally surround it with
 --   parentheses depending on the precedence and associativity of its
 --   parent.
-withPA :: Member (Reader PA) r => PA -> Sem r Doc -> Sem r Doc
+withPA :: Member (Reader PA) r => PA -> Sem r (Doc ann) -> Sem r (Doc ann)
 withPA pa = mparens pa . setPA pa
 
 -- | Locally set the precedence and associativity within a
@@ -65,20 +61,20 @@ setPA = local . const
 -- | Mark a subcomputation as pretty-printing a term on the left of an
 --   operator (so parentheses can be inserted appropriately, depending
 --   on the associativity).
-lt :: Member (Reader PA) r => Sem r Doc -> Sem r Doc
+lt :: Member (Reader PA) r => Sem r (Doc ann) -> Sem r (Doc ann)
 lt = local (\(PA p _) -> PA p InL)
 
 -- | Mark a subcomputation as pretty-printing a term on the right of
 --   an operator (so parentheses can be inserted appropriately,
 --   depending on the associativity).
-rt :: Member (Reader PA) r => Sem r Doc -> Sem r Doc
+rt :: Member (Reader PA) r => Sem r (Doc ann) -> Sem r (Doc ann)
 rt = local (\(PA p _) -> PA p InR)
 
 -- | Optionally surround a pretty-printed term with parentheses,
 --   depending on its precedence and associativity (given as the 'PA'
 --   argument) and that of its context (given by the ambient 'Reader
 --   PA' effect).
-mparens :: Member (Reader PA) r => PA -> Sem r Doc -> Sem r Doc
+mparens :: Member (Reader PA) r => PA -> Sem r (Doc ann) -> Sem r (Doc ann)
 mparens pa doc = do
   parentPA <- ask
   (if pa < parentPA then parens else id) doc
@@ -87,12 +83,12 @@ mparens pa doc = do
 -- Pretty type class
 
 class Pretty t where
-  pretty :: Members '[Reader PA, LFresh] r => t -> Sem r Doc
+  pretty :: Members '[Reader PA, LFresh] r => t -> Sem r (Doc ann)
 
 prettyStr :: Pretty t => t -> Sem r String
 prettyStr = renderDoc . runLFresh . pretty
 
-pretty' :: Pretty t => t -> Sem r Doc
+pretty' :: Pretty t => t -> Sem r (Doc ann)
 pretty' = runReader initPA . runLFresh . pretty
 
 ------------------------------------------------------------
diff --git a/src/Disco/Pretty/DSL.hs b/src/Disco/Pretty/DSL.hs
index 8032f150..226fbde5 100644
--- a/src/Disco/Pretty/DSL.hs
+++ b/src/Disco/Pretty/DSL.hs
@@ -1,5 +1,3 @@
------------------------------------------------------------------------------
------------------------------------------------------------------------------
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 -- |
@@ -15,16 +13,14 @@ module Disco.Pretty.DSL where
 import Control.Applicative hiding (empty)
 import Data.String (IsString (..))
 import Prelude hiding ((<>))
-
 import Polysemy
 import Polysemy.Reader
-
-import Text.PrettyPrint (Doc)
-import qualified Text.PrettyPrint as PP
-
+import Prettyprinter (Doc)
+import Prettyprinter.Render.String (renderString)
+import qualified Prettyprinter as PP
 import Disco.Pretty.Prec
 
-instance IsString (Sem r Doc) where
+instance IsString (Sem r (Doc ann)) where
   fromString = text
 
 ------------------------------------------------------------
@@ -33,73 +29,73 @@ instance IsString (Sem r Doc) where
 -- Each combinator here mirrors one from Text.PrettyPrint, but
 -- operates over a generic functor/monad.
 
-vcat :: Applicative f => [f Doc] -> f Doc
+vcat :: Applicative f => [f (Doc ann)] -> f (Doc ann)
 vcat ds = PP.vcat <$> sequenceA ds
 
-hcat :: Applicative f => [f Doc] -> f Doc
+hcat :: Applicative f => [f (Doc ann)] -> f (Doc ann)
 hcat ds = PP.hcat <$> sequenceA ds
 
-hsep :: Applicative f => [f Doc] -> f Doc
+hsep :: Applicative f => [f (Doc ann)] -> f (Doc ann)
 hsep ds = PP.hsep <$> sequenceA ds
 
-parens :: Functor f => f Doc -> f Doc
+parens :: Functor f => f (Doc ann) -> f (Doc ann)
 parens = fmap PP.parens
 
-brackets :: Functor f => f Doc -> f Doc
+brackets :: Functor f => f (Doc ann) -> f (Doc ann)
 brackets = fmap PP.brackets
 
-braces :: Functor f => f Doc -> f Doc
+braces :: Functor f => f (Doc ann) -> f (Doc ann)
 braces = fmap PP.braces
 
-bag :: Applicative f => f Doc -> f Doc
+bag :: Applicative f => f (Doc ann) -> f (Doc ann)
 bag p = text "⟅" <> p <> text "⟆"
 
-quotes :: Functor f => f Doc -> f Doc
-quotes = fmap PP.quotes
+quotes :: Functor f => f (Doc ann) -> f (Doc ann)
+quotes = fmap PP.squotes
 
-doubleQuotes :: Functor f => f Doc -> f Doc
-doubleQuotes = fmap PP.doubleQuotes
+doubleQuotes :: Functor f => f (Doc ann) -> f (Doc ann)
+doubleQuotes = fmap PP.dquotes
 
-text :: Applicative m => String -> m Doc
-text = pure . PP.text
+text :: Applicative m => String -> m (Doc ann)
+text = pure . fromString
 
-integer :: Applicative m => Integer -> m Doc
-integer = pure . PP.integer
+integer :: Applicative m => Integer -> m (Doc ann)
+integer = pure . PP.pretty
 
-nest :: Functor f => Int -> f Doc -> f Doc
+nest :: Functor f => Int -> f (Doc ann) -> f (Doc ann)
 nest n d = PP.nest n <$> d
 
-hang :: Applicative f => f Doc -> Int -> f Doc -> f Doc
-hang d1 n d2 = PP.hang <$> d1 <*> pure n <*> d2
+hang :: Applicative f => f (Doc ann) -> Int -> f (Doc ann) -> f (Doc ann)
+hang d1 n d2 = d1 <+> nest n d2
 
-empty :: Applicative m => m Doc
-empty = pure PP.empty
+empty :: Applicative m => m (Doc ann)
+empty = pure PP.emptyDoc
 
-(<+>) :: Applicative f => f Doc -> f Doc -> f Doc
+(<+>) :: Applicative f => f (Doc ann) -> f (Doc ann) -> f (Doc ann)
 (<+>) = liftA2 (PP.<+>)
 
-(<>) :: Applicative f => f Doc -> f Doc -> f Doc
+(<>) :: Applicative f => f (Doc ann) -> f (Doc ann) -> f (Doc ann)
 (<>) = liftA2 (PP.<>)
 
-($+$) :: Applicative f => f Doc -> f Doc -> f Doc
-($+$) = liftA2 (PP.$+$)
+($+$) :: Applicative f => f (Doc ann) -> f (Doc ann) -> f (Doc ann)
+d1 $+$ d2 = PP.vcat <$> sequenceA [d1,d2]
 
-punctuate :: Applicative f => f Doc -> [f Doc] -> f [f Doc]
+punctuate :: Applicative f => f (Doc ann) -> [f (Doc ann)] -> f [f (Doc ann)]
 punctuate p ds = map pure <$> (PP.punctuate <$> p <*> sequenceA ds)
 
-intercalate :: Monad f => f Doc -> [f Doc] -> f Doc
+intercalate :: Monad f => f (Doc ann) -> [f (Doc ann)] -> f (Doc ann)
 intercalate p ds = do
   ds' <- punctuate p ds
   hsep ds'
 
-bulletList :: Applicative f => f Doc -> [f Doc] -> f Doc
+bulletList :: Applicative f => f (Doc ann) -> [f (Doc ann)] -> f (Doc ann)
 bulletList bullet = vcat . map (hang bullet 2)
 
 ------------------------------------------------------------
 -- Running a pretty-printer
 
-renderDoc :: Sem (Reader PA ': r) Doc -> Sem r String
-renderDoc = fmap PP.render . runReader initPA
+renderDoc :: Sem (Reader PA ': r) (Doc ann) -> Sem r String
+renderDoc = fmap renderDoc' . runReader initPA
 
-renderDoc' :: Doc -> String
-renderDoc' = PP.render
+renderDoc' :: Doc ann -> String
+renderDoc' = renderString . PP.layoutPretty PP.defaultLayoutOptions
diff --git a/src/Disco/Property.hs b/src/Disco/Property.hs
index bdbd1092..93e876ba 100644
--- a/src/Disco/Property.hs
+++ b/src/Disco/Property.hs
@@ -79,7 +79,7 @@ generateSamples (Randomized n m) e
 -- Pretty-printing for test results
 ------------------------------------------------------------
 
-prettyResultCertainty :: Members '[LFresh, Reader PA] r => TestReason -> AProperty -> String -> Sem r Doc
+prettyResultCertainty :: Members '[LFresh, Reader PA] r => TestReason -> AProperty -> String -> Sem r (Doc ann)
 prettyResultCertainty r prop res =
   (if resultIsCertain r then "Certainly" else "Possibly") <+> text res <> ":" <+> pretty (eraseProperty prop)
 
@@ -88,7 +88,7 @@ prettyTestReason ::
   Bool ->
   AProperty ->
   TestReason ->
-  Sem r Doc
+  Sem r (Doc ann)
 prettyTestReason _ _ TestBool = empty
 prettyTestReason b prop (TestFound (TestResult _ tr env))
   | b = prettyTestEnv "Found example:" env
@@ -151,7 +151,7 @@ prettyTestResult' ::
   Bool ->
   AProperty ->
   TestResult ->
-  Sem r Doc
+  Sem r (Doc ann)
 prettyTestResult' _ prop (TestResult bool tr _) =
   prettyResultCertainty tr prop (map toLower (show bool))
     $+$ prettyTestReason bool prop tr
@@ -160,14 +160,14 @@ prettyTestResult ::
   Members '[Input TyDefCtx, LFresh, Reader PA] r =>
   AProperty ->
   TestResult ->
-  Sem r Doc
+  Sem r (Doc ann)
 prettyTestResult prop (TestResult b r env) = prettyTestResult' b prop (TestResult b r env)
 
 prettyTestEnv ::
   Members '[Input TyDefCtx, LFresh, Reader PA] r =>
   String ->
   TestEnv ->
-  Sem r Doc
+  Sem r (Doc ann)
 prettyTestEnv _ (TestEnv []) = empty
 prettyTestEnv s (TestEnv vs) = text s $+$ nest 2 (vcat (map prettyBind vs))
  where
diff --git a/src/Disco/Subst.hs b/src/Disco/Subst.hs
index 23e221cd..5d11c02a 100644
--- a/src/Disco/Subst.hs
+++ b/src/Disco/Subst.hs
@@ -72,7 +72,7 @@ instance Pretty a => Pretty (Substitution a) where
     ds <- punctuate "," es
     braces (hsep ds)
 
-prettyMapping :: (Pretty a, Members '[Reader PA, LFresh] r) => Name a -> a -> Sem r Doc
+prettyMapping :: (Pretty a, Members '[Reader PA, LFresh] r) => Name a -> a -> Sem r (Doc ann)
 prettyMapping x a = pretty x <+> "->" <+> pretty a
 
 -- | The domain of a substitution is the set of names for which the
diff --git a/src/Disco/Typecheck.hs b/src/Disco/Typecheck.hs
index a67f25c4..a2ff9b0d 100644
--- a/src/Disco/Typecheck.hs
+++ b/src/Disco/Typecheck.hs
@@ -114,7 +114,7 @@ inferTelescope inferOne tel = do
 --   imports should already be checked and passed in as the second
 --   argument.
 checkModule ::
-  Members '[Output Message, Reader TyCtx, Reader TyDefCtx, Error LocTCError, Fresh] r =>
+  Members '[Output (Message ann), Reader TyCtx, Reader TyDefCtx, Error LocTCError, Fresh] r =>
   ModuleName ->
   Map ModuleName ModuleInfo ->
   Module ->
@@ -268,7 +268,7 @@ checkCtx = mapM_ checkPolyTyValid . Ctx.elems
 
 -- | Type check a top-level definition in the given module.
 checkDefn ::
-  Members '[Reader TyCtx, Reader TyDefCtx, Error LocTCError, Fresh, Output Message] r =>
+  Members '[Reader TyCtx, Reader TyDefCtx, Error LocTCError, Fresh, Output (Message ann)] r =>
   ModuleName ->
   TermDefn ->
   Sem r Defn
@@ -336,7 +336,7 @@ checkDefn name (TermDefn x clauses) = mapError (LocTCError (Just (name .- x))) $
 -- | Given a context mapping names to documentation, extract the
 --   properties attached to each name and typecheck them.
 checkProperties ::
-  Members '[Reader TyCtx, Reader TyDefCtx, Error TCError, Fresh, Output Message] r =>
+  Members '[Reader TyCtx, Reader TyDefCtx, Error TCError, Fresh, Output (Message ann)] r =>
   Ctx Term Docs ->
   Sem r (Ctx ATerm [AProperty])
 checkProperties docs =
@@ -348,7 +348,7 @@ checkProperties docs =
 
 -- | Check the types of the terms embedded in a property.
 checkProperty ::
-  Members '[Reader TyCtx, Reader TyDefCtx, Error TCError, Fresh, Output Message] r =>
+  Members '[Reader TyCtx, Reader TyDefCtx, Error TCError, Fresh, Output (Message ann)] r =>
   Property ->
   Sem r AProperty
 checkProperty prop = do
@@ -445,7 +445,7 @@ infer = typecheck Infer
 --   for a term by running type inference, solving the resulting
 --   constraints, and quantifying over any remaining type variables.
 inferTop ::
-  Members '[Output Message, Reader TyCtx, Reader TyDefCtx, Error TCError, Fresh] r =>
+  Members '[Output (Message ann), Reader TyCtx, Reader TyDefCtx, Error TCError, Fresh] r =>
   Term ->
   Sem r (ATerm, PolyType)
 inferTop t = do
@@ -473,7 +473,7 @@ inferTop t = do
 --   polymorphic type by running type checking and solving the
 --   resulting constraints.
 checkTop ::
-  Members '[Output Message, Reader TyCtx, Reader TyDefCtx, Error TCError, Fresh] r =>
+  Members '[Output (Message ann), Reader TyCtx, Reader TyDefCtx, Error TCError, Fresh] r =>
   Term ->
   PolyType ->
   Sem r ATerm
diff --git a/src/Disco/Typecheck/Solve.hs b/src/Disco/Typecheck/Solve.hs
index 5de75a3e..5d00e431 100644
--- a/src/Disco/Typecheck/Solve.hs
+++ b/src/Disco/Typecheck/Solve.hs
@@ -249,7 +249,7 @@ lkup messg m k = fromMaybe (error errMsg) (M.lookup k m)
 -- Top-level solver algorithm
 
 solveConstraint ::
-  Members '[Fresh, Error SolveError, Output Message, Input TyDefCtx] r =>
+  Members '[Fresh, Error SolveError, Output (Message ann), Input TyDefCtx] r =>
   Constraint ->
   Sem r S
 solveConstraint c = do
@@ -271,7 +271,7 @@ solveConstraint c = do
   asum' (map (uncurry solveConstraintChoice) qcList)
 
 solveConstraintChoice ::
-  Members '[Fresh, Error SolveError, Output Message, Input TyDefCtx] r =>
+  Members '[Fresh, Error SolveError, Output (Message ann), Input TyDefCtx] r =>
   TyVarInfoMap ->
   [SimpleConstraint] ->
   Sem r S
@@ -487,7 +487,7 @@ checkQual q (ABase bty) =
 --   constraints, that is, only of the form (v1 <: v2), (v <: b), or
 --   (b <: v), where v is a type variable and b is a base type.
 simplify ::
-  Members '[Error SolveError, Output Message, Input TyDefCtx] r =>
+  Members '[Error SolveError, Output (Message ann), Input TyDefCtx] r =>
   TyVarInfoMap ->
   [SimpleConstraint] ->
   Sem r (TyVarInfoMap, [(Atom, Atom)], S)
@@ -517,7 +517,7 @@ simplify origVM cs =
   -- Iterate picking one simplifiable constraint and simplifying it
   -- until none are left.
   simplify' ::
-    Members '[State SimplifyState, Fresh, Error SolveError, Output Message, Input TyDefCtx] r =>
+    Members '[State SimplifyState, Fresh, Error SolveError, Output (Message ann), Input TyDefCtx] r =>
     Sem r ()
   simplify' = do
     -- q <- gets fst
@@ -751,7 +751,7 @@ mkConstraintGraph as cs = G.mkGraph nodes (S.fromList cs)
 --   only unsorted variables, just unify them all with the skolem and
 --   remove those components.
 checkSkolems ::
-  Members '[Error SolveError, Output Message, Input TyDefCtx] r =>
+  Members '[Error SolveError, Output (Message ann), Input TyDefCtx] r =>
   TyVarInfoMap ->
   Graph Atom ->
   Sem r (Graph UAtom, S)
@@ -784,7 +784,7 @@ checkSkolems vm graph = do
   noSkolems (AVar (S v)) = error $ "Skolem " ++ show v ++ " remaining in noSkolems"
 
   unifyWCCs ::
-    Members '[Error SolveError, Output Message, Input TyDefCtx] r =>
+    Members '[Error SolveError, Output (Message ann), Input TyDefCtx] r =>
     Graph Atom ->
     S ->
     [Set Atom] ->
@@ -964,7 +964,7 @@ glbBySort vm rm = limBySort vm rm SubTy
 --   predecessors in this case, since it seems nice to default to
 --   "simpler" types lower down in the subtyping chain.
 solveGraph ::
-  Members '[Fresh, Error SolveError, Output Message] r =>
+  Members '[Fresh, Error SolveError, Output (Message ann)] r =>
   TyVarInfoMap ->
   Graph UAtom ->
   Sem r S
@@ -1030,7 +1030,7 @@ solveGraph vm g = atomToTypeSubst . unifyWCC <$> go topRelMap
     fromVar _ = error "Impossible! UB but uisVar."
 
   go ::
-    Members '[Fresh, Error SolveError, Output Message] r =>
+    Members '[Fresh, Error SolveError, Output (Message ann)] r =>
     RelMap ->
     Sem r (Substitution BaseTy)
   go relMap@(RelMap rm) =
diff --git a/src/Disco/Typecheck/Util.hs b/src/Disco/Typecheck/Util.hs
index 1c70dfa0..258d6b9f 100644
--- a/src/Disco/Typecheck/Util.hs
+++ b/src/Disco/Typecheck/Util.hs
@@ -1,6 +1,3 @@
------------------------------------------------------------------------------
-
------------------------------------------------------------------------------
 
 -- |
 -- Module      :  Disco.Typecheck.Util
@@ -148,7 +145,7 @@ withConstraint = fmap swap . runWriter
 --   the resulting substitution (or failing with an error).  Note that
 --   this locally dispatches the constraint writer effect.
 solve ::
-  Members '[Reader TyDefCtx, Error TCError, Output Message] r =>
+  Members '[Reader TyDefCtx, Error TCError, Output (Message ann)] r =>
   Sem (Writer Constraint ': r) a ->
   Sem r (a, S)
 solve m = do
diff --git a/src/Disco/Value.hs b/src/Disco/Value.hs
index 21893e02..e8358117 100644
--- a/src/Disco/Value.hs
+++ b/src/Disco/Value.hs
@@ -460,10 +460,10 @@ set n c = modify $ \(Mem nxt m) -> Mem nxt (IM.insert n c m)
 -- Pretty-printing values
 ------------------------------------------------------------
 
-prettyValue' :: Member (Input TyDefCtx) r => Type -> Value -> Sem r Doc
+prettyValue' :: Member (Input TyDefCtx) r => Type -> Value -> Sem r (Doc ann)
 prettyValue' ty v = runLFresh . runReader initPA $ prettyValue ty v
 
-prettyValue :: Members '[Input TyDefCtx, LFresh, Reader PA] r => Type -> Value -> Sem r Doc
+prettyValue :: Members '[Input TyDefCtx, LFresh, Reader PA] r => Type -> Value -> Sem r (Doc ann)
 -- Lazily expand any user-defined types
 prettyValue (TyUser x args) v = do
   tydefs <- input
@@ -520,23 +520,23 @@ prettyValue ty@TyCon {} v =
 
 -- | Pretty-print a value with guaranteed parentheses.  Do nothing for
 --   tuples; add an extra set of parens for other values.
-prettyVP :: Members '[Input TyDefCtx, LFresh, Reader PA] r => Type -> Value -> Sem r Doc
+prettyVP :: Members '[Input TyDefCtx, LFresh, Reader PA] r => Type -> Value -> Sem r (Doc ann)
 prettyVP ty@(_ :*: _) = prettyValue ty
 prettyVP ty = parens . prettyValue ty
 
-prettyPlaceholder :: Members '[Reader PA, LFresh] r => Type -> Sem r Doc
+prettyPlaceholder :: Members '[Reader PA, LFresh] r => Type -> Sem r (Doc ann)
 prettyPlaceholder ty = "<" <> pretty ty <> ">"
 
-prettyTuple :: Members '[Input TyDefCtx, LFresh, Reader PA] r => Type -> Value -> Sem r Doc
+prettyTuple :: Members '[Input TyDefCtx, LFresh, Reader PA] r => Type -> Value -> Sem r (Doc ann)
 prettyTuple (ty1 :*: ty2) (VPair v1 v2) = prettyValue ty1 v1 <> "," <+> prettyTuple ty2 v2
 prettyTuple ty v = prettyValue ty v
 
 -- | 'prettySequence' pretty-prints a lists of values separated by a delimiter.
-prettySequence :: Members '[Input TyDefCtx, LFresh, Reader PA] r => Type -> Doc -> [Value] -> Sem r Doc
+prettySequence :: Members '[Input TyDefCtx, LFresh, Reader PA] r => Type -> Doc ann -> [Value] -> Sem r (Doc ann)
 prettySequence ty del vs = hsep =<< punctuate (return del) (map (prettyValue ty) vs)
 
 -- | Pretty-print a literal bag value.
-prettyBag :: Members '[Input TyDefCtx, LFresh, Reader PA] r => Type -> [(Value, Integer)] -> Sem r Doc
+prettyBag :: Members '[Input TyDefCtx, LFresh, Reader PA] r => Type -> [(Value, Integer)] -> Sem r (Doc ann)
 prettyBag _ [] = bag empty
 prettyBag ty vs
   | all ((== 1) . snd) vs = bag $ prettySequence ty "," (map fst vs)

From 01ea88ce12a36ed1b8d97253bb5c452c87599180 Mon Sep 17 00:00:00 2001
From: Brent Yorgey <byorgey@gmail.com>
Date: Fri, 3 Nov 2023 21:07:18 -0500
Subject: [PATCH 2/5] finish getting it to build

Tests don't pass yet due to some change in nested/hanging
pretty-printed output.
---
 src/Disco/Interactive/Commands.hs | 56 ++++++++++++++-----------------
 1 file changed, 26 insertions(+), 30 deletions(-)

diff --git a/src/Disco/Interactive/Commands.hs b/src/Disco/Interactive/Commands.hs
index 47174f90..1ce25e8b 100644
--- a/src/Disco/Interactive/Commands.hs
+++ b/src/Disco/Interactive/Commands.hs
@@ -2,10 +2,6 @@
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE StandaloneDeriving #-}
 
------------------------------------------------------------------------------
-
------------------------------------------------------------------------------
-
 -- |
 -- Module      :  Disco.Interactive.Commands
 -- Copyright   :  disco team and contributors
@@ -303,7 +299,7 @@ annCmd =
     }
 
 handleAnn ::
-  Members '[Error DiscoError, Input TopInfo, Output (Message ann)] r =>
+  Members '[Error DiscoError, Input TopInfo, Output (Message ())] r =>
   REPLExpr 'CAnn ->
   Sem r ()
 handleAnn (Ann t) = do
@@ -326,7 +322,7 @@ compileCmd =
     }
 
 handleCompile ::
-  Members '[Error DiscoError, Input TopInfo, Output (Message ann)] r =>
+  Members '[Error DiscoError, Input TopInfo, Output (Message ())] r =>
   REPLExpr 'CCompile ->
   Sem r ()
 handleCompile (Compile t) = do
@@ -349,7 +345,7 @@ desugarCmd =
     }
 
 handleDesugar ::
-  Members '[Error DiscoError, Input TopInfo, LFresh, Output (Message ann)] r =>
+  Members '[Error DiscoError, Input TopInfo, LFresh, Output (Message ())] r =>
   REPLExpr 'CDesugar ->
   Sem r ()
 handleDesugar (Desugar t) = do
@@ -383,7 +379,7 @@ parseDoc =
     <|> (DocOther <$> (sc *> many (anySingleBut ' ')))
 
 handleDoc ::
-  Members '[Error DiscoError, Input TopInfo, LFresh, Output (Message ann)] r =>
+  Members '[Error DiscoError, Input TopInfo, LFresh, Output (Message ())] r =>
   REPLExpr 'CDoc ->
   Sem r ()
 handleDoc (Doc (DocTerm (TBool _))) = handleDocBool
@@ -396,26 +392,26 @@ handleDoc (Doc (DocTerm _)) =
 handleDoc (Doc (DocPrim p)) = handleDocPrim p
 handleDoc (Doc (DocOther s)) = handleDocOther s
 
-handleDocBool :: Members '[Output (Message ann)] r => Sem r ()
+handleDocBool :: Members '[Output (Message ())] r => Sem r ()
 handleDocBool =
   info $
     "true and false (also written True and False) are the two possible values of type Boolean."
       $+$ mkReference "bool"
 
-handleDocUnit :: Members '[Output (Message ann)] r => Sem r ()
+handleDocUnit :: Members '[Output (Message ())] r => Sem r ()
 handleDocUnit =
   info $
     "The unit value, i.e. the single value of type Unit."
       $+$ mkReference "unit"
 
-handleDocWild :: Members '[Output (Message ann)] r => Sem r ()
+handleDocWild :: Members '[Output (Message ())] r => Sem r ()
 handleDocWild =
   info $
     "A wildcard pattern."
       $+$ mkReference "wild-pattern"
 
 handleDocVar ::
-  Members '[Error DiscoError, Input TopInfo, LFresh, Output (Message ann)] r =>
+  Members '[Error DiscoError, Input TopInfo, LFresh, Output (Message ())] r =>
   Name Term ->
   Sem r ()
 handleDocVar x = do
@@ -456,7 +452,7 @@ handleDocVar x = do
           _ -> Pretty.empty
 
 handleDocPrim ::
-  Members '[Error DiscoError, Input TopInfo, LFresh, Output (Message ann)] r =>
+  Members '[Error DiscoError, Input TopInfo, LFresh, Output (Message ())] r =>
   Prim ->
   Sem r ()
 handleDocPrim prim = do
@@ -495,12 +491,12 @@ handleDocPrim prim = do
         , if post then "~" else Pretty.empty
         ]
 
-mkReference :: String -> Sem r Doc
+mkReference :: String -> Sem r (Doc ann)
 mkReference p =
   "https://disco-lang.readthedocs.io/en/latest/reference/" <> text p <> ".html"
 
 handleDocOther ::
-  Members '[Error DiscoError, Input TopInfo, LFresh, Output (Message ann)] r =>
+  Members '[Error DiscoError, Input TopInfo, LFresh, Output (Message ())] r =>
   String ->
   Sem r ()
 handleDocOther s =
@@ -526,7 +522,7 @@ evalCmd =
     }
 
 handleEval ::
-  Members (Error DiscoError ': State TopInfo ': Output (Message ann) ': Embed IO ': EvalEffects) r =>
+  Members (Error DiscoError ': State TopInfo ': Output (Message ()) ': Embed IO ': EvalEffects) r =>
   REPLExpr 'CEval ->
   Sem r ()
 handleEval (Eval m) = do
@@ -537,7 +533,7 @@ handleEval (Eval m) = do
 -- garbageCollect?
 
 -- First argument = should the value be printed?
-evalTerm :: Members (Error EvalError ': State TopInfo ': Output (Message ann) ': EvalEffects) r => Bool -> ATerm -> Sem r Value
+evalTerm :: Members (Error EvalError ': State TopInfo ': Output (Message ()) ': EvalEffects) r => Bool -> ATerm -> Sem r Value
 evalTerm pr at = do
   env <- use @TopInfo topEnv
   v <- runInputConst env $ eval (compileTerm at)
@@ -567,7 +563,7 @@ helpCmd =
     , parser = return Help
     }
 
-handleHelp :: Member (Output (Message ann)) r => REPLExpr 'CHelp -> Sem r ()
+handleHelp :: Member (Output (Message ())) r => REPLExpr 'CHelp -> Sem r ()
 handleHelp Help =
   info $
     vcat
@@ -606,13 +602,13 @@ loadCmd =
 --   in the parent module are executed.
 --   Disco.Interactive.CmdLine uses a version of this function that returns a Bool.
 handleLoadWrapper ::
-  Members (Error DiscoError ': State TopInfo ': Output (Message ann) ': Embed IO ': EvalEffects) r =>
+  Members (Error DiscoError ': State TopInfo ': Output (Message ()) ': Embed IO ': EvalEffects) r =>
   REPLExpr 'CLoad ->
   Sem r ()
 handleLoadWrapper (Load fp) = void (handleLoad fp)
 
 handleLoad ::
-  Members (Error DiscoError ': State TopInfo ': Output (Message ann) ': Embed IO ': EvalEffects) r =>
+  Members (Error DiscoError ': State TopInfo ': Output (Message ()) ': Embed IO ': EvalEffects) r =>
   FilePath ->
   Sem r Bool
 handleLoad fp = do
@@ -640,7 +636,7 @@ handleLoad fp = do
 
 -- XXX Return a structured summary of the results, not a Bool; & move
 -- this somewhere else?
-runAllTests :: Members (Output (Message ann) ': Input TopInfo ': EvalEffects) r => [QName Term] -> Ctx ATerm [AProperty] -> Sem r Bool -- (Ctx ATerm [TestResult])
+runAllTests :: Members (Output (Message ()) ': Input TopInfo ': EvalEffects) r => [QName Term] -> Ctx ATerm [AProperty] -> Sem r Bool -- (Ctx ATerm [TestResult])
 runAllTests declNames aprops
   | Ctx.null aprops = return True
   | otherwise = do
@@ -650,7 +646,7 @@ runAllTests declNames aprops
  where
   numSamples :: Int
   numSamples = 50 -- XXX make this configurable somehow
-  runTests :: Members (Output (Message ann) ': Input TopInfo ': EvalEffects) r => QName Term -> [AProperty] -> Sem r Bool
+  runTests :: Members (Output (Message ()) ': Input TopInfo ': EvalEffects) r => QName Term -> [AProperty] -> Sem r Bool
   runTests (QName _ n) props = do
     results <- inputTopEnv $ traverse (sequenceA . (id &&& runTest numSamples)) props
     let failures = P.filter (not . testIsOk . snd) results
@@ -684,7 +680,7 @@ namesCmd =
 
 -- | Show names and types for each item in the top-level context.
 handleNames ::
-  Members '[Input TopInfo, LFresh, Output (Message ann)] r =>
+  Members '[Input TopInfo, LFresh, Output (Message ())] r =>
   REPLExpr 'CNames ->
   Sem r ()
 handleNames Names = do
@@ -729,7 +725,7 @@ parseCmd =
     , parser = Parse <$> term
     }
 
-handleParse :: Member (Output (Message ann)) r => REPLExpr 'CParse -> Sem r ()
+handleParse :: Member (Output (Message ())) r => REPLExpr 'CParse -> Sem r ()
 handleParse (Parse t) = info (text (show t))
 
 ------------------------------------------------------------
@@ -747,7 +743,7 @@ prettyCmd =
     , parser = Pretty <$> term
     }
 
-handlePretty :: Members '[LFresh, Output (Message ann)] r => REPLExpr 'CPretty -> Sem r ()
+handlePretty :: Members '[LFresh, Output (Message ())] r => REPLExpr 'CPretty -> Sem r ()
 handlePretty (Pretty t) = info $ pretty' t
 
 ------------------------------------------------------------
@@ -765,7 +761,7 @@ printCmd =
     , parser = Print <$> term
     }
 
-handlePrint :: Members (Error DiscoError ': State TopInfo ': Output (Message ann) ': EvalEffects) r => REPLExpr 'CPrint -> Sem r ()
+handlePrint :: Members (Error DiscoError ': State TopInfo ': Output (Message ()) ': EvalEffects) r => REPLExpr 'CPrint -> Sem r ()
 handlePrint (Print t) = do
   at <- inputToState . typecheckTop $ checkTop t (toPolyType TyString)
   v <- mapError EvalErr . evalTerm False $ at
@@ -787,7 +783,7 @@ reloadCmd =
     }
 
 handleReload ::
-  Members (Error DiscoError ': State TopInfo ': Output (Message ann) ': Embed IO ': EvalEffects) r =>
+  Members (Error DiscoError ': State TopInfo ': Output (Message ()) ': Embed IO ': EvalEffects) r =>
   REPLExpr 'CReload ->
   Sem r ()
 handleReload Reload = do
@@ -812,7 +808,7 @@ showDefnCmd =
     }
 
 handleShowDefn ::
-  Members '[Input TopInfo, LFresh, Output (Message ann)] r =>
+  Members '[Input TopInfo, LFresh, Output (Message ())] r =>
   REPLExpr 'CShowDefn ->
   Sem r ()
 handleShowDefn (ShowDefn x) = do
@@ -845,7 +841,7 @@ testPropCmd =
     }
 
 handleTest ::
-  Members (Error DiscoError ': State TopInfo ': Output (Message ann) ': EvalEffects) r =>
+  Members (Error DiscoError ': State TopInfo ': Output (Message ()) ': EvalEffects) r =>
   REPLExpr 'CTestProp ->
   Sem r ()
 handleTest (TestProp t) = do
@@ -871,7 +867,7 @@ typeCheckCmd =
     }
 
 handleTypeCheck ::
-  Members '[Error DiscoError, Input TopInfo, LFresh, Output (Message ann)] r =>
+  Members '[Error DiscoError, Input TopInfo, LFresh, Output (Message ())] r =>
   REPLExpr 'CTypeCheck ->
   Sem r ()
 handleTypeCheck (TypeCheck t) = do

From bd61b297ddd58c5debded7c8161361981ed1b6e3 Mon Sep 17 00:00:00 2001
From: Brent Yorgey <byorgey@gmail.com>
Date: Sat, 11 Nov 2023 13:36:47 -0600
Subject: [PATCH 3/5] progress towards getting tests working again

---
 src/Disco/Error.hs                | 24 ++++++++++++------------
 src/Disco/Interactive/Commands.hs | 18 ++++++++++--------
 src/Disco/Parser.hs               |  4 ----
 src/Disco/Pretty/DSL.hs           | 15 +++++++++++----
 src/Disco/Property.hs             | 15 ++++++++-------
 5 files changed, 41 insertions(+), 35 deletions(-)

diff --git a/src/Disco/Error.hs b/src/Disco/Error.hs
index 423c69e0..c80fbf42 100644
--- a/src/Disco/Error.hs
+++ b/src/Disco/Error.hs
@@ -93,9 +93,9 @@ instance Pretty DiscoError where
     CyclicImport ms -> cyclicImportError ms
     TypeCheckErr (LocTCError Nothing te) -> prettyTCError te
     TypeCheckErr (LocTCError (Just n) te) ->
-      vcat
+      nest 2 $ vcat
         [ "While checking " <> pretty' n <> ":"
-        , nest 2 $ prettyTCError te
+        , prettyTCError te
         ]
     ParseErr pe -> text (errorBundlePretty pe)
     EvalErr ee -> prettyEvalError ee
@@ -116,9 +116,9 @@ cyclicImportError ::
   [ModuleName] ->
   Sem r (Doc ann)
 cyclicImportError ms =
-  vcat
+  nest 2 $ vcat
     [ "Error: module imports form a cycle:"
-    , nest 2 $ intercalate " ->" (map pretty ms)
+    , intercalate " ->" (map pretty ms)
     ]
 
 prettyEvalError :: Members '[Reader PA, LFresh] r => EvalError -> Sem r (Doc ann)
@@ -150,7 +150,7 @@ prettyTCError = \case
   Ambiguous x ms ->
     vcat
       [ "Error: the name" <+> pretty' x <+> "is ambiguous. It could refer to:"
-      , nest 2 (vcat . map (\m -> pretty' m <> "." <> pretty' x) $ ms)
+      , indent 2 . vcat . map (\m -> pretty' m <> "." <> pretty' x) $ ms
       , rtd "ambiguous"
       ]
   NoType x ->
@@ -166,9 +166,9 @@ prettyTCError = \case
   NotCon c t ty ->
     vcat
       [ "Error: the expression"
-      , nest 2 $ pretty' t
+      , indent 2 $ pretty' t
       , "must have both a" <+> conWord c <+> "type and also the incompatible type"
-      , nest 2 $ pretty' ty <> "."
+      , indent 2 $ pretty' ty <> "."
       , rtd "notcon"
       ]
   EmptyCase ->
@@ -179,9 +179,9 @@ prettyTCError = \case
   PatternType c pat ty ->
     vcat
       [ "Error: the pattern"
-      , nest 2 $ pretty' pat
+      , indent 2 $ pretty' pat
       , "is supposed to have type"
-      , nest 2 $ pretty' ty <> ","
+      , indent 2 $ pretty' ty <> ","
       , "but instead it has a" <+> conWord c <+> "type."
       , rtd "pattern-type"
       ]
@@ -220,7 +220,7 @@ prettyTCError = \case
   NoSearch ty ->
     vcat
       [ "Error: the type"
-      , nest 2 $ pretty' ty
+      , indent 2 $ pretty' ty
       , "is not searchable (i.e. it cannot be used in a forall)."
       , rtd "no-search"
       ]
@@ -259,7 +259,7 @@ prettyTCError = \case
   NoPolyRec s ss tys ->
     vcat
       [ "Error: in the definition of " <> text s <> parens (intercalate "," (map text ss)) <> ": recursive occurrences of" <+> text s <+> "may only have type variables as arguments."
-      , nest
+      , indent
           2
           ( text s <> parens (intercalate "," (map pretty' tys)) <+> "does not follow this rule."
           )
@@ -307,7 +307,7 @@ prettySolveError = \case
   QualSkolem q a ->
     vcat
       [ "Error: type variable" <+> pretty' a <+> "represents any type, so we cannot assume values of that type"
-      , nest 2 (qualPhrase True q) <> "."
+      , indent 2 (qualPhrase True q) <> "."
       , rtd "qual-skolem"
       ]
 
diff --git a/src/Disco/Interactive/Commands.hs b/src/Disco/Interactive/Commands.hs
index 1ce25e8b..7c2e63a1 100644
--- a/src/Disco/Interactive/Commands.hs
+++ b/src/Disco/Interactive/Commands.hs
@@ -474,7 +474,7 @@ handleDocPrim prim = do
     (Nothing, Nothing) -> return ()
     (Nothing, Just p) -> info $ mkReference p
     (Just d, mp) ->
-      info $ "" $+$ text d $+$ "" $+$ maybe Pretty.empty (\p -> mkReference p $+$ "") mp
+      info $ Pretty.empty $+$ text d $+$ Pretty.empty $+$ maybe Pretty.empty (\p -> mkReference p $+$ Pretty.empty) mp
  where
   describePrec p = "precedence level" <+> text (show p)
   describeFixity In = Pretty.empty
@@ -504,7 +504,7 @@ handleDocOther s =
     (Nothing, Nothing) -> info $ "No documentation found for '" <> text s <> "'."
     (Nothing, Just p) -> info $ mkReference p
     (Just d, mp) ->
-      info $ text d $+$ "" $+$ maybe Pretty.empty (\p -> mkReference p $+$ "") mp
+      info $ text d $+$ Pretty.empty $+$ maybe Pretty.empty (\p -> mkReference p $+$ Pretty.empty) mp
 
 ------------------------------------------------------------
 -- eval
@@ -653,14 +653,16 @@ runAllTests declNames aprops
         hdr = pretty' n <> ":"
 
     case P.null failures of
-      True -> info $ nest 2 $ hdr <+> "OK"
+      True -> info $ indent 2 $ hdr <+> "OK"
       False -> do
         tydefs <- inputs @TopInfo (view (replModInfo . to allTydefs))
         let prettyFailures =
-              runInputConst tydefs . runReader initPA . runLFresh $
-                bulletList "-" $
-                  map (uncurry prettyTestResult) failures
-        info $ nest 2 $ hdr $+$ prettyFailures
+              runInputConst tydefs
+                . runReader initPA
+                . runLFresh
+                $ bulletList "-"
+                $ map (uncurry prettyTestResult) failures
+        info $ indent 2 $ hdr $+$ prettyFailures
     return (P.null failures)
 
 ------------------------------------------------------------
@@ -849,7 +851,7 @@ handleTest (TestProp t) = do
   tydefs <- use @TopInfo (replModInfo . to allTydefs)
   inputToState . inputTopEnv $ do
     r <- runTest 100 at -- XXX make configurable
-    info $ runInputConst tydefs . runReader initPA $ nest 2 $ "-" <+> prettyTestResult at r
+    info $ runInputConst tydefs . runReader initPA $ indent 2 . nest 2 $ "-" <+> prettyTestResult at r
 
 ------------------------------------------------------------
 -- :type
diff --git a/src/Disco/Parser.hs b/src/Disco/Parser.hs
index 96d2b2d6..196c274e 100644
--- a/src/Disco/Parser.hs
+++ b/src/Disco/Parser.hs
@@ -1,9 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
 
------------------------------------------------------------------------------
-
------------------------------------------------------------------------------
-
 -- |
 -- Module      :  Disco.Parser
 -- Copyright   :  disco team and contributors
diff --git a/src/Disco/Pretty/DSL.hs b/src/Disco/Pretty/DSL.hs
index 226fbde5..dd7a2018 100644
--- a/src/Disco/Pretty/DSL.hs
+++ b/src/Disco/Pretty/DSL.hs
@@ -12,13 +12,14 @@ module Disco.Pretty.DSL where
 
 import Control.Applicative hiding (empty)
 import Data.String (IsString (..))
-import Prelude hiding ((<>))
+import Disco.Pretty.Prec
 import Polysemy
 import Polysemy.Reader
 import Prettyprinter (Doc)
-import Prettyprinter.Render.String (renderString)
 import qualified Prettyprinter as PP
-import Disco.Pretty.Prec
+import Prettyprinter.Internal (Doc (Empty)) -- XXX comment me
+import Prettyprinter.Render.String (renderString)
+import Prelude hiding ((<>))
 
 instance IsString (Sem r (Doc ann)) where
   fromString = text
@@ -65,6 +66,9 @@ integer = pure . PP.pretty
 nest :: Functor f => Int -> f (Doc ann) -> f (Doc ann)
 nest n d = PP.nest n <$> d
 
+indent :: Functor f => Int -> f (Doc ann) -> f (Doc ann)
+indent n d = PP.indent n <$> d
+
 hang :: Applicative f => f (Doc ann) -> Int -> f (Doc ann) -> f (Doc ann)
 hang d1 n d2 = d1 <+> nest n d2
 
@@ -78,7 +82,10 @@ empty = pure PP.emptyDoc
 (<>) = liftA2 (PP.<>)
 
 ($+$) :: Applicative f => f (Doc ann) -> f (Doc ann) -> f (Doc ann)
-d1 $+$ d2 = PP.vcat <$> sequenceA [d1,d2]
+d1 $+$ d2 = f <$> d1 <*> d2
+ where
+  f x1 Empty = x1
+  f x1 x2 = PP.vcat [x1, x2]
 
 punctuate :: Applicative f => f (Doc ann) -> [f (Doc ann)] -> f [f (Doc ann)]
 punctuate p ds = map pure <$> (PP.punctuate <$> p <*> sequenceA ds)
diff --git a/src/Disco/Property.hs b/src/Disco/Property.hs
index 93e876ba..c3edd902 100644
--- a/src/Disco/Property.hs
+++ b/src/Disco/Property.hs
@@ -90,9 +90,9 @@ prettyTestReason ::
   TestReason ->
   Sem r (Doc ann)
 prettyTestReason _ _ TestBool = empty
-prettyTestReason b prop (TestFound (TestResult _ tr env))
+prettyTestReason b _ (TestFound (TestResult _ _ env))
   | b = prettyTestEnv "Found example:" env
-  | not b = prettyTestReason b prop tr $+$ prettyTestEnv "Found counterexample:" env
+  | not b = prettyTestEnv "Found counterexample:" env
 prettyTestReason b _ (TestNotFound Exhaustive)
   | b = "No counterexamples exist; all possible values were checked."
   | not b = "No example exists; all possible values were checked."
@@ -112,16 +112,17 @@ prettyTestReason _ _ (TestLt t a1 a2) =
     , "Right side: " <> prettyValue t a2
     ]
 prettyTestReason _ _ (TestRuntimeError ee) =
-  "Test failed with an error:"
-    $+$ nest 2 (pretty (EvalErr ee))
+  nest 2 $
+    "Test failed with an error:"
+      $+$ pretty (EvalErr ee)
 -- \$+$
 -- prettyTestEnv "Example inputs that caused the error:" env
 -- See #364
 prettyTestReason b (ATApp _ (ATPrim _ (PrimBOp _)) (ATTup _ [p1, p2])) (TestBin _ tr1 tr2) =
   bulletList
     "-"
-    [ "Left side:" $+$ nest 2 (prettyTestResult' b p1 tr1)
-    , "Right side:" $+$ nest 2 (prettyTestResult' b p2 tr2)
+    [ nest 2 $ "Left side:" $+$ prettyTestResult' b p1 tr1
+    , nest 2 $ "Right side:" $+$ prettyTestResult' b p2 tr2
     ]
 -- See Note [prettyTestReason fallback]
 prettyTestReason _ _ _ = empty
@@ -169,7 +170,7 @@ prettyTestEnv ::
   TestEnv ->
   Sem r (Doc ann)
 prettyTestEnv _ (TestEnv []) = empty
-prettyTestEnv s (TestEnv vs) = text s $+$ nest 2 (vcat (map prettyBind vs))
+prettyTestEnv s (TestEnv vs) = nest 2 $ text s $+$ vcat (map prettyBind vs)
  where
   maxNameLen = maximum . map (\(n, _, _) -> length n) $ vs
   prettyBind (x, ty, v) =

From ff8817211dd0fbcf17950dc5528fc241c3c427de Mon Sep 17 00:00:00 2001
From: Brent Yorgey <byorgey@gmail.com>
Date: Wed, 15 Nov 2023 21:50:14 -0600
Subject: [PATCH 4/5] more progress, handle some blank line issues

---
 src/Disco/Interactive/Commands.hs | 52 +++++++++++++++++++------------
 src/Disco/Pretty.hs               | 12 +++----
 2 files changed, 36 insertions(+), 28 deletions(-)

diff --git a/src/Disco/Interactive/Commands.hs b/src/Disco/Interactive/Commands.hs
index 7c2e63a1..68409000 100644
--- a/src/Disco/Interactive/Commands.hs
+++ b/src/Disco/Interactive/Commands.hs
@@ -80,7 +80,7 @@ import Disco.Parser (
   withExts,
  )
 import Disco.Pretty hiding (empty, (<>))
-import qualified Disco.Pretty as Pretty
+import qualified Disco.Pretty as PP
 import Disco.Property (prettyTestResult)
 import Disco.Syntax.Operators
 import Disco.Syntax.Prims (
@@ -443,13 +443,13 @@ handleDocVar x = do
       hsep [pretty' x, ":", pretty' ty]
         $+$ case Ctx.lookup' qn docMap of
           Just (DocString ss : _) -> vcat (text "" : map text ss ++ [text ""])
-          _ -> Pretty.empty
+          _ -> PP.empty
   showDoc docMap (Right tdBody) =
     info $
       pretty' (name2String x, tdBody)
         $+$ case Ctx.lookupAll' x docMap of
           ((_, DocString ss : _) : _) -> vcat (text "" : map text ss ++ [text ""])
-          _ -> Pretty.empty
+          _ -> PP.empty
 
 handleDocPrim ::
   Members '[Error DiscoError, Input TopInfo, LFresh, Output (Message ())] r =>
@@ -457,38 +457,45 @@ handleDocPrim ::
   Sem r ()
 handleDocPrim prim = do
   handleTypeCheck (TypeCheck (TPrim prim))
-  info $
-    vcat
-      [ case prim of
+  info
+    . vcat
+    $ ( case prim of
           PrimUOp u -> describeAlts (f == Post) (f == Pre) syns
            where
             OpInfo (UOpF f _) syns _ = uopMap ! u
           PrimBOp b -> describeAlts True True (opSyns $ bopMap ! b)
-          _ -> Pretty.empty
-      , case prim of
-          PrimUOp u -> describePrec (uPrec u)
-          PrimBOp b -> describePrec (bPrec b) <> describeFixity (assoc b)
-          _ -> Pretty.empty
-      ]
+          _ -> []
+      )
+      ++ ( case prim of
+            PrimUOp u -> [describePrec (uPrec u)]
+            PrimBOp b -> [describePrec (bPrec b) <> describeFixity (assoc b)]
+            _ -> []
+         )
   case (M.lookup prim primDoc, M.lookup prim primReference) of
     (Nothing, Nothing) -> return ()
     (Nothing, Just p) -> info $ mkReference p
     (Just d, mp) ->
-      info $ Pretty.empty $+$ text d $+$ Pretty.empty $+$ maybe Pretty.empty (\p -> mkReference p $+$ Pretty.empty) mp
+      info $
+        vcat
+          [ PP.empty
+          , text d
+          , PP.empty
+          , maybe PP.empty (\p -> vcat [mkReference p, PP.empty]) mp
+          ]
  where
   describePrec p = "precedence level" <+> text (show p)
-  describeFixity In = Pretty.empty
+  describeFixity In = PP.empty
   describeFixity InL = ", left associative"
   describeFixity InR = ", right associative"
-  describeAlts _ _ [] = Pretty.empty
-  describeAlts _ _ [_] = Pretty.empty
-  describeAlts pre post (_ : alts) = "Alternative syntax:" <+> intercalate "," (map showOp alts)
+  describeAlts _ _ [] = []
+  describeAlts _ _ [_] = []
+  describeAlts pre post (_ : alts) = ["Alternative syntax:" <+> intercalate "," (map showOp alts)]
    where
     showOp op =
       hcat
-        [ if pre then "~" else Pretty.empty
+        [ if pre then "~" else PP.empty
         , text op
-        , if post then "~" else Pretty.empty
+        , if post then "~" else PP.empty
         ]
 
 mkReference :: String -> Sem r (Doc ann)
@@ -504,7 +511,12 @@ handleDocOther s =
     (Nothing, Nothing) -> info $ "No documentation found for '" <> text s <> "'."
     (Nothing, Just p) -> info $ mkReference p
     (Just d, mp) ->
-      info $ text d $+$ Pretty.empty $+$ maybe Pretty.empty (\p -> mkReference p $+$ Pretty.empty) mp
+      info $
+        vcat
+          [ text d
+          , PP.empty
+          , maybe PP.empty (\p -> vcat [mkReference p, PP.empty]) mp
+          ]
 
 ------------------------------------------------------------
 -- eval
diff --git a/src/Disco/Pretty.hs b/src/Disco/Pretty.hs
index 522e4b71..bcc47ed7 100644
--- a/src/Disco/Pretty.hs
+++ b/src/Disco/Pretty.hs
@@ -2,10 +2,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE NoMonomorphismRestriction #-}
 
------------------------------------------------------------------------------
-
------------------------------------------------------------------------------
-
 -- TODO: the calls to 'error' should be replaced with logging/error capabilities.
 
 -- |
@@ -34,13 +30,13 @@ import Data.Ratio
 import Data.Set (Set)
 import qualified Data.Set as S
 import Disco.Effects.LFresh
-import Polysemy
-import Polysemy.Reader
-import Unbound.Generics.LocallyNameless (Name)
-import Prettyprinter (Doc)
 import Disco.Pretty.DSL
 import Disco.Pretty.Prec
 import Disco.Syntax.Operators
+import Polysemy
+import Polysemy.Reader
+import Prettyprinter (Doc)
+import Unbound.Generics.LocallyNameless (Name)
 
 ------------------------------------------------------------
 -- Utilities for handling precedence and associativity

From 14d48254a10f4cc9c141b2c2fc9cbc7683e1dd4b Mon Sep 17 00:00:00 2001
From: Brent Yorgey <byorgey@gmail.com>
Date: Mon, 27 Nov 2023 20:54:41 -0600
Subject: [PATCH 5/5] finish refactor

---
 src/Disco/AST/Core.hs           | 20 +++++++++-----------
 test/compile-misc/expected      |  6 +++---
 test/repl-proptest/expected     |  2 --
 test/types-char-string/expected |  2 +-
 4 files changed, 13 insertions(+), 17 deletions(-)

diff --git a/src/Disco/AST/Core.hs b/src/Disco/AST/Core.hs
index 7cc8c107..877373ff 100644
--- a/src/Disco/AST/Core.hs
+++ b/src/Disco/AST/Core.hs
@@ -291,17 +291,15 @@ instance Pretty Core where
     CCase c l r -> do
       lunbind l $ \(x, lc) -> do
         lunbind r $ \(y, rc) -> do
-          "case"
-            <+> pretty c
-            <+> "of {"
-            $+$ nest
-              2
-              ( vcat
-                  [ withPA funPA $ "left" <+> rt (pretty x) <+> "->" <+> pretty lc
-                  , withPA funPA $ "right" <+> rt (pretty y) <+> "->" <+> pretty rc
-                  ]
-              )
-            $+$ "}"
+          nest 2 $
+            "case"
+              <+> pretty c
+              <+> "of {"
+              $+$ vcat
+                [ withPA funPA $ "left" <+> rt (pretty x) <+> "->" <+> pretty lc
+                , withPA funPA $ "right" <+> rt (pretty y) <+> "->" <+> pretty rc
+                ]
+              $+$ "}"
     CUnit -> "unit"
     CPair c1 c2 -> setPA initPA $ parens (pretty c1 <> ", " <> pretty c2)
     CProj s c -> withPA funPA $ selectSide s "fst" "snd" <+> rt (pretty c)
diff --git a/test/compile-misc/expected b/test/compile-misc/expected
index 4cd50107..eafae62e 100644
--- a/test/compile-misc/expected
+++ b/test/compile-misc/expected
@@ -2,8 +2,8 @@ holds (∀ℕ. (λarg0. (λ_. (λk. (λx. test [(x, ℕ, x)] (3 < x)) arg0) (λ_
 λx, y. x
 (λ_. (λk. (λy. (λp, q. p) (fst y) (snd y)) (frac (2 / 3))) (λ_1. matchErr)) unit
 (λ_. (λk. case (3 < 2) of {
-            left _1 -> k unit
-            right px -> (λ_2. 1) px
-          }) (λ_1. (λk. 17) (λ_2. matchErr))) unit
+  left _1 -> k unit
+  right px -> (λ_2. 1) px
+  }) (λ_1. (λk. 17) (λ_2. matchErr))) unit
 (10 choose right (5, left unit))
 5!
diff --git a/test/repl-proptest/expected b/test/repl-proptest/expected
index 4fcdf0a7..52a7b04e 100644
--- a/test/repl-proptest/expected
+++ b/test/repl-proptest/expected
@@ -7,8 +7,6 @@
       a = false
       b = false
   - Certainly false: ∀a, b. (a /\ b) =!= (a \/ b)
-    - Left side:  false
-    - Right side: true
     Found counterexample:
       a = false
       b = true
diff --git a/test/types-char-string/expected b/test/types-char-string/expected
index 62bf6a20..c8da8ccd 100644
--- a/test/types-char-string/expected
+++ b/test/types-char-string/expected
@@ -12,7 +12,7 @@ true
 2
 3
 (λx. {? 1 when x is 'a' 
-     ?})("Disco")
+?})("Disco")
 1:3:
   |
 1 | ' a'