Merge branch 'trunk' into topic/native-compiler

# Conflicts:
#	unison-cli/unison/ArgParse.hs
#	unison-cli/unison/Main.hs

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
@@ -94,6 +97,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 Name.libSegment)
+    & Branch.nonEmptyChildren
+    & Map.keys
+    & fmap NameSegment.toText
+    & pure
+
 -- | Select a namespace from the given branch.
 -- Returned Path's will match the provided 'Position' type.
 fuzzySelectFromList :: [Text] -> FZFResolver
@@ -123,6 +139,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

@@ -3006,7 +3006,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`.",
@@ -3267,6 +3267,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.:> Name.libSegment),
+      fzfResolver = Just Resolvers.projectDependencyResolver
+    }
+
 -- | Names of child branches of the branch, only gives options for one 'layer' deeper at a time.
 childNamespaceNames :: Branch.Branch0 m -> [Text]
 childNamespaceNames b = NameSegment.toText <$> Map.keys (Branch.nonEmptyChildren b)

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/unison/ArgParse.hs

@@ -59,6 +59,7 @@ import Text.Read (readMaybe)
 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.PrettyTerminal qualified as PT
 import Unison.Server.CodebaseServer (CodebaseServerOpts (..))
 import Unison.Server.CodebaseServer qualified as Server
@@ -119,6 +120,7 @@ data GlobalOptions = GlobalOptions
   { codebasePathOption :: Maybe CodebasePathOption,
     exitOption :: ShouldExit,
     nativeRuntimePath :: Maybe FilePath
+    lspFormattingConfig :: LspFormattingConfig
   }
   deriving (Show, Eq)
 
@@ -261,13 +263,10 @@ globalOptionsParser = do
   codebasePathOption <- codebasePathParser <|> codebaseCreateParser
   exitOption <- exitParser
   nativeRuntimePath <- nativeRuntimePathFlag
+  lspFormattingConfig <- lspFormattingParser
 
   pure
-    GlobalOptions
-      { codebasePathOption = codebasePathOption,
-        exitOption = exitOption,
-        nativeRuntimePath = nativeRuntimePath
-      }
+    GlobalOptions {codebasePathOption, exitOption, nativeRuntimePath, lspFormattingConfig}
 
 codebasePathParser :: Parser (Maybe CodebasePathOption)
 codebasePathParser = do
@@ -294,6 +293,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

@@ -15,12 +15,7 @@ where
 import ArgParse
   ( CodebasePathOption (..),
     Command (Init, Launch, PrintVersion, Run, Transcript),
-    GlobalOptions
-      ( GlobalOptions,
-        codebasePathOption,
-        exitOption,
-        nativeRuntimePath
-      ),
+    GlobalOptions (..),
     IsHeadless (Headless, WithCLI),
     RunSource (..),
     ShouldExit (DoNotExit, Exit),
@@ -131,7 +126,7 @@ main = do
       -- hSetBuffering stdout NoBuffering -- cool
       (renderUsageInfo, globalOptions, command) <- parseCLIArgs progName (Text.unpack Version.gitDescribeWithDate)
       nrtp <- fixNativeRuntimePath (nativeRuntimePath globalOptions)
-      let GlobalOptions {codebasePathOption = mCodePathOption, exitOption = exitOption} = globalOptions
+      let GlobalOptions {codebasePathOption = mCodePathOption, exitOption, lspFormattingConfig} = globalOptions
       withConfig mCodePathOption \config -> do
         currentDir <- getCurrentDirectory
         case command of
@@ -304,7 +299,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

@@ -169,6 +169,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

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
@@ -94,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

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/Parser.hs

@@ -338,8 +338,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_