fix tab completion

This commit is contained in:
Mitchell Rosen 2024-02-22 13:18:26 -05:00
parent 12a75f18b3
commit e31aba4620
2 changed files with 47 additions and 21 deletions

View File

@ -21,6 +21,7 @@ module Unison.CommandLine.Completion
where
import Control.Lens (ifoldMap)
import Control.Lens qualified as Lens
import Control.Lens.Cons (unsnoc)
import Data.Aeson qualified as Aeson
import Data.List (isPrefixOf)
@ -148,7 +149,12 @@ completeWithinNamespace compTypes query currentPath = do
currentBranchSuggestions <- do
nib <- namesInBranch shortHashLen b
nib
& fmap (\(isFinished, match) -> (isFinished, Text.unpack (Path.toText' queryPathPrefix <> "." <> match)))
& fmap
( \(ty, isFinished, match) ->
( isFinished,
Text.unpack (dotifyNamespace ty (Path.toText' (queryPathPrefix Lens.:> NameSegment match)))
)
)
& filter (\(_isFinished, match) -> List.isPrefixOf query match)
& fmap (\(isFinished, match) -> prettyCompletionWithQueryPrefix isFinished query match)
& pure
@ -178,11 +184,16 @@ completeWithinNamespace compTypes query currentPath = do
childBranch <- V2Causal.value childCausal
nib <- namesInBranch shortHashLen childBranch
nib
& fmap (\(isFinished, match) -> (isFinished, Text.unpack (Path.toText' queryPathPrefix <> "." <> match)))
& fmap
( \(ty, isFinished, match) ->
( isFinished,
Text.unpack (dotifyNamespace ty (Path.toText' (queryPathPrefix Lens.:> suffix Lens.:> NameSegment match)))
)
)
& filter (\(_isFinished, match) -> List.isPrefixOf query match)
& fmap (\(isFinished, match) -> prettyCompletionWithQueryPrefix isFinished query match)
& pure
namesInBranch :: Int -> V2Branch.Branch Sqlite.Transaction -> Sqlite.Transaction [(Bool, Text)]
namesInBranch :: Int -> V2Branch.Branch Sqlite.Transaction -> Sqlite.Transaction [(CompletionType, Bool, Text)]
namesInBranch hashLen b = do
nonEmptyChildren <- V2Branch.nonEmptyChildren b
let textifyHQ :: (NameSegment -> r -> HQ'.HashQualified NameSegment) -> Map NameSegment (Map r metadata) -> [(Bool, Text)]
@ -192,10 +203,18 @@ completeWithinNamespace compTypes query currentPath = do
& fmap (HQ'.toTextWith NameSegment.toEscapedText)
& fmap (True,)
pure $
((False,) <$> dotifyNamespaces (fmap NameSegment.toEscapedText . Map.keys $ nonEmptyChildren))
<> Monoid.whenM (NESet.member TermCompletion compTypes) (textifyHQ (hqFromNamedV2Referent hashLen) $ V2Branch.terms b)
<> Monoid.whenM (NESet.member TypeCompletion compTypes) (textifyHQ (hqFromNamedV2Reference hashLen) $ V2Branch.types b)
<> Monoid.whenM (NESet.member PatchCompletion compTypes) (fmap ((True,) . NameSegment.toEscapedText) . Map.keys $ V2Branch.patches b)
concat
[ (NamespaceCompletion,False,) <$> (fmap NameSegment.toEscapedText . Map.keys $ nonEmptyChildren),
Monoid.whenM
(NESet.member TermCompletion compTypes)
(map (\(x, y) -> (TermCompletion, x, y)) (textifyHQ (hqFromNamedV2Referent hashLen) $ V2Branch.terms b)),
Monoid.whenM
(NESet.member TypeCompletion compTypes)
(map (\(x, y) -> (TypeCompletion, x, y)) (textifyHQ (hqFromNamedV2Reference hashLen) $ V2Branch.types b)),
Monoid.whenM
(NESet.member PatchCompletion compTypes)
(fmap ((PatchCompletion,True,) . NameSegment.toEscapedText) . Map.keys $ V2Branch.patches b)
]
-- Regrettably there'shqFromNamedV2Referencenot a great spot to combinators for V2 references and shorthashes right now.
hqFromNamedV2Referent :: Int -> NameSegment -> Referent.Referent -> HQ'.HashQualified NameSegment
@ -214,11 +233,9 @@ completeWithinNamespace compTypes query currentPath = do
-- If we're not completing namespaces, then all namespace completions should automatically
-- drill-down by adding a trailing '.'
dotifyNamespaces :: [Text] -> [Text]
dotifyNamespaces namespaces =
if not (NESet.member NamespaceCompletion compTypes)
then fmap (<> ".") namespaces
else namespaces
dotifyNamespace :: CompletionType -> Text -> Text
dotifyNamespace NamespaceCompletion | not (NESet.member NamespaceCompletion compTypes) = (<> ".")
dotifyNamespace _ = id
-- | A path parser which which is more lax with respect to well formed paths,
-- specifically we can determine a valid path prefix with a (possibly empty) suffix query.

View File

@ -59,12 +59,14 @@ unique type subnamespace.AType = A | B
-- Should tab complete namespaces since they may contain terms/types
.> debug.tab-complete view sub
subnamespace.
subnamespace2.
-- 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.
subnamespace2.
-- Should complete things from child namespaces of the current query if it's dot-suffixed
.> debug.tab-complete view subnamespace.
@ -77,7 +79,8 @@ 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.
* subnamespace2.thing
-- Should prefix-filter by query suffix
.> debug.tab-complete view subnamespace.some
@ -102,11 +105,13 @@ unique type subnamespace.AType = A | B
-- Should tab complete namespaces
.> debug.tab-complete cd sub
subnamespace
subnamespace2
.> debug.tab-complete cd subnamespace
subnamespace
subnamespace2
.> debug.tab-complete cd subnamespace.
@ -114,11 +119,13 @@ unique type subnamespace.AType = A | B
.> debug.tab-complete io.test sub
subnamespace.
subnamespace2.
.> debug.tab-complete io.test subnamespace
subnamespace.
subnamespace2.
.> debug.tab-complete io.test subnamespace.
@ -159,11 +166,12 @@ add b = b
.> debug.tab-complete delete.type Foo
* Foo
Foo.
.> debug.tab-complete delete.term add
* add
```
## Tab complete projects and branches
@ -230,5 +238,6 @@ myproject/main> add
myproject/main> debug.tab-complete merge mybr
/mybranch
mybranchsubnamespace
```