⅄ trunk → 22-10-18-backticky-parser

codebase2/core/Unison/NameSegment.hs

@@ -30,6 +30,11 @@ instance Show NameSegment where
 
 -- | Convert a name segment to unescaped text.
 --
+-- You might use this when storing a name segment as text in a database, where the literal name segment bytes are all
+-- that matter. However, you wouldn't use this to display the name segment to a user - that depends on concrete syntax.
+-- See Unison.Syntax.NameSegment (or indeed, some actual yet-built interface that abstracts concrete syntax) for that
+-- kind of function.
+--
 -- > toUnescapedText (unsafeFromText ".~") = ".~"
 toUnescapedText :: NameSegment -> Text
 toUnescapedText =

docs/release-steps.md

@@ -46,44 +46,36 @@ Smoke test of the new release. Try `brew upgrade unison-language`, launch it, la
 
 ## 4
 
-Announce on #general Slack channel. Template below.
+Announce on #general Discord channel. Template below.
 
 ---
 
-Release announcement template (be sure to update the release urls) -
+We've just released a new version of Unison, $RELEASE_NAME.
 
-We've just released a new version of Unison, $RELEASE_NAME, release notes here (link to the issue). Install/upgrade instructions in the thread.
+---
 
-Mac upgrade is just `brew upgrade unison-language`.
+**macOS or Linux w/ Homebrew:**
+Install or upgrade is just `brew install unisonweb/unison/unison-language`.
 
-A fresh install via:
+If you have previously done `brew install unison-language --head` to install a dev build, uninstall that first via `brew uninstall unison-language`.
 
+**macOS or Linux manual install:**
+macOS
 ```
-brew tap unisonweb/unison
-brew install unison-language
+mkdir -p unisonlanguage && cd unisonlanguage
+curl -L https://github.com/unisonweb/unison/releases/latest/download/ucm-macos.tar.gz \
+  | tar -xz
+./ucm
+```
+Linux
+```
+mkdir -p unisonlanguage && cd unisonlanguage
+curl -L https://github.com/unisonweb/unison/releases/latest/download/ucm-linux.tar.gz \
+    | tar -xz
+./ucm
 ```
 
-If you have previously done brew install unison-language --head to install a dev build, uninstall that first via brew uninstall unison-language.
-
-_Linux manual install:_
-
-```
-mkdir unisonlanguage
-curl -L https://github.com/unisonweb/unison/releases/download/release%2FM2h/ucm-linux.tar.gz --output unisonlanguage/ucm.tar.gz
-tar -xzf unisonlanguage/ucm.tar.gz -C unisonlanguage
-./unisonlanguage/ucm
-```
-
-_Mac manual install:_
-
-```
-mkdir unisonlanguage
-curl -L https://github.com/unisonweb/unison/releases/download/release%2FM2h/ucm-macos.tar.gz --output unisonlanguage/ucm.tar.gz
-tar -xzf unisonlanguage/ucm.tar.gz -C unisonlanguage
-./unisonlanguage/ucm
-```
-
-_Windows manual install:_
+**Windows manual install:**
 * Recommended: [Set your default Terminal application](https://devblogs.microsoft.com/commandline/windows-terminal-as-your-default-command-line-experience/) to “Windows Terminal”.
 * Download [the release](https://github.com/unisonweb/unison/releases/download/release%2FM5h/ucm-windows.zip) and extract it to a location of your choosing.
 * Run `ucm.exe`

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

@@ -351,9 +351,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-cli/src/Unison/Codebase/Editor/HandleInput.hs

@@ -67,6 +67,7 @@ import Unison.Codebase.Editor.HandleInput.Branch (handleBranch)
 import Unison.Codebase.Editor.HandleInput.BranchRename (handleBranchRename)
 import Unison.Codebase.Editor.HandleInput.Branches (handleBranches)
 import Unison.Codebase.Editor.HandleInput.DebugDefinition qualified as DebugDefinition
+import Unison.Codebase.Editor.HandleInput.DebugFoldRanges qualified as DebugFoldRanges
 import Unison.Codebase.Editor.HandleInput.DeleteBranch (handleDeleteBranch)
 import Unison.Codebase.Editor.HandleInput.DeleteProject (handleDeleteProject)
 import Unison.Codebase.Editor.HandleInput.EditNamespace (handleEditNamespace)
@@ -1144,6 +1145,8 @@ loop e = do
               for_ (Relation.toList . Branch.deepTerms $ rootBranch0) \(r, name) ->
                 traceM $ show name ++ ",Term," ++ Text.unpack (Referent.toText r)
             DebugTermI isVerbose hqName -> DebugDefinition.debugTerm isVerbose hqName
+            DebugLSPFoldRangesI -> do
+              DebugFoldRanges.debugFoldRanges
             DebugTypeI hqName -> DebugDefinition.debugDecl hqName
             DebugClearWatchI {} ->
               Cli.runTransaction Codebase.clearWatches
@@ -1363,6 +1366,7 @@ inputDescription input =
         then pure ("debug.term.verbose " <> HQ.toText hqName)
         else pure ("debug.term " <> HQ.toText hqName)
     DebugTypeI hqName -> pure ("debug.type " <> HQ.toText hqName)
+    DebugLSPFoldRangesI -> pure "debug.lsp.fold-ranges"
     DebugNameDiffI {} -> wat
     DebugNumberedArgsI {} -> wat
     DebugTabCompletionI _input -> wat

unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugFoldRanges.hs

@@ -0,0 +1,61 @@
+module Unison.Codebase.Editor.HandleInput.DebugFoldRanges (debugFoldRanges) where
+
+import Control.Lens
+import Control.Monad.Reader
+import Data.Text qualified as Text
+import Language.LSP.Protocol.Lens
+import Language.LSP.Protocol.Types qualified as LSP
+import Unison.Cli.Monad (Cli)
+import Unison.Cli.Monad qualified as Cli
+import Unison.Cli.MonadUtils qualified as Cli
+import Unison.Codebase.Editor.HandleInput.FormatFile (TextReplacement (..))
+import Unison.Codebase.Editor.HandleInput.FormatFile qualified as FormatFile
+import Unison.Codebase.Editor.Output
+import Unison.LSP.Conversions qualified as CV
+import Unison.LSP.FoldingRange (foldingRangesForFile)
+import Unison.Prelude
+import Unison.Util.Range qualified as U
+
+debugFoldRanges :: Cli ()
+debugFoldRanges = do
+  Cli.Env {loadSource} <- ask
+  (filePath, _) <- Cli.expectLatestFile
+  parsedFile <- Cli.expectLatestParsedFile
+  let foldingRanges =
+        foldingRangesForFile parsedFile
+          & fmap
+            ( \fr ->
+                LSP.Range
+                  (LSP.Position (fr ^. startLine) (fromMaybe 0 $ fr ^. startCharacter))
+                  ( case (fr ^. endCharacter) of
+                      Just c -> LSP.Position (fr ^. endLine) c
+                      -- If there's no end char specified, go all the way to the beginning of the next line
+                      Nothing -> LSP.Position ((fr ^. endLine) + 1) 0
+                  )
+            )
+  sourceTxt <-
+    liftIO (loadSource (Text.pack filePath)) >>= \case
+      Cli.InvalidSourceNameError -> Cli.returnEarly $ InvalidSourceName filePath
+      Cli.LoadError -> Cli.returnEarly $ SourceLoadFailed filePath
+      Cli.LoadSuccess contents -> pure contents
+  Cli.respond $ AnnotatedFoldRanges $ annotateRanges sourceTxt foldingRanges
+
+-- | Annotate the bounds of a range within text using 《 and 》.
+--
+-- Useful for checking that computed ranges make sense against the source text.
+--
+-- >>> annotateRanges "one\ntwo\nthree\nfour" [ LSP.Range (LSP.Position 1 0) (LSP.Position 2 3) ]
+-- "one\n\12298two\nthr\12299ee\nfour"
+annotateRanges :: Text -> [LSP.Range] -> Text
+annotateRanges txt ranges =
+  let replacements =
+        ranges
+          & foldMap
+            ( \(LSP.Range start end) ->
+                let startPos = CV.lspToUPos start
+                    endPos = CV.lspToUPos end
+                 in [ TextReplacement "《" (U.Range startPos startPos),
+                      TextReplacement "》" (U.Range endPos endPos)
+                    ]
+            )
+   in FormatFile.applyTextReplacements replacements txt

unison-cli/src/Unison/Codebase/Editor/Input.hs

@@ -222,6 +222,7 @@ data Input
   | DebugDumpNamespaceSimpleI
   | DebugTermI (Bool {- Verbose mode -}) (HQ.HashQualified Name)
   | DebugTypeI (HQ.HashQualified Name)
+  | DebugLSPFoldRangesI
   | DebugClearWatchI
   | DebugDoctorI
   | DebugNameDiffI ShortCausalHash ShortCausalHash

unison-cli/src/Unison/Codebase/Editor/Output.hs

@@ -327,6 +327,7 @@ data Output
   | DebugFuzzyOptionsNoResolver
   | DebugTerm (Bool {- verbose mode -}) (Either (Text {- A builtin hash -}) (Term Symbol Ann))
   | DebugDecl (Either (Text {- A builtin hash -}) (DD.Decl Symbol Ann)) (Maybe ConstructorId {- If 'Just' we're debugging a constructor of the given decl -})
+  | AnnotatedFoldRanges Text
   | ClearScreen
   | PulledEmptyBranch (ReadRemoteNamespace Share.RemoteProjectBranch)
   | CreatedProject Bool {- randomly-generated name? -} ProjectName
@@ -574,6 +575,7 @@ isFailure o = case o of
   DebugFuzzyOptionsNoResolver {} -> True
   DebugTerm {} -> False
   DebugDecl {} -> False
+  AnnotatedFoldRanges {} -> False
   DisplayDebugNameDiff {} -> False
   ClearScreen -> False
   PulledEmptyBranch {} -> False

unison-cli/src/Unison/CommandLine/FZFResolvers.hs

@@ -4,6 +4,7 @@ module Unison.CommandLine.FZFResolvers
     termDefinitionOptions,
     typeDefinitionOptions,
     namespaceOptions,
+    projectDependencyResolver,
     projectNameOptions,
     projectBranchOptions,
     projectBranchOptionsWithinCurrentProject,
@@ -24,6 +25,7 @@ where
 
 import Control.Lens
 import Data.List.Extra qualified as List
+import Data.Map qualified as Map
 import Data.Set qualified as Set
 import Data.Text qualified as Text
 import U.Codebase.Sqlite.Project as SqliteProject
@@ -35,6 +37,7 @@ import Unison.Codebase.Branch qualified as Branch
 import Unison.Codebase.Path (Path, Path' (..))
 import Unison.Codebase.Path qualified as Path
 import Unison.Name qualified as Name
+import Unison.NameSegment qualified as NameSegment
 import Unison.Names qualified as Names
 import Unison.Parser.Ann (Ann)
 import Unison.Position qualified as Position
@@ -42,6 +45,7 @@ import Unison.Prelude
 import Unison.Project.Util (ProjectContext (..))
 import Unison.Symbol (Symbol)
 import Unison.Syntax.HashQualified qualified as HQ (toText)
+import Unison.Syntax.NameSegment qualified as NameSegment
 import Unison.Util.Monoid (foldMapM)
 import Unison.Util.Monoid qualified as Monoid
 import Unison.Util.Relation qualified as Relation
@@ -94,6 +98,19 @@ namespaceOptions _codebase _projCtx searchBranch0 = do
     & map (Path.toText' . intoPath')
     & pure
 
+-- | Lists all dependencies of the current project.
+--
+-- E.g. if the current project has `lib.base` and `lib.distributed`, it will list:
+-- ["base", "distributed"]
+projectDependencyOptions :: OptionFetcher
+projectDependencyOptions _codebase _projCtx searchBranch0 = do
+  searchBranch0
+    & Branch.getAt0 (Path.singleton NameSegment.libSegment)
+    & Branch.nonEmptyChildren
+    & Map.keys
+    & fmap NameSegment.toEscapedText
+    & pure
+
 -- | Select a namespace from the given branch.
 -- Returned Path's will match the provided 'Position' type.
 fuzzySelectFromList :: [Text] -> FZFResolver
@@ -123,6 +140,9 @@ namespaceResolver = FZFResolver {getOptions = namespaceOptions}
 namespaceOrDefinitionResolver :: FZFResolver
 namespaceOrDefinitionResolver = multiResolver [definitionOptions, namespaceOptions]
 
+projectDependencyResolver :: FZFResolver
+projectDependencyResolver = FZFResolver {getOptions = projectDependencyOptions}
+
 -- | A project name, branch name, or both.
 projectAndOrBranchArg :: FZFResolver
 projectAndOrBranchArg = multiResolver [projectBranchOptions, projectNameOptions]

unison-cli/src/Unison/CommandLine/InputPatterns.hs

@@ -56,6 +56,7 @@ import Unison.JitInfo qualified as JitInfo
 import Unison.Name (Name)
 import Unison.Name qualified as Name
 import Unison.NameSegment (NameSegment)
+import Unison.NameSegment qualified as NameSegment
 import Unison.Prelude
 import Unison.Project (ProjectAndBranch (..), ProjectAndBranchNames (..), ProjectBranchName, ProjectBranchNameOrLatestRelease (..), ProjectBranchSpecifier (..), ProjectName, Semver)
 import Unison.Project.Util (ProjectContext (..), projectContextFromPath)
@@ -2284,6 +2285,16 @@ debugType =
         _ -> Left (I.help debugType)
     )
 
+debugLSPFoldRanges :: InputPattern
+debugLSPFoldRanges =
+  InputPattern
+    "debug.lsp.fold-ranges"
+    []
+    I.Hidden
+    []
+    "Output the source from the most recently parsed file, but annotated with the computed fold ranges."
+    (const $ Right Input.DebugLSPFoldRangesI)
+
 debugClearWatchCache :: InputPattern
 debugClearWatchCache =
   InputPattern
@@ -2959,7 +2970,7 @@ upgrade =
     { patternName = "upgrade",
       aliases = [],
       visibility = I.Visible,
-      args = [],
+      args = [("dependency to upgrade", Required, dependencyArg), ("dependency to upgrade to", Required, dependencyArg)],
       help =
         P.wrap $
           "`upgrade old new` upgrades library dependency `lib.old` to `lib.new`, and, if successful, deletes `lib.old`.",
@@ -3006,6 +3017,7 @@ validInputs =
       debugTerm,
       debugTermVerbose,
       debugType,
+      debugLSPFoldRanges,
       debugFileHashes,
       debugNameDiff,
       debugNumberedArgs,
@@ -3219,6 +3231,17 @@ namespaceOrDefinitionArg =
         Just Resolvers.namespaceOrDefinitionResolver
     }
 
+-- | A dependency name. E.g. if your project has `lib.base`, `base` would be a dependency
+-- name.
+dependencyArg :: ArgumentType
+dependencyArg =
+  ArgumentType
+    { typeName = "project dependency",
+      suggestions = \q cb _http p -> Codebase.runTransaction cb do
+        prefixCompleteNamespace q (p Path.:> NameSegment.libSegment),
+      fzfResolver = Just Resolvers.projectDependencyResolver
+    }
+
 newNameArg :: ArgumentType
 newNameArg =
   ArgumentType

unison-cli/src/Unison/CommandLine/OutputMessages.hs

@@ -160,6 +160,9 @@ import Unison.Var qualified as Var
 import Unison.WatchKind qualified as WK
 import Witch (unsafeFrom)
 
+reportBugURL :: Pretty
+reportBugURL = "https://github.com/unisonweb/unison/issues/new"
+
 type Pretty = P.Pretty P.ColorText
 
 shortenDirectory :: FilePath -> IO FilePath
@@ -1791,6 +1794,7 @@ notifyUser dir = \case
         <> case typ of
           Left builtinTxt -> "Builtin type: ##" <> P.text builtinTxt
           Right decl -> either (P.text . TL.toStrict . pShowNoColor) (P.text . TL.toStrict . pShowNoColor) decl
+  AnnotatedFoldRanges txt -> pure $ P.text txt
   DisplayDebugNameDiff NameChanges {termNameAdds, termNameRemovals, typeNameAdds, typeNameRemovals} -> do
     let referentText =
           -- We don't use the constructor type in the actual output here, so there's no
@@ -2315,7 +2319,8 @@ prettyUpdatePathError repoInfo = \case
 prettyUploadEntitiesError :: Share.UploadEntitiesError -> Pretty
 prettyUploadEntitiesError = \case
   Share.UploadEntitiesError'EntityValidationFailure validationFailureErr -> prettyValidationFailure validationFailureErr
-  Share.UploadEntitiesError'HashMismatchForEntity _hashMismatch -> error "TODO: hash mismatch error message"
+  Share.UploadEntitiesError'HashMismatchForEntity (Share.HashMismatchForEntity {supplied, computed}) ->
+    hashMismatchFromShare supplied computed
   Share.UploadEntitiesError'InvalidRepoInfo err repoInfo -> invalidRepoInfo err repoInfo
   Share.UploadEntitiesError'NeedDependencies dependencies -> needDependencies dependencies
   Share.UploadEntitiesError'NoWritePermission repoInfo -> noWritePermissionForRepo repoInfo
@@ -2445,6 +2450,18 @@ invalidRepoInfo err repoInfo =
       P.text err
     ]
 
+hashMismatchFromShare :: Hash32 -> Hash32 -> Pretty
+hashMismatchFromShare supplied computed =
+  P.lines
+    [ P.wrap "Uh oh, Share double-checked the hash of something you're uploading and it didn't match.",
+      P.wrap "Don't worry, you didn't do anything wrong, this is a bug in UCM, please report it and we'll do our best to sort it out 🤞",
+      reportBugURL,
+      "",
+      "Please include the following information in your report:",
+      P.wrap $ "The hash provided by your UCM is: " <> prettyHash32 supplied,
+      P.wrap $ "The hash computed by Share is: " <> prettyHash32 computed
+    ]
+
 pushPublicNote :: InputPattern -> Text -> [Text] -> Pretty
 pushPublicNote cmd uname ys =
   let msg =

unison-cli/src/Unison/LSP.hs

@@ -3,7 +3,11 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeOperators #-}
 
-module Unison.LSP where
+module Unison.LSP
+  ( spawnLsp,
+    LspFormattingConfig (..),
+  )
+where
 
 import Colog.Core (LogAction (LogAction))
 import Colog.Core qualified as Colog
@@ -50,12 +54,15 @@ import Unison.Symbol
 import UnliftIO
 import UnliftIO.Foreign (Errno (..), eADDRINUSE)
 
+data LspFormattingConfig = LspFormatEnabled | LspFormatDisabled
+  deriving (Show, Eq)
+
 getLspPort :: IO String
 getLspPort = fromMaybe "5757" <$> lookupEnv "UNISON_LSP_PORT"
 
 -- | Spawn an LSP server on the configured port.
-spawnLsp :: Codebase IO Symbol Ann -> Runtime Symbol -> STM CausalHash -> STM (Path.Absolute) -> IO ()
-spawnLsp codebase runtime latestRootHash latestPath =
+spawnLsp :: LspFormattingConfig -> Codebase IO Symbol Ann -> Runtime Symbol -> STM CausalHash -> STM (Path.Absolute) -> IO ()
+spawnLsp lspFormattingConfig codebase runtime latestRootHash latestPath =
   ifEnabled . TCP.withSocketsDo $ do
     lspPort <- getLspPort
     UnliftIO.handleIO (handleFailure lspPort) $ do
@@ -75,7 +82,7 @@ spawnLsp codebase runtime latestRootHash latestPath =
           -- different un-saved state for the same file.
           initVFS $ \vfs -> do
             vfsVar <- newMVar vfs
-            void $ runServerWith lspServerLogger lspClientLogger clientInput clientOutput (serverDefinition vfsVar codebase runtime scope latestRootHash latestPath)
+            void $ runServerWith lspServerLogger lspClientLogger clientInput clientOutput (serverDefinition lspFormattingConfig vfsVar codebase runtime scope latestRootHash latestPath)
   where
     handleFailure :: String -> IOException -> IO ()
     handleFailure lspPort ioerr =
@@ -101,6 +108,7 @@ spawnLsp codebase runtime latestRootHash latestPath =
         Nothing -> when (not onWindows) runServer
 
 serverDefinition ::
+  LspFormattingConfig ->
   MVar VFS ->
   Codebase IO Symbol Ann ->
   Runtime Symbol ->
@@ -108,14 +116,14 @@ serverDefinition ::
   STM CausalHash ->
   STM (Path.Absolute) ->
   ServerDefinition Config
-serverDefinition vfsVar codebase runtime scope latestRootHash latestPath =
+serverDefinition lspFormattingConfig vfsVar codebase runtime scope latestRootHash latestPath =
   ServerDefinition
     { defaultConfig = defaultLSPConfig,
       configSection = "unison",
       parseConfig = Config.parseConfig,
       onConfigChange = Config.updateConfig,
       doInitialize = lspDoInitialize vfsVar codebase runtime scope latestRootHash latestPath,
-      staticHandlers = lspStaticHandlers,
+      staticHandlers = lspStaticHandlers lspFormattingConfig,
       interpretHandler = lspInterpretHandler,
       options = lspOptions
     }
@@ -154,16 +162,16 @@ lspDoInitialize vfsVar codebase runtime scope latestRootHash latestPath lspConte
   pure $ Right $ env
 
 -- | LSP request handlers that don't register/unregister dynamically
-lspStaticHandlers :: ClientCapabilities -> Handlers Lsp
-lspStaticHandlers _capabilities =
+lspStaticHandlers :: LspFormattingConfig -> ClientCapabilities -> Handlers Lsp
+lspStaticHandlers lspFormattingConfig _capabilities =
   Handlers
-    { reqHandlers = lspRequestHandlers,
+    { reqHandlers = lspRequestHandlers lspFormattingConfig,
       notHandlers = lspNotificationHandlers
     }
 
 -- | LSP request handlers
-lspRequestHandlers :: SMethodMap (ClientMessageHandler Lsp 'Msg.Request)
-lspRequestHandlers =
+lspRequestHandlers :: LspFormattingConfig -> SMethodMap (ClientMessageHandler Lsp 'Msg.Request)
+lspRequestHandlers lspFormattingConfig =
   mempty
     & SMM.insert Msg.SMethod_TextDocumentHover (mkHandler hoverHandler)
     & SMM.insert Msg.SMethod_TextDocumentCodeAction (mkHandler codeActionHandler)
@@ -172,9 +180,15 @@ lspRequestHandlers =
     & SMM.insert Msg.SMethod_TextDocumentFoldingRange (mkHandler foldingRangeRequest)
     & SMM.insert Msg.SMethod_TextDocumentCompletion (mkHandler completionHandler)
     & SMM.insert Msg.SMethod_CompletionItemResolve (mkHandler completionItemResolveHandler)
-    & SMM.insert Msg.SMethod_TextDocumentFormatting (mkHandler formatDocRequest)
-    & SMM.insert Msg.SMethod_TextDocumentRangeFormatting (mkHandler formatRangeRequest)
+    & addFormattingHandlers
   where
+    addFormattingHandlers handlers =
+      case lspFormattingConfig of
+        LspFormatEnabled ->
+          handlers
+            & SMM.insert Msg.SMethod_TextDocumentFormatting (mkHandler formatDocRequest)
+            & SMM.insert Msg.SMethod_TextDocumentRangeFormatting (mkHandler formatRangeRequest)
+        LspFormatDisabled -> handlers
     defaultTimeout = 10_000 -- 10s
     mkHandler ::
       forall m.

unison-cli/src/Unison/LSP/FoldingRange.hs

@@ -1,50 +1,71 @@
 {-# LANGUAGE DataKinds #-}
 
-module Unison.LSP.FoldingRange where
+module Unison.LSP.FoldingRange
+  ( foldingRangeRequest,
+    foldingRangesForFile,
+  )
+where
 
 import Control.Lens hiding (List)
+import Data.Map qualified as Map
+import Data.Text qualified as Text
 import Language.LSP.Protocol.Lens hiding (id, to)
 import Language.LSP.Protocol.Message qualified as Msg
 import Language.LSP.Protocol.Types
-import Unison.ABT qualified as ABT
 import Unison.DataDeclaration qualified as DD
-import Unison.Debug qualified as Debug
 import Unison.LSP.Conversions (annToRange)
 import Unison.LSP.FileAnalysis (getFileAnalysis)
 import Unison.LSP.Types
+import Unison.Parser.Ann (Ann)
 import Unison.Prelude
+import Unison.Symbol (Symbol)
 import Unison.UnisonFile (UnisonFile (..))
+import Unison.UnisonFile qualified as UF
+import Unison.Var qualified as Var
 
 foldingRangeRequest :: Msg.TRequestMessage 'Msg.Method_TextDocumentFoldingRange -> (Either Msg.ResponseError (Msg.MessageResult 'Msg.Method_TextDocumentFoldingRange) -> Lsp ()) -> Lsp ()
 foldingRangeRequest m respond = do
-  foldRanges <- foldingRangesForFile (m ^. params . textDocument . uri)
-  Debug.debugM Debug.LSP "Folding Ranges" foldRanges
+  let fileUri = m ^. params . textDocument . uri
+  foldRanges <-
+    fromMaybe [] <$> runMaybeT do
+      FileAnalysis {parsedFile = mayParsedFile} <- getFileAnalysis fileUri
+      parsedFile <- hoistMaybe mayParsedFile
+      pure $ foldingRangesForFile parsedFile
   respond . Right . InL $ foldRanges
 
 -- | Return a folding range for each top-level definition
-foldingRangesForFile :: Uri -> Lsp [FoldingRange]
-foldingRangesForFile fileUri =
-  fromMaybe []
-    <$> runMaybeT do
-      FileAnalysis {parsedFile} <- getFileAnalysis fileUri
-      UnisonFileId {dataDeclarationsId, effectDeclarationsId, terms} <- MaybeT $ pure parsedFile
-      let dataFolds = dataDeclarationsId ^.. folded . _2 . to dataDeclSpan
-      let abilityFolds = effectDeclarationsId ^.. folded . _2 . to DD.toDataDecl . to dataDeclSpan
-      let termFolds = terms ^.. folded . _3 . to ABT.annotation
-      let folds = dataFolds <> abilityFolds <> termFolds
-      let ranges = mapMaybe annToRange folds
-      pure $
-        ranges <&> \r ->
-          FoldingRange
-            { _startLine = r ^. start . line,
-              _startCharacter = Just (r ^. start . character),
-              _endLine = r ^. end . line,
-              _endCharacter = Just (r ^. end . character),
-              _kind = Just FoldingRangeKind_Region,
-              _collapsedText = Nothing
-            }
-  where
-    dataDeclSpan dd =
-      -- We don't have a proper Annotation for data decls so we take the span of all the
-      -- constructors using their monoid instance.
-      DD.annotation dd <> DD.constructors' dd ^. folded . to (\(a, _v, typ) -> a <> ABT.annotation typ)
+foldingRangesForFile :: UF.UnisonFile Symbol Ann -> [FoldingRange]
+foldingRangesForFile UnisonFileId {dataDeclarationsId, effectDeclarationsId, terms, watches} =
+  let dataFolds =
+        dataDeclarationsId
+          & Map.toList
+          & map \(sym, (_typ, decl)) -> (Just sym, DD.annotation decl)
+      abilityFolds =
+        effectDeclarationsId
+          & Map.toList
+          & map \(sym, (_typ, decl)) -> (Just sym, DD.annotation . DD.toDataDecl $ decl)
+      termFolds = terms & fmap \(sym, ann, _trm) -> (Just sym, ann)
+      watchFolds =
+        watches
+          & fold
+          & fmap
+            ( \(_sym, ann, _trm) ->
+                -- We don't use the symbol here because watch symbols are often auto-generated
+                -- and ugly.
+                (Nothing, ann)
+            )
+      folds =
+        dataFolds <> abilityFolds <> termFolds <> watchFolds
+      ranges =
+        folds
+          & mapMaybe \(sym, range) ->
+            (Text.pack . Var.nameStr <$> sym,) <$> annToRange range
+   in ranges <&> \(maySym, r) ->
+        FoldingRange
+          { _startLine = r ^. start . line,
+            _startCharacter = Just (r ^. start . character),
+            _endLine = r ^. end . line,
+            _endCharacter = Just (r ^. end . character),
+            _kind = Just FoldingRangeKind_Region,
+            _collapsedText = maySym
+          }

unison-cli/unison-cli.cabal

@@ -51,6 +51,7 @@ library
       Unison.Codebase.Editor.HandleInput.Branches
       Unison.Codebase.Editor.HandleInput.BranchRename
       Unison.Codebase.Editor.HandleInput.DebugDefinition
+      Unison.Codebase.Editor.HandleInput.DebugFoldRanges
       Unison.Codebase.Editor.HandleInput.DeleteBranch
       Unison.Codebase.Editor.HandleInput.DeleteProject
       Unison.Codebase.Editor.HandleInput.EditNamespace

unison-cli/unison/ArgParse.hs

@@ -53,6 +53,7 @@ import System.Environment (lookupEnv)
 import Unison.Codebase.Path qualified as Path
 import Unison.Codebase.Path.Parse qualified as Path
 import Unison.CommandLine.Types (ShouldWatchFiles (..))
+import Unison.LSP (LspFormattingConfig (..))
 import Unison.Prelude
 import Unison.PrettyTerminal qualified as PT
 import Unison.Server.CodebaseServer (CodebaseServerOpts (..))
@@ -112,7 +113,8 @@ data Command
 -- | Options shared by sufficiently many subcommands.
 data GlobalOptions = GlobalOptions
   { codebasePathOption :: Maybe CodebasePathOption,
-    exitOption :: ShouldExit
+    exitOption :: ShouldExit,
+    lspFormattingConfig :: LspFormattingConfig
   }
   deriving (Show, Eq)
 
@@ -254,12 +256,10 @@ globalOptionsParser = do
   -- ApplicativeDo
   codebasePathOption <- codebasePathParser <|> codebaseCreateParser
   exitOption <- exitParser
+  lspFormattingConfig <- lspFormattingParser
 
   pure
-    GlobalOptions
-      { codebasePathOption = codebasePathOption,
-        exitOption = exitOption
-      }
+    GlobalOptions {codebasePathOption, exitOption, lspFormattingConfig}
 
 codebasePathParser :: Parser (Maybe CodebasePathOption)
 codebasePathParser = do
@@ -286,6 +286,11 @@ exitParser = flag DoNotExit Exit (long "exit" <> help exitHelp)
   where
     exitHelp = "Exit repl after the command."
 
+lspFormattingParser :: Parser LspFormattingConfig
+lspFormattingParser = flag LspFormatDisabled LspFormatEnabled (long "lsp-format" <> help lspFormatHelp)
+  where
+    lspFormatHelp = "[Experimental] Enable formatting of source files via LSP."
+
 versionOptionParser :: String -> String -> Parser (a -> a)
 versionOptionParser progName version =
   infoOption (progName <> " version: " <> version) (short 'v' <> long "version" <> help "Show version")

unison-cli/unison/Main.hs

@@ -14,7 +14,7 @@ where
 import ArgParse
   ( CodebasePathOption (..),
     Command (Init, Launch, PrintVersion, Run, Transcript),
-    GlobalOptions (GlobalOptions, codebasePathOption, exitOption),
+    GlobalOptions (..),
     IsHeadless (Headless, WithCLI),
     RunSource (..),
     ShouldExit (DoNotExit, Exit),
@@ -118,7 +118,7 @@ main = do
       progName <- getProgName
       -- hSetBuffering stdout NoBuffering -- cool
       (renderUsageInfo, globalOptions, command) <- parseCLIArgs progName (Text.unpack Version.gitDescribeWithDate)
-      let GlobalOptions {codebasePathOption = mCodePathOption, exitOption = exitOption} = globalOptions
+      let GlobalOptions {codebasePathOption = mCodePathOption, exitOption, lspFormattingConfig} = globalOptions
       withConfig mCodePathOption \config -> do
         currentDir <- getCurrentDirectory
         case command of
@@ -291,7 +291,7 @@ main = do
                 -- prevent UCM from shutting down properly. Hopefully we can re-enable LSP on
                 -- Windows when we move to GHC 9.*
                 -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/1224
-                void . Ki.fork scope $ LSP.spawnLsp theCodebase runtime (readTVar rootCausalHashVar) (readTVar pathVar)
+                void . Ki.fork scope $ LSP.spawnLsp lspFormattingConfig theCodebase runtime (readTVar rootCausalHashVar) (readTVar pathVar)
                 Server.startServer (Backend.BackendEnv {Backend.useNamesIndex = False}) codebaseServerOpts sbRuntime theCodebase $ \baseUrl -> do
                   case exitOption of
                     DoNotExit -> do

unison-share-api/src/Unison/Server/Orphans.hs

@@ -167,6 +167,9 @@ instance ToJSON Name where
   toEncoding = toEncoding . Name.toText
   toJSON = toJSON . Name.toText
 
+instance ToJSONKey Name where
+  toJSONKey = contramap Name.toText (toJSONKey @Text)
+
 instance ToSchema Name where
   declareNamedSchema _ = declareNamedSchema (Proxy @Text)
 

unison-src/transcripts/formatter.md

@@ -19,6 +19,15 @@ x y =
     x + y
 -- Should keep comments after
 
+-- symbolyDefinition
+(<|>) : Nat -> Nat -> (Nat, Nat)
+(<|>) a b = (a, b)
+
+symbolyEndOfBlock =
+  x = 1
+  (+:)
+
+
 -- Test for a previous regression that added extra brackets.
 oneLiner = {{ one liner }}
 -- After
@@ -38,6 +47,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 
 }}
@@ -48,6 +70,21 @@ structural type Optional   a = More Text
 
 {{ A doc before a type with no type-vars }}
 type Two = One Nat | Two Text
+
+-- Regression for https://github.com/unisonweb/unison/issues/4669
+
+multilineBold = {{
+
+**This paragraph is really really really really really long and spans multiple lines 
+with a strike-through block**
+
+_This paragraph is really really really really really long and spans multiple lines 
+with a strike-through block_
+
+~This paragraph is really really really really really long and spans multiple lines 
+with a strike-through block~
+
+}}
 ```
 
 ```ucm

unison-src/transcripts/formatter.output.md

@@ -15,6 +15,15 @@ x y =
     x + y
 -- Should keep comments after
 
+-- symbolyDefinition
+(<|>) : Nat -> Nat -> (Nat, Nat)
+(<|>) a b = (a, b)
+
+symbolyEndOfBlock =
+  x = 1
+  (+:)
+
+
 -- Test for a previous regression that added extra brackets.
 oneLiner = {{ one liner }}
 -- After
@@ -34,6 +43,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 
 }}
@@ -44,6 +66,21 @@ structural type Optional   a = More Text
 
 {{ A doc before a type with no type-vars }}
 type Two = One Nat | Two Text
+
+-- Regression for https://github.com/unisonweb/unison/issues/4669
+
+multilineBold = {{
+
+**This paragraph is really really really really really long and spans multiple lines 
+with a strike-through block**
+
+_This paragraph is really really really really really long and spans multiple lines 
+with a strike-through block_
+
+~This paragraph is really really really really really long and spans multiple lines 
+with a strike-through block~
+
+}}
 ```
 
 ```ucm
@@ -66,6 +103,15 @@ x y =
   x + y
 -- Should keep comments after
 
+-- symbolyDefinition
+(<|>) : Nat -> Nat -> (Nat, Nat)
+a <|> b = (a, b)
+
+symbolyEndOfBlock =
+  x = 1
+  (+:)
+
+
 -- Test for a previous regression that added extra brackets.
 oneLiner = {{ one liner }}
 -- After
@@ -86,11 +132,37 @@ 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 
 
 Two.doc = {{ A doc before a type with no type-vars }}
 type Two = One Nat | Two Text
+
+-- Regression for https://github.com/unisonweb/unison/issues/4669
+
+multilineBold =
+  {{
+  **This paragraph is really really really really really long and spans
+  multiple lines with a strike-through block**
+  
+  __This paragraph is really really really really really long and spans
+  multiple lines with a strike-through block__
+  
+  ~~This paragraph is really really really really really long and spans
+  multiple lines with a strike-through block~~
+  }}
 ```
 
 Formatter should leave things alone if the file doesn't typecheck.

unison-src/transcripts/lsp-fold-ranges.md

@@ -0,0 +1,33 @@
+```ucm:hide
+.> builtins.mergeio
+```
+
+```unison:hide
+
+{{ Type doc }}
+structural type Optional a =
+  None
+  | Some a
+
+{{
+  Multi line
+
+  Term doc
+}}
+List.map : 
+  (a -> b) 
+  -> [a] 
+  -> [b]
+List.map f = cases
+  (x +: xs) -> f x +: List.map f xs
+  [] -> []
+
+test> z = let
+  x = "hello"
+  y = "world"
+  [Ok (x ++ y)]
+```
+
+```ucm
+.> debug.lsp.fold-ranges
+```

unison-src/transcripts/lsp-fold-ranges.output.md

@@ -0,0 +1,52 @@
+```unison
+{{ Type doc }}
+structural type Optional a =
+  None
+  | Some a
+
+{{
+  Multi line
+
+  Term doc
+}}
+List.map : 
+  (a -> b) 
+  -> [a] 
+  -> [b]
+List.map f = cases
+  (x +: xs) -> f x +: List.map f xs
+  [] -> []
+
+test> z = let
+  x = "hello"
+  y = "world"
+  [Ok (x ++ y)]
+```
+
+```ucm
+.> debug.lsp.fold-ranges
+
+  《{{ Type doc }}》
+  《structural type Optional a =
+    None
+    | Some a》
+  
+  《{{
+    Multi line
+  
+    Term doc
+  }}》
+  《List.map : 
+    (a -> b) 
+    -> [a] 
+    -> [b]
+  List.map f = cases
+    (x +: xs) -> f x +: List.map f xs
+    [] -> []》
+  
+  《test> z = let
+    x = "hello"
+    y = "world"
+    [Ok (x ++ y)]》
+
+```

unison-src/transcripts/upgrade-happy-path.md

@@ -10,8 +10,19 @@ lib.new.foo = 18
 thingy = lib.old.foo + 10
 ```
 
+
 ```ucm
 proj/main> add
+```
+
+Test tab completion and fzf options of upgrade command.
+```ucm
+proj/main> debug.tab-complete upgrade ol
+proj/main> debug.fuzzy-options upgrade _
+proj/main> debug.fuzzy-options upgrade old _
+```
+
+```ucm
 proj/main> upgrade old new
 proj/main> ls lib
 proj/main> view thingy

unison-src/transcripts/upgrade-happy-path.output.md

@@ -28,6 +28,29 @@ proj/main> add
     lib.old.foo : Nat
     thingy      : Nat
 
+```
+Test tab completion and fzf options of upgrade command.
+```ucm
+proj/main> debug.tab-complete upgrade ol
+
+   old
+
+proj/main> debug.fuzzy-options upgrade _
+
+  Select a dependency to upgrade:
+    * builtin
+    * new
+    * old
+
+proj/main> debug.fuzzy-options upgrade old _
+
+  Select a dependency to upgrade to:
+    * builtin
+    * new
+    * old
+
+```
+```ucm
 proj/main> upgrade old new
 
   I upgraded old to new, and removed old.

unison-syntax/src/Unison/Syntax/Lexer.hs

@@ -559,6 +559,14 @@ lexemes' eof =
         nonNewlineSpace ch = isSpace ch && ch /= '\n' && ch /= '\r'
         nonNewlineSpaces = P.takeWhileP Nothing nonNewlineSpace
 
+        -- Allows whitespace or a newline, but not more than two newlines in a row.
+        whitespaceWithoutParagraphBreak :: P ()
+        whitespaceWithoutParagraphBreak = void do
+          void nonNewlineSpaces
+          optional newline >>= \case
+            Just _ -> void nonNewlineSpaces
+            Nothing -> pure ()
+
         fencedBlock =
           P.label "block eval (syntax: a fenced code block)" $
             evalUnison <|> exampleBlock <|> other
@@ -623,7 +631,7 @@ lexemes' eof =
           wrap (name end) . wrap "syntax.docParagraph" $
             join
               <$> P.someTill
-                (leafy (closing <|> (void $ lit end)) <* nonNewlineSpaces)
+                (leafy (closing <|> (void $ lit end)) <* whitespaceWithoutParagraphBreak)
                 (lit end)
 
         externalLink =

unison-syntax/src/Unison/Syntax/Parser.hs

@@ -328,8 +328,16 @@ symbolyDefinitionName = queryToken $ \case
   L.SymbolyId n -> Just $ Name.toVar (HQ'.toName n)
   _ -> Nothing
 
-parenthesize :: (Ord v) => P v m a -> P v m a
-parenthesize p = P.try (openBlockWith "(" *> p) <* closeBlock
+-- | Expect parentheses around a token, includes the parentheses within the start/end
+-- annotations of the resulting token.
+parenthesize :: (Ord v) => P v m (L.Token a) -> P v m (L.Token a)
+parenthesize p = do
+  (start, a) <- P.try do
+    start <- L.start <$> openBlockWith "("
+    a <- p
+    pure (start, a)
+  end <- L.end <$> closeBlock
+  pure (L.Token {payload = L.payload a, start, end})
 
 hqPrefixId, hqInfixId :: (Ord v) => P v m (L.Token (HQ.HashQualified Name))
 hqPrefixId = hqWordyId_ <|> parenthesize hqSymbolyId_