mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 02:25:39 +03:00
Merge branch 'trunk' into topic/native-compiler
# Conflicts: # unison-cli/unison/ArgParse.hs # unison-cli/unison/Main.hs
This commit is contained in:
commit
25d703a203
@ -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]
|
||||
|
@ -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)
|
||||
|
@ -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.
|
||||
|
@ -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")
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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.
|
||||
|
@ -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_
|
||||
|
Loading…
Reference in New Issue
Block a user