mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 02:25:39 +03:00
partially fix tab-completion
This commit is contained in:
parent
ed881583e7
commit
12a75f18b3
@ -9,6 +9,8 @@ module Unison.Codebase.Path.Parse
|
||||
parseShortHashOrHQSplit',
|
||||
|
||||
-- * Path parsers
|
||||
pathP,
|
||||
pathP',
|
||||
splitP,
|
||||
splitP',
|
||||
)
|
||||
@ -17,6 +19,7 @@ where
|
||||
import Data.Text qualified as Text
|
||||
import Text.Megaparsec (Parsec)
|
||||
import Text.Megaparsec qualified as P
|
||||
import Text.Megaparsec.Char qualified as P (char)
|
||||
import Text.Megaparsec.Internal qualified as P (withParsecT)
|
||||
import Unison.Codebase.Path
|
||||
import Unison.HashQualified' qualified as HQ'
|
||||
@ -31,9 +34,8 @@ import Unison.Syntax.ShortHash qualified as ShortHash
|
||||
-- Path parsing functions
|
||||
|
||||
parsePath :: String -> Either Text Path
|
||||
parsePath = \case
|
||||
"" -> Right empty
|
||||
path -> unsplit <$> parseSplit path
|
||||
parsePath =
|
||||
runParser pathP
|
||||
|
||||
parsePath' :: String -> Either Text Path'
|
||||
parsePath' = \case
|
||||
@ -65,12 +67,23 @@ parseHQSplit' =
|
||||
|
||||
runParser :: Parsec (Lexer.Token Text) [Char] a -> String -> Either Text a
|
||||
runParser p =
|
||||
mapLeft (Text.pack . P.errorBundlePretty)
|
||||
. P.runParser (p <* P.eof) ""
|
||||
mapLeft (Text.pack . P.errorBundlePretty) . P.runParser (p <* P.eof) ""
|
||||
|
||||
------------------------------------------------------------------------------------------------------------------------
|
||||
-- Path parsers
|
||||
|
||||
pathP :: Parsec (Lexer.Token Text) [Char] Path
|
||||
pathP =
|
||||
(unsplit <$> splitP) <|> pure empty
|
||||
|
||||
pathP' :: Parsec (Lexer.Token Text) [Char] Path'
|
||||
pathP' =
|
||||
asum
|
||||
[ unsplit' <$> splitP',
|
||||
P.char '.' $> absoluteEmpty',
|
||||
pure relativeEmpty'
|
||||
]
|
||||
|
||||
splitP :: Parsec (Lexer.Token Text) [Char] Split
|
||||
splitP =
|
||||
splitFromName <$> P.withParsecT (fmap NameSegment.renderParseErr) Name.relativeNameP
|
||||
|
@ -148,7 +148,6 @@ completeWithinNamespace compTypes query currentPath = do
|
||||
currentBranchSuggestions <- do
|
||||
nib <- namesInBranch shortHashLen b
|
||||
nib
|
||||
-- See Note [Naughty NameSegment]
|
||||
& fmap (\(isFinished, match) -> (isFinished, Text.unpack (Path.toText' queryPathPrefix <> "." <> match)))
|
||||
& filter (\(_isFinished, match) -> List.isPrefixOf query match)
|
||||
& fmap (\(isFinished, match) -> prettyCompletionWithQueryPrefix isFinished query match)
|
||||
@ -179,7 +178,6 @@ completeWithinNamespace compTypes query currentPath = do
|
||||
childBranch <- V2Causal.value childCausal
|
||||
nib <- namesInBranch shortHashLen childBranch
|
||||
nib
|
||||
-- See Note [Naughty NameSegment]
|
||||
& fmap (\(isFinished, match) -> (isFinished, Text.unpack (Path.toText' queryPathPrefix <> "." <> match)))
|
||||
& filter (\(_isFinished, match) -> List.isPrefixOf query match)
|
||||
& fmap (\(isFinished, match) -> prettyCompletionWithQueryPrefix isFinished query match)
|
||||
@ -250,8 +248,11 @@ completeWithinNamespace compTypes query currentPath = do
|
||||
parseLaxPath'Query :: Text -> (Path.Path', Text)
|
||||
parseLaxPath'Query txt =
|
||||
case P.runParser ((,) <$> Path.splitP' <*> P.takeRest) "" (Text.unpack txt) of
|
||||
Left _err -> (Path.RelativePath' (Path.Relative Path.empty), txt)
|
||||
Right (path, rest) -> (Path.unsplit' path, Text.pack rest)
|
||||
Left _err -> (Path.relativeEmpty', txt)
|
||||
Right ((path, segment), rest) ->
|
||||
if take 1 rest == "."
|
||||
then (Path.unsplit' (path, segment), Text.empty)
|
||||
else (path, NameSegment.toEscapedText segment)
|
||||
|
||||
-- | Completes a namespace argument by prefix-matching against the query.
|
||||
prefixCompleteNamespace ::
|
||||
|
@ -64,10 +64,7 @@ unique type subnamespace.AType = A | B
|
||||
-- Should not complete things from child namespaces of the current query if there are other completions at this level
|
||||
.> debug.tab-complete view subnamespace
|
||||
|
||||
* subnamespace.AType
|
||||
subnamespace.AType.
|
||||
* subnamespace.someName
|
||||
* subnamespace.someOtherName
|
||||
|
||||
|
||||
-- Should complete things from child namespaces of the current query if it's dot-suffixed
|
||||
.> debug.tab-complete view subnamespace.
|
||||
@ -80,21 +77,23 @@ unique type subnamespace.AType = A | B
|
||||
-- Should complete things from child namespaces of the current query if there are no more completions at this level.
|
||||
.> debug.tab-complete view subnamespace2
|
||||
|
||||
* subnamespace2.thing
|
||||
|
||||
|
||||
-- Should prefix-filter by query suffix
|
||||
.> debug.tab-complete view subnamespace.some
|
||||
|
||||
|
||||
* subnamespace.someName
|
||||
* subnamespace.someOtherName
|
||||
|
||||
.> debug.tab-complete view subnamespace.someOther
|
||||
|
||||
|
||||
* subnamespace.someOtherName
|
||||
|
||||
-- Should tab complete absolute names
|
||||
.othernamespace> debug.tab-complete view .subnamespace.some
|
||||
|
||||
|
||||
* .subnamespace.someName
|
||||
* .subnamespace.someOtherName
|
||||
|
||||
```
|
||||
## Tab complete namespaces
|
||||
@ -107,7 +106,7 @@ unique type subnamespace.AType = A | B
|
||||
|
||||
.> debug.tab-complete cd subnamespace
|
||||
|
||||
subnamespace.AType
|
||||
|
||||
|
||||
.> debug.tab-complete cd subnamespace.
|
||||
|
||||
@ -119,9 +118,7 @@ unique type subnamespace.AType = A | B
|
||||
|
||||
.> debug.tab-complete io.test subnamespace
|
||||
|
||||
subnamespace.AType.
|
||||
* subnamespace.someName
|
||||
* subnamespace.someOtherName
|
||||
|
||||
|
||||
.> debug.tab-complete io.test subnamespace.
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user