chore: remove adaptExcept

src/Init/Control/EState.lean

@@ -92,9 +92,6 @@ fun s => match x s with
   | Result.error e s => Result.error (f e) s
   | Result.ok a s    => Result.ok a s
 
-instance monadExceptAdapter {ε ε' σ} : MonadExceptAdapter ε ε' (EStateM ε σ) (EStateM ε' σ) :=
-⟨fun α f x => adaptExcept f x⟩
-
 @[inline] protected def bind (x : EStateM ε σ α) (f : α → EStateM ε σ β) : EStateM ε σ β :=
 fun s => match x s with
   | Result.ok a s    => f a s

src/Init/Control/Except.lean

@@ -178,27 +178,6 @@ catch t₁ $ fun e₁ => catch t₂ $ fun e₂ => throw (if useFirstEx then e₁
 
 end MonadExcept
 
-/-- Adapt a Monad stack, changing its top-most error Type.
-
-    Note: This class can be seen as a simplification of the more "principled" definition
-    ```
-    class MonadExceptFunctor (ε ε' : outParam (Type u)) (n n' : Type u → Type u) :=
-    (map {α : Type u} : (∀ {m : Type u → Type u} [Monad m], ExceptT ε m α → ExceptT ε' m α) → n α → n' α)
-    `` -/
-class MonadExceptAdapter (ε ε' : outParam (Type u)) (m m' : Type u → Type v) :=
-(adaptExcept {α : Type u} : (ε → ε') → m α → m' α)
-export MonadExceptAdapter (adaptExcept)
-
-section
-variables {ε ε' : Type u} {m m' : Type u → Type v}
-
-instance monadExceptAdapterTrans {n n' : Type u → Type v} [MonadExceptAdapter ε ε' m m'] [MonadFunctor m m' n n'] : MonadExceptAdapter ε ε' n n' :=
-⟨fun α f => monadMap (fun α => (adaptExcept f : m α → m' α))⟩
-
-instance [Monad m] : MonadExceptAdapter ε ε' (ExceptT ε m) (ExceptT ε' m) :=
-⟨fun α => ExceptT.adapt⟩
-end
-
 @[inline] def observing {ε α : Type u} {m : Type u → Type v} [Monad m] [MonadExcept ε m] (x : m α) : m (Except ε α) :=
 catch (do a ← x; pure (Except.ok a)) (fun ex => pure (Except.error ex))
 

src/Init/System/IO.lean

@@ -28,9 +28,6 @@ def IO.RealWorld : Type := Unit
 -/
 def EIO (ε : Type) : Type → Type := EStateM ε IO.RealWorld
 
-instance {ε ε'} : MonadExceptAdapter ε ε' (EIO ε) (EIO ε') :=
-  inferInstanceAs $ MonadExceptAdapter ε ε' (EStateM ε IO.RealWorld) (EStateM ε' IO.RealWorld)
-
 @[inline] def EIO.catchExceptions {α ε} (x : EIO ε α) (h : ε → EIO Empty α) : EIO Empty α :=
   fun s => match x s with
   | EStateM.Result.ok a s     => EStateM.Result.ok a s
@@ -84,9 +81,6 @@ instance (m n) [MonadIO m] [MonadLift m n] : MonadIO n :=
 instance : MonadIO IO :=
 { liftIO := id }
 
-@[inline] def mkEIOMonadIO {ε ε'} [MonadIO (EIO ε)] (f : ε → ε') : MonadIO (EIO ε') :=
-  { liftIO := fun x => adaptExcept f (liftIO x : EIO ε _) }
-
 namespace IO
 
 def ofExcept {ε α : Type} [HasToString ε] (e : Except ε α) : IO α :=

src/Lean/CoreM.lean

@@ -63,7 +63,7 @@ instance : MonadRecDepth CoreM := {
 
 @[inline] def liftIOCore {α} (x : IO α) : CoreM α := do
   let ref ← getRef
-  liftM (adaptExcept (fun (err : IO.Error) => Exception.error ref (toString err)) x : EIO Exception α)
+  IO.toEIO (fun (err : IO.Error) => Exception.error ref (toString err)) x
 
 instance : MonadIO CoreM := {
   liftIO := @liftIOCore
@@ -97,7 +97,7 @@ def mkFreshUserName {m} [MonadLiftT CoreM m] (n : Name) : m Name :=
 instance {α} [MetaHasEval α] : MetaHasEval (CoreM α) := {
   eval := fun env opts x _ => do
     let x : CoreM α := do try x finally printTraces
-    let (a, s) ← x.toIO { maxRecDepth := getMaxRecDepth opts, options := opts } { env := env}
+    let (a, s) ← x.toIO { maxRecDepth := getMaxRecDepth opts, options := opts } { env := env }
     MetaHasEval.eval s.env opts a (hideUnit := true)
 }
 
@@ -106,17 +106,17 @@ end Core
 export Core (CoreM mkFreshUserName)
 
 @[inline] def catchInternalId {α} {m : Type → Type} [Monad m] [MonadExcept Exception m] (id : InternalExceptionId) (x : m α) (h : Exception → m α) : m α := do
-try
-  x
-catch ex => match ex with
-  | Exception.error _ _    => throw ex
-  | Exception.internal id' => if id == id' then h ex else throw ex
+  try
+    x
+  catch ex => match ex with
+    | Exception.error _ _    => throw ex
+    | Exception.internal id' => if id == id' then h ex else throw ex
 
 @[inline] def catchInternalIds {α} {m : Type → Type} [Monad m] [MonadExcept Exception m] (ids : List InternalExceptionId) (x : m α) (h : Exception → m α) : m α := do
-try
-  x
-catch ex => match ex with
-  | Exception.error _ _   => throw ex
-  | Exception.internal id => if ids.contains id then h ex else throw ex
+  try
+    x
+  catch ex => match ex with
+    | Exception.error _ _   => throw ex
+    | Exception.internal id => if ids.contains id then h ex else throw ex
 
 end Lean

src/Lean/Elab/Command.lean

@@ -115,7 +115,7 @@ private def ioErrorToMessage (ctx : Context) (ref : Syntax) (err : IO.Error) : M
 
 @[inline] def liftIO {α} (x : IO α) : CommandElabM α := do
   let ctx ← read
-  liftEIO $ adaptExcept (fun (ex : IO.Error) => Exception.error ctx.ref ex.toString) x
+  IO.toEIO (fun (ex : IO.Error) => Exception.error ctx.ref ex.toString) x
 
 instance : MonadIO CommandElabM := { liftIO := liftIO }
 

src/Lean/PrettyPrinter.lean

@@ -44,14 +44,19 @@ parenthesize Lean.Parser.Module.module.parenthesizer stx >>= format Lean.Parser.
 
 private partial def noContext : MessageData → MessageData
 | MessageData.withContext ctx msg => noContext msg
+| MessageData.withNamingContext ctx msg => MessageData.withNamingContext ctx (noContext msg)
+| MessageData.nest n msg => MessageData.nest n (noContext msg)
+| MessageData.group msg  => MessageData.group (noContext msg)
+| MessageData.compose msg₁ msg₂ => MessageData.compose (noContext msg₁) (noContext msg₂)
+| MessageData.tagged tag msg => MessageData.tagged tag (noContext msg)
+| MessageData.node msgs => MessageData.node (msgs.map noContext)
 | msg => msg
 
 -- strip context (including environments with registered pretty printers) to prevent infinite recursion when pretty printing pretty printer error
-private def withoutContext {m} [MonadExceptAdapter Exception Exception m m] (x : m Format) : m Format :=
-adaptExcept (fun ex => match ex with
-  | Exception.error ref msg => Exception.error ref (noContext msg)
-  | e                       => e)
-  x
+private def withoutContext {m} [MonadExcept Exception m] (x : m Format) : m Format :=
+«catch» x fun
+  | Exception.error ref msg => throw $ Exception.error ref (noContext msg)
+  | ex                      => throw ex
 
 builtin_initialize
   ppFnsRef.set {

src/Lean/Server/Snapshots.lean

@@ -92,11 +92,10 @@ def compileNextCmd (contents : String) (snap : Snapshot) : IO (Sum Snapshot Mess
         fileName := inputCtx.fileName,
         fileMap := inputCtx.fileMap
       }
-    adaptExcept
-      ioErrorFromEmpty
-      (Elab.Command.catchExceptions
+    EIO.toIO ioErrorFromEmpty $
+      Elab.Command.catchExceptions
         (Elab.Command.elabCommand cmdStx)
-        cmdCtx cmdStateRef)
+        cmdCtx cmdStateRef
     let postCmdState ← cmdStateRef.get
     let postCmdSnap : Snapshot := {
         beginPos := cmdPos,