Fix span annotations on handle-with blocks

Author: ChrisPenner

parser-typechecker/src/Unison/Syntax/TermParser.hs

@@ -352,9 +352,12 @@ lam p = label "lambda" $ mkLam <$> P.try (some prefixDefinitionName <* reserved
 letBlock, handle, ifthen :: (Monad m, Var v) => TermP v m
 letBlock = label "let" $ (snd <$> block "let")
 handle = label "handle" do
-  (_spanAnn, b) <- block "handle"
-  (_spanAnn, handler) <- block "with"
-  pure $ Term.handle (ann b) handler b
+  (handleSpan, b) <- block "handle"
+  (_withSpan, handler) <- block "with"
+  -- We don't use the annotation span from 'with' here because it will
+  -- include a dedent if it's at the end of block.
+  -- Meaning the newline gets overwritten when pretty-printing and it messes things up.
+  pure $ Term.handle (handleSpan <> ann handler) handler b
 
 checkCasesArities :: (Ord v, Annotated a) => NonEmpty (Int, a) -> P v m (Int, NonEmpty a)
 checkCasesArities cases@((i, _) NonEmpty.:| rest) =

unison-src/transcripts/formatter.md

@@ -38,6 +38,19 @@ ability Thing where
   more  : Nat -> Text -> Nat
   doThing  : Nat -> Int
 
+
+{{ Ability with single constructor }}
+structural ability Ask a where 
+  ask : {Ask a} a
+
+-- Regression test for: https://github.com/unisonweb/unison/issues/4666
+provide : a -> '{Ask a} r -> r
+provide a action = 
+  h = cases
+        {ask -> resume} -> handle resume a with h
+        {r} -> r
+  handle !action with h
+
 {{ 
 A Doc before a type 
 }}

unison-src/transcripts/formatter.output.md

@@ -34,6 +34,19 @@ ability Thing where
   more  : Nat -> Text -> Nat
   doThing  : Nat -> Int
 
+
+{{ Ability with single constructor }}
+structural ability Ask a where 
+  ask : {Ask a} a
+
+-- Regression test for: https://github.com/unisonweb/unison/issues/4666
+provide : a -> '{Ask a} r -> r
+provide a action = 
+  h = cases
+        {ask -> resume} -> handle resume a with h
+        {r} -> r
+  handle !action with h
+
 {{ 
 A Doc before a type 
 }}
@@ -86,6 +99,18 @@ ability Thing where
   more : Nat -> Text ->{Thing} Nat
   doThing : Nat ->{Thing} Int
 
+
+Ask.doc = {{ Ability with single constructor }}
+structural ability Ask a where ask : {Ask a} a
+
+-- Regression test for: https://github.com/unisonweb/unison/issues/4666
+provide : a -> '{Ask a} r -> r
+provide a action =
+  h = cases
+    { ask -> resume } -> handle resume a with h
+    { r }             -> r
+  handle !action with h
+
 Optional.doc = {{ A Doc before a type }}
 structural type Optional a = More Text | Some | Other a | None Nat