mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 02:25:39 +03:00
⅄ trunk → 22-10-18-backticky-parser
This commit is contained in:
commit
aa2107982f
@ -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 =
|
||||
|
@ -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`
|
||||
|
@ -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) =
|
||||
|
@ -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
|
||||
|
@ -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
|
@ -222,6 +222,7 @@ data Input
|
||||
| DebugDumpNamespaceSimpleI
|
||||
| DebugTermI (Bool {- Verbose mode -}) (HQ.HashQualified Name)
|
||||
| DebugTypeI (HQ.HashQualified Name)
|
||||
| DebugLSPFoldRangesI
|
||||
| DebugClearWatchI
|
||||
| DebugDoctorI
|
||||
| DebugNameDiffI ShortCausalHash ShortCausalHash
|
||||
|
@ -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
|
||||
|
@ -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]
|
||||
|
@ -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
|
||||
|
@ -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 =
|
||||
|
@ -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.
|
||||
|
@ -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
|
||||
}
|
||||
|
@ -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
|
||||
|
@ -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")
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
||||
|
@ -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
|
||||
|
@ -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.
|
||||
|
33
unison-src/transcripts/lsp-fold-ranges.md
Normal file
33
unison-src/transcripts/lsp-fold-ranges.md
Normal file
@ -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
|
||||
```
|
52
unison-src/transcripts/lsp-fold-ranges.output.md
Normal file
52
unison-src/transcripts/lsp-fold-ranges.output.md
Normal file
@ -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)]》
|
||||
|
||||
```
|
@ -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.
|
||||
|
@ -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 =
|
||||
|
@ -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_
|
||||
|
Loading…
Reference in New Issue
Block a user