mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-17 13:27:30 +03:00
Tab completion speedup (#3312)
* Working and fast prefix-based tab complete * Re-arrange completion modules * Hash completion for conflicted terms * Sort Completions * Remove fuzzy matcher for now * Remove 'Branch' from suggestion signature * Add ability to test completions in transcripts * Use explicit lax-path query parser
This commit is contained in:
Chris Penner
GitHub
parent
723eaf622e
commit
8696fef129
@ -1,6 +1,6 @@
|
||||
cabal-version: 1.12
|
||||
|
||||
-- This file has been generated from package.yaml by hpack version 0.34.7.
|
||||
-- This file has been generated from package.yaml by hpack version 0.34.4.
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
cabal-version: 1.12
|
||||
|
||||
-- This file has been generated from package.yaml by hpack version 0.34.7.
|
||||
-- This file has been generated from package.yaml by hpack version 0.34.4.
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
|
||||
|
||||
@ -3,8 +3,6 @@ cabal-version: 1.12
|
||||
-- This file has been generated from package.yaml by hpack version 0.34.4.
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: e3307c66c00f5bf45548b61cb0aa78f2006c2df8b9ad9172c645f944688d6263
|
||||
|
||||
name: unison-codebase-sync
|
||||
version: 0.0.0
|
||||
|
||||
@ -3,8 +3,6 @@ cabal-version: 1.12
|
||||
-- This file has been generated from package.yaml by hpack version 0.34.4.
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: c95852b01c310af9965bbec9dfa7637e97148815d674788512bd1748a1858314
|
||||
|
||||
name: unison-core
|
||||
version: 0.0.0
|
||||
|
||||
@ -3,8 +3,6 @@ cabal-version: 1.12
|
||||
-- This file has been generated from package.yaml by hpack version 0.34.4.
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: 065e98437c72cce9c4cc6102d3eb0b3c8be444a95c3c71ab65a9d17f29e95eae
|
||||
|
||||
name: unison-util-serialization
|
||||
version: 0.0.0
|
||||
|
||||
@ -3,8 +3,6 @@ cabal-version: 1.12
|
||||
-- This file has been generated from package.yaml by hpack version 0.34.4.
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: 6b08707c87592d47677b3f2db15c17c94a23c13544f339227e43ac19f7ee7947
|
||||
|
||||
name: unison-util-term
|
||||
version: 0.0.0
|
||||
|
||||
@ -38,6 +38,7 @@ module Unison.Codebase
|
||||
beforeImpl,
|
||||
shallowBranchAtPath,
|
||||
getShallowBranchForHash,
|
||||
getShallowBranchFromRoot,
|
||||
getShallowRootBranch,
|
||||
|
||||
-- * Root branch
|
||||
@ -145,6 +146,7 @@ import Unison.Reference (Reference)
|
||||
import qualified Unison.Reference as Reference
|
||||
import qualified Unison.Referent as Referent
|
||||
import qualified Unison.Runtime.IOSource as IOSource
|
||||
import qualified Unison.Sqlite as Sqlite
|
||||
import Unison.Symbol (Symbol)
|
||||
import Unison.Term (Term)
|
||||
import qualified Unison.Term as Term
|
||||
@ -155,13 +157,16 @@ import qualified Unison.UnisonFile as UF
|
||||
import qualified Unison.Util.Relation as Rel
|
||||
import Unison.Var (Var)
|
||||
import qualified Unison.WatchKind as WK
|
||||
import qualified Unison.Sqlite as Sqlite
|
||||
|
||||
-- | Run a transaction on a codebase.
|
||||
runTransaction :: MonadIO m => Codebase m v a -> Sqlite.Transaction b -> m b
|
||||
runTransaction Codebase{withConnection} action =
|
||||
runTransaction Codebase {withConnection} action =
|
||||
withConnection \conn -> Sqlite.runTransaction conn action
|
||||
|
||||
getShallowBranchFromRoot :: Monad m => Codebase m v a -> Path.Absolute -> m (Maybe (V2Branch.CausalBranch m))
|
||||
getShallowBranchFromRoot codebase p = do
|
||||
getShallowRootBranch codebase >>= shallowBranchAtPath (Path.unabsolute p)
|
||||
|
||||
-- | Get the shallow representation of the root branches without loading the children or
|
||||
-- history.
|
||||
getShallowRootBranch :: Monad m => Codebase m v a -> m (V2.CausalBranch m)
|
||||
|
||||
@ -14,7 +14,11 @@ module Unison.Codebase.Path
|
||||
singleton,
|
||||
Unison.Codebase.Path.uncons,
|
||||
empty,
|
||||
isAbsolute,
|
||||
isRelative,
|
||||
absoluteEmpty,
|
||||
absoluteEmpty',
|
||||
relativeEmpty,
|
||||
relativeEmpty',
|
||||
currentPath,
|
||||
prefix,
|
||||
@ -39,7 +43,9 @@ module Unison.Codebase.Path
|
||||
fromName',
|
||||
fromPath',
|
||||
fromText,
|
||||
fromText',
|
||||
toAbsoluteSplit,
|
||||
toSplit',
|
||||
toList,
|
||||
toName,
|
||||
toName',
|
||||
@ -105,6 +111,14 @@ newtype Relative = Relative {unrelative :: Path} deriving (Eq, Ord)
|
||||
newtype Path' = Path' {unPath' :: Either Absolute Relative}
|
||||
deriving (Eq, Ord)
|
||||
|
||||
isAbsolute :: Path' -> Bool
|
||||
isAbsolute (AbsolutePath' _) = True
|
||||
isAbsolute _ = False
|
||||
|
||||
isRelative :: Path' -> Bool
|
||||
isRelative (RelativePath' _) = True
|
||||
isRelative _ = False
|
||||
|
||||
isCurrentPath :: Path' -> Bool
|
||||
isCurrentPath p = p == currentPath
|
||||
|
||||
@ -172,15 +186,24 @@ prefix (Absolute (Path prefix)) (Path' p) = case p of
|
||||
Left (unabsolute -> abs) -> abs
|
||||
Right (unrelative -> rel) -> Path $ prefix <> toSeq rel
|
||||
|
||||
toSplit' :: Path' -> Maybe (Path', NameSegment)
|
||||
toSplit' = Lens.unsnoc
|
||||
|
||||
toAbsoluteSplit :: Absolute -> (Path', a) -> (Absolute, a)
|
||||
toAbsoluteSplit a (p, s) = (resolve a p, s)
|
||||
|
||||
absoluteEmpty :: Absolute
|
||||
absoluteEmpty = Absolute empty
|
||||
|
||||
relativeEmpty :: Relative
|
||||
relativeEmpty = Relative empty
|
||||
|
||||
relativeEmpty' :: Path'
|
||||
relativeEmpty' = Path' (Right (Relative empty))
|
||||
|
||||
absoluteEmpty' :: Path'
|
||||
absoluteEmpty' = Path' (Left (Absolute empty))
|
||||
|
||||
-- | Mitchell: this function is bogus, because an empty name segment is bogus
|
||||
toPath' :: Path -> Path'
|
||||
toPath' = \case
|
||||
@ -298,6 +321,25 @@ fromText = \case
|
||||
"" -> empty
|
||||
t -> fromList $ NameSegment <$> NameSegment.segments' t
|
||||
|
||||
-- | Construct a Path' from a text
|
||||
--
|
||||
-- >>> fromText' "a.b.c"
|
||||
-- a.b.c
|
||||
--
|
||||
-- >>> fromText' ".a.b.c"
|
||||
-- .a.b.c
|
||||
--
|
||||
-- >>> show $ fromText' ""
|
||||
-- ""
|
||||
fromText' :: Text -> Path'
|
||||
fromText' txt =
|
||||
case Text.uncons txt of
|
||||
Nothing -> relativeEmpty'
|
||||
Just ('.', p) ->
|
||||
Path' (Left . Absolute $ fromText p)
|
||||
Just _ ->
|
||||
Path' (Right . Relative $ fromText txt)
|
||||
|
||||
toText' :: Path' -> Text
|
||||
toText' = \case
|
||||
Path' (Left (Absolute path)) -> Text.cons '.' (toText path)
|
||||
@ -319,6 +361,18 @@ instance Cons Path Path NameSegment NameSegment where
|
||||
Path (hd :<| tl) -> Right (hd, Path tl)
|
||||
_ -> Left p
|
||||
|
||||
instance Cons Path' Path' NameSegment NameSegment where
|
||||
_Cons = prism (uncurry cons) uncons
|
||||
where
|
||||
cons :: NameSegment -> Path' -> Path'
|
||||
cons ns (AbsolutePath' p) = AbsolutePath' (ns :< p)
|
||||
cons ns (RelativePath' p) = RelativePath' (ns :< p)
|
||||
uncons :: Path' -> Either Path' (NameSegment, Path')
|
||||
uncons p = case p of
|
||||
AbsolutePath' (ns :< tl) -> Right (ns, AbsolutePath' tl)
|
||||
RelativePath' (ns :< tl) -> Right (ns, RelativePath' tl)
|
||||
_ -> Left p
|
||||
|
||||
instance Snoc Relative Relative NameSegment NameSegment where
|
||||
_Snoc = prism (uncurry snocRelative) $ \case
|
||||
Relative (Lens.unsnoc -> Just (s, a)) -> Right (Relative s, a)
|
||||
@ -327,6 +381,26 @@ instance Snoc Relative Relative NameSegment NameSegment where
|
||||
snocRelative :: Relative -> NameSegment -> Relative
|
||||
snocRelative r n = Relative . (`Lens.snoc` n) $ unrelative r
|
||||
|
||||
instance Cons Relative Relative NameSegment NameSegment where
|
||||
_Cons = prism (uncurry cons) uncons
|
||||
where
|
||||
cons :: NameSegment -> Relative -> Relative
|
||||
cons ns (Relative p) = Relative (ns :< p)
|
||||
uncons :: Relative -> Either Relative (NameSegment, Relative)
|
||||
uncons p = case p of
|
||||
Relative (ns :< tl) -> Right (ns, Relative tl)
|
||||
_ -> Left p
|
||||
|
||||
instance Cons Absolute Absolute NameSegment NameSegment where
|
||||
_Cons = prism (uncurry cons) uncons
|
||||
where
|
||||
cons :: NameSegment -> Absolute -> Absolute
|
||||
cons ns (Absolute p) = Absolute (ns :< p)
|
||||
uncons :: Absolute -> Either Absolute (NameSegment, Absolute)
|
||||
uncons p = case p of
|
||||
Absolute (ns :< tl) -> Right (ns, Absolute tl)
|
||||
_ -> Left p
|
||||
|
||||
instance Snoc Absolute Absolute NameSegment NameSegment where
|
||||
_Snoc = prism (uncurry snocAbsolute) $ \case
|
||||
Absolute (Lens.unsnoc -> Just (s, a)) -> Right (Absolute s, a)
|
||||
|
||||
@ -104,9 +104,11 @@ import qualified Unison.Codebase.TermEdit.Typing as TermEdit
|
||||
import Unison.Codebase.Type (GitPushBehavior (..))
|
||||
import qualified Unison.Codebase.TypeEdit as TypeEdit
|
||||
import qualified Unison.Codebase.Verbosity as Verbosity
|
||||
import qualified Unison.CommandLine.Completion as Completion
|
||||
import qualified Unison.CommandLine.DisplayValues as DisplayValues
|
||||
import qualified Unison.CommandLine.FuzzySelect as Fuzzy
|
||||
import qualified Unison.CommandLine.InputPattern as InputPattern
|
||||
import qualified Unison.CommandLine.InputPatterns as IP
|
||||
import qualified Unison.CommandLine.InputPatterns as InputPatterns
|
||||
import Unison.ConstructorReference (GConstructorReference (..))
|
||||
import qualified Unison.DataDeclaration as DD
|
||||
@ -1386,6 +1388,12 @@ loop e = do
|
||||
effects = [(Name.unsafeFromVar v, r) | (v, (r, _e)) <- Map.toList $ UF.effectDeclarationsId' uf]
|
||||
terms = [(Name.unsafeFromVar v, r) | (v, (r, _wk, _tm, _tp)) <- Map.toList $ UF.hashTermsId uf]
|
||||
Cli.respond $ DumpUnisonFileHashes hqLength datas effects terms
|
||||
DebugTabCompletionI inputs -> do
|
||||
Cli.Env {codebase} <- ask
|
||||
currentPath <- Cli.getCurrentPath
|
||||
let completionFunc = Completion.haskelineTabComplete IP.patternMap codebase currentPath
|
||||
(_, completions) <- liftIO $ completionFunc (reverse (unwords inputs), "")
|
||||
Cli.respond (DisplayDebugCompletions completions)
|
||||
DebugDumpNamespacesI -> do
|
||||
let seen h = State.gets (Set.member h)
|
||||
set h = State.modify (Set.insert h)
|
||||
@ -1647,6 +1655,7 @@ inputDescription input =
|
||||
UiI -> wat
|
||||
UpI {} -> wat
|
||||
VersionI -> wat
|
||||
DebugTabCompletionI _input -> wat
|
||||
where
|
||||
hp' :: Either SBH.ShortBranchHash Path' -> Cli r Text
|
||||
hp' = either (pure . Text.pack . show) p'
|
||||
|
||||
@ -176,6 +176,7 @@ data Input
|
||||
| -- | List all external dependencies of a given namespace, or the current namespace if
|
||||
-- no path is provided.
|
||||
NamespaceDependenciesI (Maybe Path')
|
||||
| DebugTabCompletionI [String] -- The raw arguments provided
|
||||
| DebugNumberedArgsI
|
||||
| DebugTypecheckedUnisonFileI
|
||||
| DebugDumpNamespacesI
|
||||
|
||||
@ -19,6 +19,7 @@ import Data.List.NonEmpty (NonEmpty)
|
||||
import qualified Data.Set as Set
|
||||
import Data.Set.NonEmpty (NESet)
|
||||
import Network.URI (URI)
|
||||
import qualified System.Console.Haskeline as Completion
|
||||
import Unison.Auth.Types (CredentialFailure)
|
||||
import qualified Unison.Codebase.Branch as Branch
|
||||
import Unison.Codebase.Editor.DisplayObject (DisplayObject)
|
||||
@ -256,6 +257,7 @@ data Output
|
||||
| CredentialFailureMsg CredentialFailure
|
||||
| PrintVersion Text
|
||||
| IntegrityCheck IntegrityResult
|
||||
| DisplayDebugCompletions [Completion.Completion]
|
||||
|
||||
data ShareError
|
||||
= ShareErrorCheckAndSetPush Sync.CheckAndSetPushError
|
||||
@ -397,6 +399,7 @@ isFailure o = case o of
|
||||
IntegrityErrorDetected {} -> True
|
||||
ShareError {} -> True
|
||||
ViewOnShare {} -> False
|
||||
DisplayDebugCompletions {} -> False
|
||||
|
||||
isNumberedFailure :: NumberedOutput -> Bool
|
||||
isNumberedFailure = \case
|
||||
|
||||
@ -17,17 +17,6 @@ module Unison.CommandLine
|
||||
warn,
|
||||
warnNote,
|
||||
|
||||
-- * Completers
|
||||
completion,
|
||||
completion',
|
||||
exactComplete,
|
||||
fuzzyComplete,
|
||||
fuzzyCompleteHashQualified,
|
||||
prefixIncomplete,
|
||||
prettyCompletion,
|
||||
fixupCompletion,
|
||||
completeWithinQueryNamespace,
|
||||
|
||||
-- * Other
|
||||
parseInput,
|
||||
prompt,
|
||||
@ -43,12 +32,9 @@ import Data.Configurator (autoConfig, autoReload)
|
||||
import qualified Data.Configurator as Config
|
||||
import Data.Configurator.Types (Config, Worth (..))
|
||||
import Data.List (isPrefixOf, isSuffixOf)
|
||||
import qualified Data.List as List
|
||||
import Data.List.Extra (nubOrd)
|
||||
import Data.ListLike (ListLike)
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Text as Text
|
||||
import qualified System.Console.Haskeline as Line
|
||||
import System.FilePath (takeFileName)
|
||||
import Text.Regex.TDFA ((=~))
|
||||
import Unison.Codebase.Branch (Branch0)
|
||||
@ -58,13 +44,8 @@ import qualified Unison.Codebase.Watch as Watch
|
||||
import qualified Unison.CommandLine.Globbing as Globbing
|
||||
import Unison.CommandLine.InputPattern (InputPattern (..))
|
||||
import qualified Unison.CommandLine.InputPattern as InputPattern
|
||||
import qualified Unison.HashQualified as HQ
|
||||
import qualified Unison.HashQualified' as HQ'
|
||||
import Unison.Names (Names)
|
||||
import Unison.Prelude
|
||||
import qualified Unison.Server.SearchResult as SR
|
||||
import qualified Unison.Util.ColorText as CT
|
||||
import qualified Unison.Util.Find as Find
|
||||
import qualified Unison.Util.Pretty as P
|
||||
import Unison.Util.TQueue (TQueue)
|
||||
import qualified Unison.Util.TQueue as Q
|
||||
@ -125,95 +106,6 @@ emojiNote lead s = P.group (fromString lead) <> "\n" <> P.wrap s
|
||||
nothingTodo :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s
|
||||
nothingTodo = emojiNote "😶"
|
||||
|
||||
completion :: String -> Line.Completion
|
||||
completion s = Line.Completion s s True
|
||||
|
||||
completion' :: String -> Line.Completion
|
||||
completion' s = Line.Completion s s False
|
||||
|
||||
-- discards formatting in favor of better alignment
|
||||
-- prettyCompletion (s, p) = Line.Completion s (P.toPlainUnbroken p) True
|
||||
-- preserves formatting, but Haskeline doesn't know how to align
|
||||
prettyCompletion :: Bool -> (String, P.Pretty P.ColorText) -> Line.Completion
|
||||
prettyCompletion endWithSpace (s, p) = Line.Completion s (P.toAnsiUnbroken p) endWithSpace
|
||||
|
||||
-- | Renders a completion option with the prefix matching the query greyed out.
|
||||
prettyCompletionWithQueryPrefix ::
|
||||
Bool ->
|
||||
-- | query
|
||||
String ->
|
||||
-- | completion
|
||||
String ->
|
||||
Line.Completion
|
||||
prettyCompletionWithQueryPrefix endWithSpace query s =
|
||||
let coloredMatch = P.hiBlack (P.string query) <> P.string (drop (length query) s)
|
||||
in Line.Completion s (P.toAnsiUnbroken coloredMatch) endWithSpace
|
||||
|
||||
fuzzyCompleteHashQualified :: Names -> String -> [Line.Completion]
|
||||
fuzzyCompleteHashQualified b q0@(HQ'.fromString -> query) = case query of
|
||||
Nothing -> []
|
||||
Just query ->
|
||||
fixupCompletion q0 $
|
||||
makeCompletion <$> Find.fuzzyFindInBranch b query
|
||||
where
|
||||
makeCompletion (sr, p) =
|
||||
prettyCompletion False (HQ.toString . SR.name $ sr, p)
|
||||
|
||||
fuzzyComplete :: String -> [String] -> [Line.Completion]
|
||||
fuzzyComplete absQuery@('.' : _) ss = completeWithinQueryNamespace absQuery ss
|
||||
fuzzyComplete fuzzyQuery ss =
|
||||
fixupCompletion fuzzyQuery (prettyCompletion False <$> Find.simpleFuzzyFinder fuzzyQuery ss id)
|
||||
|
||||
-- | Constructs a list of 'Completion's from a query and completion options by
|
||||
-- filtering them for prefix matches. A completion will be selected if it's an exact match for
|
||||
-- a provided option.
|
||||
exactComplete :: String -> [String] -> [Line.Completion]
|
||||
exactComplete q ss = go <$> filter (isPrefixOf q) ss
|
||||
where
|
||||
go s = prettyCompletionWithQueryPrefix (s == q) q s
|
||||
|
||||
-- | Completes a list of options, limiting options to the same namespace as the query,
|
||||
-- or the namespace's children if the query is itself a namespace.
|
||||
--
|
||||
-- E.g.
|
||||
-- query: "base"
|
||||
-- would match: ["base", "base.List", "base2"]
|
||||
-- wouldn't match: ["base.List.map", "contrib", "base2.List"]
|
||||
completeWithinQueryNamespace :: String -> [String] -> [Line.Completion]
|
||||
completeWithinQueryNamespace q ss = (go <$> (limitToQueryNamespace q $ ss))
|
||||
where
|
||||
go s = prettyCompletionWithQueryPrefix (s == q) q s
|
||||
limitToQueryNamespace :: String -> [String] -> [String]
|
||||
limitToQueryNamespace query xs =
|
||||
nubOrd $ catMaybes (fmap ((query <>) . thing) . List.stripPrefix query <$> xs)
|
||||
where
|
||||
thing ('.' : rest) = '.' : takeWhile (/= '.') rest
|
||||
thing other = takeWhile (/= '.') other
|
||||
|
||||
prefixIncomplete :: String -> [String] -> [Line.Completion]
|
||||
prefixIncomplete q ss = go <$> filter (isPrefixOf q) ss
|
||||
where
|
||||
go s =
|
||||
prettyCompletion
|
||||
False
|
||||
(s, P.hiBlack (P.string q) <> P.string (drop (length q) s))
|
||||
|
||||
-- workaround for https://github.com/judah/haskeline/issues/100
|
||||
-- if the common prefix of all the completions is smaller than
|
||||
-- the query, we make all the replacements equal to the query,
|
||||
-- which will preserve what the user has typed
|
||||
fixupCompletion :: String -> [Line.Completion] -> [Line.Completion]
|
||||
fixupCompletion _q [] = []
|
||||
fixupCompletion _q [c] = [c]
|
||||
fixupCompletion q cs@(h : t) =
|
||||
let commonPrefix (h1 : t1) (h2 : t2) | h1 == h2 = h1 : commonPrefix t1 t2
|
||||
commonPrefix _ _ = ""
|
||||
overallCommonPrefix =
|
||||
foldl commonPrefix (Line.replacement h) (Line.replacement <$> t)
|
||||
in if not (q `isPrefixOf` overallCommonPrefix)
|
||||
then [c {Line.replacement = q} | c <- cs]
|
||||
else cs
|
||||
|
||||
parseInput ::
|
||||
-- | Root branch, used to expand globs
|
||||
Branch0 m ->
|
||||
|
||||
353
unison-cli/src/Unison/CommandLine/Completion.hs
Normal file
353
unison-cli/src/Unison/CommandLine/Completion.hs
Normal file
@ -0,0 +1,353 @@
|
||||
{-
|
||||
This module defines tab-completion strategies for entering info via the CLI
|
||||
-}
|
||||
module Unison.CommandLine.Completion
|
||||
( -- * Completers
|
||||
exactComplete,
|
||||
prefixCompleteTermOrType,
|
||||
prefixCompleteTerm,
|
||||
prefixCompleteType,
|
||||
prefixCompletePatch,
|
||||
noCompletions,
|
||||
prefixCompleteNamespace,
|
||||
-- Unused for now, but may be useful later
|
||||
prettyCompletion,
|
||||
fixupCompletion,
|
||||
haskelineTabComplete,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Lens (ifoldMap)
|
||||
import qualified Control.Lens as Lens
|
||||
import Control.Lens.Cons (unsnoc)
|
||||
import Data.List (isPrefixOf)
|
||||
import qualified Data.List as List
|
||||
import Data.List.Extra (nubOrdOn)
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import qualified Data.Map as Map
|
||||
import Data.Set.NonEmpty (NESet)
|
||||
import qualified Data.Set.NonEmpty as NESet
|
||||
import qualified Data.Text as Text
|
||||
import qualified System.Console.Haskeline as Line
|
||||
import System.Console.Haskeline.Completion (Completion)
|
||||
import qualified System.Console.Haskeline.Completion as Haskeline
|
||||
import qualified U.Codebase.Branch as V2Branch
|
||||
import qualified U.Codebase.Causal as V2Causal
|
||||
import qualified U.Codebase.Reference as Reference
|
||||
import qualified U.Codebase.Referent as Referent
|
||||
import qualified U.Util.Monoid as Monoid
|
||||
import Unison.Codebase (Codebase)
|
||||
import qualified Unison.Codebase as Codebase
|
||||
import qualified Unison.Codebase.Path as Path
|
||||
import qualified Unison.Codebase.SqliteCodebase.Conversions as Cv
|
||||
import qualified Unison.CommandLine.InputPattern as IP
|
||||
import qualified Unison.Hash as H
|
||||
import qualified Unison.HashQualified' as HQ'
|
||||
import Unison.NameSegment (NameSegment (NameSegment))
|
||||
import qualified Unison.NameSegment as NameSegment
|
||||
import Unison.Prelude
|
||||
import qualified Unison.ShortHash as SH
|
||||
import qualified Unison.Util.Pretty as P
|
||||
import Prelude hiding (readFile, writeFile)
|
||||
|
||||
-- | A completion func for use with Haskeline
|
||||
haskelineTabComplete ::
|
||||
Monad m =>
|
||||
Map String IP.InputPattern ->
|
||||
Codebase m v a ->
|
||||
Path.Absolute ->
|
||||
Line.CompletionFunc m
|
||||
haskelineTabComplete patterns codebase currentPath = Line.completeWordWithPrev Nothing " " $ \prev word ->
|
||||
-- User hasn't finished a command name, complete from command names
|
||||
if null prev
|
||||
then pure . exactComplete word $ Map.keys patterns
|
||||
else -- User has finished a command name; use completions for that command
|
||||
case words $ reverse prev of
|
||||
h : t -> fromMaybe (pure []) $ do
|
||||
p <- Map.lookup h patterns
|
||||
argType <- IP.argType p (length t)
|
||||
pure $ IP.suggestions argType word codebase currentPath
|
||||
_ -> pure []
|
||||
|
||||
-- | Things which we may want to complete for.
|
||||
data CompletionType
|
||||
= NamespaceCompletion
|
||||
| TermCompletion
|
||||
| TypeCompletion
|
||||
| PatchCompletion
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
-- | The empty completor.
|
||||
noCompletions ::
|
||||
Monad m =>
|
||||
String ->
|
||||
Codebase m v a ->
|
||||
Path.Absolute ->
|
||||
m [System.Console.Haskeline.Completion.Completion]
|
||||
noCompletions _ _ _ = pure []
|
||||
|
||||
-- | Finds names of the selected completion types within the path provided by the query.
|
||||
--
|
||||
-- Given a codebase with these terms:
|
||||
--
|
||||
-- @@
|
||||
-- .base.List.map.doc
|
||||
-- .base.List
|
||||
-- .bar.foo
|
||||
-- @@
|
||||
--
|
||||
-- We will return:
|
||||
--
|
||||
-- @@
|
||||
-- .> cd bas<Tab>
|
||||
-- base
|
||||
--
|
||||
-- .> cd base<Tab>
|
||||
-- base
|
||||
-- base.List
|
||||
--
|
||||
-- .> cd base.<Tab>
|
||||
-- base.List
|
||||
--
|
||||
-- .> cd base.List.<Tab>
|
||||
-- base.List.map
|
||||
--
|
||||
-- If conflicted, or if there's a # in the query, we expand completions into short-hashes.
|
||||
-- This is also a convenient way to just see the shorthash for a given term.
|
||||
--
|
||||
-- .> view base.List.map#<Tab>
|
||||
-- base.List.map#0q926sgnn6
|
||||
completeWithinNamespace ::
|
||||
forall m v a.
|
||||
Monad m =>
|
||||
-- | The types of completions to return
|
||||
NESet CompletionType ->
|
||||
-- | The portion of this are that the user has already typed.
|
||||
String ->
|
||||
Codebase m v a ->
|
||||
Path.Absolute ->
|
||||
m [System.Console.Haskeline.Completion.Completion]
|
||||
completeWithinNamespace compTypes query codebase currentPath = do
|
||||
shortHashLen <- Codebase.hashLength codebase
|
||||
Codebase.getShallowBranchFromRoot codebase absQueryPath >>= \case
|
||||
Nothing -> do
|
||||
pure []
|
||||
Just cb -> do
|
||||
b <- V2Causal.value cb
|
||||
let currentBranchSuggestions =
|
||||
namesInBranch shortHashLen b
|
||||
& fmap (\(isFinished, match) -> (isFinished, Text.unpack . Path.toText' $ queryPathPrefix Lens.:> NameSegment.NameSegment match))
|
||||
& filter (\(_isFinished, match) -> List.isPrefixOf query match)
|
||||
& fmap (\(isFinished, match) -> prettyCompletionWithQueryPrefix isFinished query match)
|
||||
|
||||
childSuggestions <- getChildSuggestions shortHashLen b
|
||||
pure . nubOrdOn Haskeline.replacement . List.sortOn Haskeline.replacement $ currentBranchSuggestions <> childSuggestions
|
||||
where
|
||||
queryPathPrefix :: Path.Path'
|
||||
querySuffix :: NameSegment.NameSegment
|
||||
(queryPathPrefix, querySuffix) = parseLaxPath'Query (Text.pack query)
|
||||
absQueryPath :: Path.Absolute
|
||||
absQueryPath = Path.resolve currentPath queryPathPrefix
|
||||
getChildSuggestions :: Int -> V2Branch.Branch m -> m [Completion]
|
||||
getChildSuggestions shortHashLen b = do
|
||||
case querySuffix of
|
||||
"" -> pure []
|
||||
suffix -> do
|
||||
case Map.lookup (Cv.namesegment1to2 suffix) (V2Branch.children b) of
|
||||
Nothing -> pure []
|
||||
Just childCausal -> do
|
||||
childBranch <- V2Causal.value childCausal
|
||||
namesInBranch shortHashLen childBranch
|
||||
& fmap
|
||||
( \(isFinished, match) -> (isFinished, Text.unpack . Path.toText' $ queryPathPrefix Lens.:> suffix Lens.:> NameSegment.NameSegment match)
|
||||
)
|
||||
& filter (\(_isFinished, match) -> List.isPrefixOf query match)
|
||||
& fmap (\(isFinished, match) -> prettyCompletionWithQueryPrefix isFinished query match)
|
||||
& pure
|
||||
namesInBranch :: Int -> V2Branch.Branch m -> [(Bool, Text)]
|
||||
namesInBranch hashLen b =
|
||||
let textifyHQ :: (V2Branch.NameSegment -> r -> HQ'.HashQualified V2Branch.NameSegment) -> Map V2Branch.NameSegment (Map r metadata) -> [(Bool, Text)]
|
||||
textifyHQ f xs =
|
||||
xs
|
||||
& hashQualifyCompletions f
|
||||
& fmap (HQ'.toTextWith V2Branch.unNameSegment)
|
||||
& fmap (True,)
|
||||
in ((False,) <$> dotifyNamespaces (fmap V2Branch.unNameSegment . Map.keys $ V2Branch.children b))
|
||||
<> 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,) . V2Branch.unNameSegment) . Map.keys $ V2Branch.patches b)
|
||||
|
||||
-- Regrettably there'shqFromNamedV2Referencenot a great spot to combinators for V2 references and shorthashes right now.
|
||||
hqFromNamedV2Referent :: Int -> V2Branch.NameSegment -> Referent.Referent -> HQ'.HashQualified V2Branch.NameSegment
|
||||
hqFromNamedV2Referent hashLen n r = HQ'.HashQualified n (SH.take hashLen $ v2ReferentToShortHash r)
|
||||
hqFromNamedV2Reference :: Int -> V2Branch.NameSegment -> Reference.Reference -> HQ'.HashQualified V2Branch.NameSegment
|
||||
hqFromNamedV2Reference hashLen n r = HQ'.HashQualified n (SH.take hashLen $ v2ReferenceToShortHash r)
|
||||
v2ReferentToShortHash :: Referent.Referent -> SH.ShortHash
|
||||
v2ReferentToShortHash = \case
|
||||
Referent.Ref r -> v2ReferenceToShortHash r
|
||||
Referent.Con r conId ->
|
||||
case v2ReferenceToShortHash r of
|
||||
SH.ShortHash h p _con -> SH.ShortHash h p (Just $ tShow conId)
|
||||
sh@(SH.Builtin {}) -> sh
|
||||
|
||||
v2ReferenceToShortHash :: Reference.Reference -> SH.ShortHash
|
||||
v2ReferenceToShortHash (Reference.ReferenceBuiltin b) = SH.Builtin b
|
||||
v2ReferenceToShortHash (Reference.ReferenceDerived (Reference.Id h i)) = SH.ShortHash (H.base32Hex h) (showComponentPos i) Nothing
|
||||
showComponentPos :: Reference.Pos -> Maybe Text
|
||||
showComponentPos 0 = Nothing
|
||||
showComponentPos n = Just (tShow n)
|
||||
|
||||
hashQualifyCompletions :: forall r metadata. (V2Branch.NameSegment -> r -> HQ'.HashQualified V2Branch.NameSegment) -> Map V2Branch.NameSegment (Map r metadata) -> [HQ'.HashQualified V2Branch.NameSegment]
|
||||
hashQualifyCompletions qualify defs = ifoldMap qualifyRefs defs
|
||||
where
|
||||
-- Qualify any conflicted definitions. If the query has a "#" in it, then qualify ALL
|
||||
-- completions.
|
||||
qualifyRefs :: V2Branch.NameSegment -> (Map r metadata) -> [HQ'.HashQualified V2Branch.NameSegment]
|
||||
qualifyRefs n refs
|
||||
| ((Text.isInfixOf "#" . NameSegment.toText) querySuffix) || length refs > 1 =
|
||||
refs
|
||||
& Map.keys
|
||||
<&> qualify n
|
||||
| otherwise = [HQ'.NameOnly n]
|
||||
|
||||
-- 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
|
||||
|
||||
-- | 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.
|
||||
-- This is used in tab-completion where the difference between `.base` and `.base.` is
|
||||
-- relevant, but can't be detected when running something like 'Path.fromText''
|
||||
--
|
||||
-- >>> parseLaxPath'Query ".base."
|
||||
-- (.base,"")
|
||||
--
|
||||
-- >>> parseLaxPath'Query ".base"
|
||||
-- (.,"base")
|
||||
--
|
||||
-- >>> parseLaxPath'Query ".base.List"
|
||||
-- (.base,"List")
|
||||
--
|
||||
-- >>> parseLaxPath'Query ""
|
||||
-- (,"")
|
||||
--
|
||||
-- >>> parseLaxPath'Query "base"
|
||||
-- (,"base")
|
||||
--
|
||||
-- >>> parseLaxPath'Query "base."
|
||||
-- (base,"")
|
||||
--
|
||||
-- >>> parseLaxPath'Query "base.List"
|
||||
-- (base,"List")
|
||||
parseLaxPath'Query :: Text -> (Path.Path', NameSegment)
|
||||
parseLaxPath'Query txt =
|
||||
case unsnoc (Text.splitOn "." txt) of
|
||||
-- This case is impossible due to the behaviour of 'splitOn'
|
||||
Nothing ->
|
||||
(Path.relativeEmpty', NameSegment "")
|
||||
-- ".base."
|
||||
-- ".base.List"
|
||||
Just ("" : pathPrefix, querySegment) -> (Path.AbsolutePath' . Path.Absolute . Path.fromList . fmap NameSegment $ pathPrefix, NameSegment querySegment)
|
||||
-- ""
|
||||
-- "base"
|
||||
-- "base.List"
|
||||
Just (pathPrefix, querySegment) ->
|
||||
( Path.RelativePath' . Path.Relative . Path.fromList . fmap NameSegment $ pathPrefix,
|
||||
NameSegment querySegment
|
||||
)
|
||||
|
||||
-- | Completes a namespace argument by prefix-matching against the query.
|
||||
prefixCompleteNamespace ::
|
||||
forall m v a.
|
||||
Monad m =>
|
||||
String ->
|
||||
Codebase m v a ->
|
||||
Path.Absolute -> -- Current path
|
||||
m [Line.Completion]
|
||||
prefixCompleteNamespace = completeWithinNamespace (NESet.singleton NamespaceCompletion)
|
||||
|
||||
-- | Completes a term or type argument by prefix-matching against the query.
|
||||
prefixCompleteTermOrType ::
|
||||
forall m v a.
|
||||
Monad m =>
|
||||
String ->
|
||||
Codebase m v a ->
|
||||
Path.Absolute -> -- Current path
|
||||
m [Line.Completion]
|
||||
prefixCompleteTermOrType = completeWithinNamespace (NESet.fromList (TermCompletion NE.:| [TypeCompletion]))
|
||||
|
||||
-- | Completes a term argument by prefix-matching against the query.
|
||||
prefixCompleteTerm ::
|
||||
forall m v a.
|
||||
Monad m =>
|
||||
String ->
|
||||
Codebase m v a ->
|
||||
Path.Absolute -> -- Current path
|
||||
m [Line.Completion]
|
||||
prefixCompleteTerm = completeWithinNamespace (NESet.singleton TermCompletion)
|
||||
|
||||
-- | Completes a term or type argument by prefix-matching against the query.
|
||||
prefixCompleteType ::
|
||||
forall m v a.
|
||||
Monad m =>
|
||||
String ->
|
||||
Codebase m v a ->
|
||||
Path.Absolute -> -- Current path
|
||||
m [Line.Completion]
|
||||
prefixCompleteType = completeWithinNamespace (NESet.singleton TypeCompletion)
|
||||
|
||||
-- | Completes a patch argument by prefix-matching against the query.
|
||||
prefixCompletePatch ::
|
||||
forall m v a.
|
||||
Monad m =>
|
||||
String ->
|
||||
Codebase m v a ->
|
||||
Path.Absolute -> -- Current path
|
||||
m [Line.Completion]
|
||||
prefixCompletePatch = completeWithinNamespace (NESet.singleton PatchCompletion)
|
||||
|
||||
-- | Renders a completion option with the prefix matching the query greyed out.
|
||||
prettyCompletionWithQueryPrefix ::
|
||||
Bool ->
|
||||
-- | query
|
||||
String ->
|
||||
-- | completion
|
||||
String ->
|
||||
Line.Completion
|
||||
prettyCompletionWithQueryPrefix endWithSpace query s =
|
||||
let coloredMatch = P.hiBlack (P.string query) <> P.string (drop (length query) s)
|
||||
in Line.Completion s (P.toAnsiUnbroken coloredMatch) endWithSpace
|
||||
|
||||
-- discards formatting in favor of better alignment
|
||||
-- prettyCompletion (s, p) = Line.Completion s (P.toPlainUnbroken p) True
|
||||
-- preserves formatting, but Haskeline doesn't know how to align
|
||||
prettyCompletion :: Bool -> (String, P.Pretty P.ColorText) -> Line.Completion
|
||||
prettyCompletion endWithSpace (s, p) = Line.Completion s (P.toAnsiUnbroken p) endWithSpace
|
||||
|
||||
-- | Constructs a list of 'Completion's from a query and completion options by
|
||||
-- filtering them for prefix matches. A completion will be selected if it's an exact match for
|
||||
-- a provided option.
|
||||
exactComplete :: String -> [String] -> [Line.Completion]
|
||||
exactComplete q ss = go <$> filter (isPrefixOf q) ss
|
||||
where
|
||||
go s = prettyCompletionWithQueryPrefix (s == q) q s
|
||||
|
||||
-- workaround for https://github.com/judah/haskeline/issues/100
|
||||
-- if the common prefix of all the completions is smaller than
|
||||
-- the query, we make all the replacements equal to the query,
|
||||
-- which will preserve what the user has typed
|
||||
fixupCompletion :: String -> [Line.Completion] -> [Line.Completion]
|
||||
fixupCompletion _q [] = []
|
||||
fixupCompletion _q [c] = [c]
|
||||
fixupCompletion q cs@(h : t) =
|
||||
let commonPrefix (h1 : t1) (h2 : t2) | h1 == h2 = h1 : commonPrefix t1 t2
|
||||
commonPrefix _ _ = ""
|
||||
overallCommonPrefix =
|
||||
foldl commonPrefix (Line.replacement h) (Line.replacement <$> t)
|
||||
in if not (q `isPrefixOf` overallCommonPrefix)
|
||||
then [c {Line.replacement = q} | c <- cs]
|
||||
else cs
|
||||
@ -2,12 +2,22 @@
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
module Unison.CommandLine.InputPattern where
|
||||
module Unison.CommandLine.InputPattern
|
||||
( InputPattern (..),
|
||||
ArgumentType (..),
|
||||
argType,
|
||||
IsOptional (..),
|
||||
Visibility (..),
|
||||
|
||||
-- * Currently Unused
|
||||
minArgs,
|
||||
maxArgs,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Set (Set)
|
||||
import qualified System.Console.Haskeline as Line
|
||||
import Unison.Codebase (Codebase)
|
||||
import Unison.Codebase.Branch (Branch)
|
||||
import Unison.Codebase.Editor.Input (Input (..))
|
||||
import Unison.Codebase.Path as Path
|
||||
import qualified Unison.CommandLine.Globbing as Globbing
|
||||
@ -43,7 +53,6 @@ data ArgumentType = ArgumentType
|
||||
Monad m =>
|
||||
String ->
|
||||
Codebase m v a ->
|
||||
Branch m -> -- Root Branch
|
||||
Path.Absolute -> -- Current path
|
||||
m [Line.Completion],
|
||||
-- | Select which targets glob patterns may expand into for this argument.
|
||||
@ -105,12 +114,3 @@ maxArgs ip@(fmap fst . argTypes -> args) = go args
|
||||
<> show (patternName ip)
|
||||
<> "): "
|
||||
<> show args
|
||||
|
||||
noSuggestions ::
|
||||
Monad m =>
|
||||
String ->
|
||||
Codebase m v a ->
|
||||
Branch m ->
|
||||
Path.Absolute ->
|
||||
m [Line.Completion]
|
||||
noSuggestions _ _ _ _ = pure []
|
||||
|
||||
@ -5,8 +5,7 @@ module Unison.CommandLine.InputPatterns where
|
||||
|
||||
import qualified Control.Lens.Cons as Cons
|
||||
import Data.Bifunctor (Bifunctor (bimap), first)
|
||||
import Data.List (intercalate, isPrefixOf)
|
||||
import Data.List.Extra (nubOrdOn)
|
||||
import Data.List (intercalate)
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import qualified Data.Map as Map
|
||||
import Data.Proxy (Proxy (..))
|
||||
@ -14,12 +13,9 @@ import qualified Data.Set as Set
|
||||
import qualified Data.Text as Text
|
||||
import Data.Void (Void)
|
||||
import System.Console.Haskeline.Completion (Completion (Completion))
|
||||
import qualified System.Console.Haskeline.Completion as Completion
|
||||
import qualified Text.Megaparsec as P
|
||||
import Unison.Codebase (Codebase)
|
||||
import qualified Unison.Codebase.Branch as Branch
|
||||
import qualified Unison.Codebase.Branch.Merge as Branch
|
||||
import qualified Unison.Codebase.Branch.Names as Branch
|
||||
import Unison.Codebase.Editor.Input (Input)
|
||||
import qualified Unison.Codebase.Editor.Input as Input
|
||||
import Unison.Codebase.Editor.Output.PushPull (PushPull (Pull, Push))
|
||||
@ -34,6 +30,7 @@ import qualified Unison.Codebase.SyncMode as SyncMode
|
||||
import Unison.Codebase.Verbosity (Verbosity)
|
||||
import qualified Unison.Codebase.Verbosity as Verbosity
|
||||
import Unison.CommandLine
|
||||
import Unison.CommandLine.Completion
|
||||
import qualified Unison.CommandLine.Globbing as Globbing
|
||||
import Unison.CommandLine.InputPattern
|
||||
( ArgumentType (..),
|
||||
@ -44,13 +41,11 @@ import qualified Unison.CommandLine.InputPattern as I
|
||||
import qualified Unison.HashQualified as HQ
|
||||
import Unison.Name (Name)
|
||||
import qualified Unison.Name as Name
|
||||
import Unison.NameSegment (NameSegment (NameSegment))
|
||||
import qualified Unison.Names as Names
|
||||
import qualified Unison.NameSegment as NameSegment
|
||||
import Unison.Prelude
|
||||
import qualified Unison.Util.ColorText as CT
|
||||
import Unison.Util.Monoid (intercalateMap)
|
||||
import qualified Unison.Util.Pretty as P
|
||||
import qualified Unison.Util.Relation as R
|
||||
|
||||
showPatternHelp :: InputPattern -> P.Pretty CT.ColorText
|
||||
showPatternHelp i =
|
||||
@ -155,7 +150,7 @@ load =
|
||||
"load"
|
||||
[]
|
||||
I.Visible
|
||||
[(Optional, noCompletions)]
|
||||
[(Optional, noCompletionsArg)]
|
||||
( P.wrapColumn2
|
||||
[ ( makeExample' load,
|
||||
"parses, typechecks, and evaluates the most recent scratch file."
|
||||
@ -177,7 +172,7 @@ add =
|
||||
"add"
|
||||
[]
|
||||
I.Visible
|
||||
[(ZeroPlus, noCompletions)]
|
||||
[(ZeroPlus, noCompletionsArg)]
|
||||
( "`add` adds to the codebase all the definitions from the most recently "
|
||||
<> "typechecked file."
|
||||
)
|
||||
@ -189,7 +184,7 @@ previewAdd =
|
||||
"add.preview"
|
||||
[]
|
||||
I.Visible
|
||||
[(ZeroPlus, noCompletions)]
|
||||
[(ZeroPlus, noCompletionsArg)]
|
||||
( "`add.preview` previews additions to the codebase from the most recently "
|
||||
<> "typechecked file. This command only displays cached typechecking "
|
||||
<> "results. Use `load` to reparse & typecheck the file if the context "
|
||||
@ -203,7 +198,7 @@ updateNoPatch =
|
||||
"update.nopatch"
|
||||
["un"]
|
||||
I.Visible
|
||||
[(ZeroPlus, noCompletions)]
|
||||
[(ZeroPlus, noCompletionsArg)]
|
||||
( P.wrap
|
||||
( makeExample' updateNoPatch
|
||||
<> "works like"
|
||||
@ -237,7 +232,7 @@ update =
|
||||
"update"
|
||||
[]
|
||||
I.Visible
|
||||
[(Optional, patchArg), (ZeroPlus, noCompletions)]
|
||||
[(Optional, patchArg), (ZeroPlus, noCompletionsArg)]
|
||||
( P.wrap
|
||||
( makeExample' update
|
||||
<> "works like"
|
||||
@ -281,7 +276,7 @@ previewUpdate =
|
||||
"update.preview"
|
||||
[]
|
||||
I.Visible
|
||||
[(ZeroPlus, noCompletions)]
|
||||
[(ZeroPlus, noCompletionsArg)]
|
||||
( "`update.preview` previews updates to the codebase from the most "
|
||||
<> "recently typechecked file. This command only displays cached "
|
||||
<> "typechecking results. Use `load` to reparse & typecheck the file if "
|
||||
@ -366,7 +361,7 @@ displayTo =
|
||||
"display.to"
|
||||
[]
|
||||
I.Visible
|
||||
[(Required, noCompletions), (ZeroPlus, definitionQueryArg)]
|
||||
[(Required, noCompletionsArg), (ZeroPlus, definitionQueryArg)]
|
||||
( P.wrap $
|
||||
makeExample displayTo ["<filename>", "foo"]
|
||||
<> "prints a rendered version of the term `foo` to the given file."
|
||||
@ -448,7 +443,7 @@ find' cmd fscope =
|
||||
cmd
|
||||
[]
|
||||
I.Visible
|
||||
[(ZeroPlus, fuzzyDefinitionQueryArg)]
|
||||
[(ZeroPlus, exactDefinitionArg)]
|
||||
( P.wrapColumn2
|
||||
[ ("`find`", "lists all definitions in the current namespace."),
|
||||
( "`find foo`",
|
||||
@ -497,7 +492,7 @@ findVerbose =
|
||||
"find.verbose"
|
||||
[]
|
||||
I.Visible
|
||||
[(ZeroPlus, fuzzyDefinitionQueryArg)]
|
||||
[(ZeroPlus, exactDefinitionArg)]
|
||||
( "`find.verbose` searches for definitions like `find`, but includes hashes "
|
||||
<> "and aliases in the results."
|
||||
)
|
||||
@ -509,7 +504,7 @@ findVerboseAll =
|
||||
"find.all.verbose"
|
||||
[]
|
||||
I.Visible
|
||||
[(ZeroPlus, fuzzyDefinitionQueryArg)]
|
||||
[(ZeroPlus, exactDefinitionArg)]
|
||||
( "`find.all.verbose` searches for definitions like `find.all`, but includes hashes "
|
||||
<> "and aliases in the results."
|
||||
)
|
||||
@ -738,7 +733,7 @@ aliasMany =
|
||||
"alias.many"
|
||||
["copy"]
|
||||
I.Visible
|
||||
[(Required, definitionQueryArg), (OnePlus, exactDefinitionOrPathArg)]
|
||||
[(Required, definitionQueryArg), (OnePlus, exactDefinitionArg)]
|
||||
( P.group . P.lines $
|
||||
[ P.wrap $
|
||||
P.group (makeExample aliasMany ["<relative1>", "[relative2...]", "<namespace>"])
|
||||
@ -1087,6 +1082,22 @@ pullExhaustive =
|
||||
_ -> Left (I.help pull)
|
||||
)
|
||||
|
||||
debugTabCompletion :: InputPattern
|
||||
debugTabCompletion =
|
||||
InputPattern
|
||||
"debug.tab-complete"
|
||||
[]
|
||||
I.Hidden
|
||||
[(ZeroPlus, noCompletionsArg)]
|
||||
( P.lines
|
||||
[ P.wrap $ "This command can be used to test and debug ucm's tab-completion within transcripts.",
|
||||
P.wrap $ "Completions which are finished are prefixed with a *"
|
||||
]
|
||||
)
|
||||
( \inputs ->
|
||||
Right $ Input.DebugTabCompletionI inputs
|
||||
)
|
||||
|
||||
push :: InputPattern
|
||||
push =
|
||||
InputPattern
|
||||
@ -1567,7 +1578,7 @@ topicNameArg :: ArgumentType
|
||||
topicNameArg =
|
||||
ArgumentType
|
||||
{ typeName = "topic",
|
||||
suggestions = \q _ _ _ -> pure (exactComplete q $ Map.keys helpTopicsMap),
|
||||
suggestions = \q _ _ -> pure (exactComplete q $ Map.keys helpTopicsMap),
|
||||
globTargets = mempty
|
||||
}
|
||||
|
||||
@ -1575,7 +1586,7 @@ codebaseServerNameArg :: ArgumentType
|
||||
codebaseServerNameArg =
|
||||
ArgumentType
|
||||
{ typeName = "codebase-server",
|
||||
suggestions = \q _ _ _ -> pure (exactComplete q $ Map.keys helpTopicsMap),
|
||||
suggestions = \q _ _ -> pure (exactComplete q $ Map.keys helpTopicsMap),
|
||||
globTargets = mempty
|
||||
}
|
||||
|
||||
@ -1949,7 +1960,7 @@ debugDumpNamespace =
|
||||
"debug.dump-namespace"
|
||||
[]
|
||||
I.Visible
|
||||
[(Required, noCompletions)]
|
||||
[(Required, noCompletionsArg)]
|
||||
"Dump the namespace to a text file"
|
||||
(const $ Right Input.DebugDumpNamespacesI)
|
||||
|
||||
@ -1959,7 +1970,7 @@ debugDumpNamespaceSimple =
|
||||
"debug.dump-namespace-simple"
|
||||
[]
|
||||
I.Visible
|
||||
[(Required, noCompletions)]
|
||||
[(Required, noCompletionsArg)]
|
||||
"Dump the namespace to a text file"
|
||||
(const $ Right Input.DebugDumpNamespaceSimpleI)
|
||||
|
||||
@ -1969,7 +1980,7 @@ debugClearWatchCache =
|
||||
"debug.clear-cache"
|
||||
[]
|
||||
I.Visible
|
||||
[(Required, noCompletions)]
|
||||
[(Required, noCompletionsArg)]
|
||||
"Clear the watch expression cache"
|
||||
(const $ Right Input.DebugClearWatchI)
|
||||
|
||||
@ -2050,7 +2061,7 @@ execute =
|
||||
"run"
|
||||
[]
|
||||
I.Visible
|
||||
[(Required, exactDefinitionTermQueryArg), (ZeroPlus, noCompletions)]
|
||||
[(Required, exactDefinitionTermQueryArg), (ZeroPlus, noCompletionsArg)]
|
||||
( P.wrapColumn2
|
||||
[ ( "`run mymain args...`",
|
||||
"Runs `!mymain`, where `mymain` is searched for in the most recent"
|
||||
@ -2091,7 +2102,7 @@ makeStandalone =
|
||||
"compile"
|
||||
["compile.output"]
|
||||
I.Visible
|
||||
[(Required, exactDefinitionTermQueryArg), (Required, noCompletions)]
|
||||
[(Required, exactDefinitionTermQueryArg), (Required, noCompletionsArg)]
|
||||
( P.wrapColumn2
|
||||
[ ( "`compile main file`",
|
||||
"Outputs a stand alone file that can be directly loaded and"
|
||||
@ -2112,7 +2123,7 @@ createAuthor =
|
||||
"create.author"
|
||||
[]
|
||||
I.Visible
|
||||
[(Required, noCompletions), (Required, noCompletions)]
|
||||
[(Required, noCompletionsArg), (Required, noCompletionsArg)]
|
||||
( makeExample createAuthor ["alicecoder", "\"Alice McGee\""]
|
||||
<> "creates"
|
||||
<> backtick "alicecoder"
|
||||
@ -2287,11 +2298,19 @@ validInputs =
|
||||
debugDumpNamespaceSimple,
|
||||
debugClearWatchCache,
|
||||
debugDoctor,
|
||||
debugTabCompletion,
|
||||
gist,
|
||||
authLogin,
|
||||
printVersion
|
||||
]
|
||||
|
||||
-- | A map of all command patterns by pattern name or alias.
|
||||
patternMap :: Map String InputPattern
|
||||
patternMap =
|
||||
Map.fromList $
|
||||
validInputs
|
||||
>>= (\p -> (I.patternName p, p) : ((,p) <$> I.aliases p))
|
||||
|
||||
visibleInputs :: [InputPattern]
|
||||
visibleInputs = filter ((== I.Visible) . I.visibility) validInputs
|
||||
|
||||
@ -2302,43 +2321,34 @@ commandNameArg :: ArgumentType
|
||||
commandNameArg =
|
||||
ArgumentType
|
||||
{ typeName = "command",
|
||||
suggestions = \q _ _ _ -> pure (exactComplete q (commandNames <> Map.keys helpTopicsMap)),
|
||||
suggestions = \q _ _ -> pure (exactComplete q (commandNames <> Map.keys helpTopicsMap)),
|
||||
globTargets = mempty
|
||||
}
|
||||
|
||||
exactDefinitionOrPathArg :: ArgumentType
|
||||
exactDefinitionOrPathArg =
|
||||
exactDefinitionArg :: ArgumentType
|
||||
exactDefinitionArg =
|
||||
ArgumentType
|
||||
{ typeName = "definition or path",
|
||||
suggestions =
|
||||
allCompletors
|
||||
[ termCompletor exactComplete,
|
||||
typeCompletor exactComplete,
|
||||
pathCompletor exactComplete (Set.map Path.toText . Branch.deepPaths)
|
||||
],
|
||||
globTargets = Set.fromList [Globbing.Term, Globbing.Type, Globbing.Namespace]
|
||||
{ typeName = "definition",
|
||||
suggestions = prefixCompleteTermOrType,
|
||||
globTargets = Set.fromList [Globbing.Term, Globbing.Type]
|
||||
}
|
||||
|
||||
-- todo: improve this
|
||||
fuzzyDefinitionQueryArg :: ArgumentType
|
||||
fuzzyDefinitionQueryArg =
|
||||
ArgumentType
|
||||
{ typeName = "fuzzy definition query",
|
||||
suggestions =
|
||||
bothCompletors
|
||||
(termCompletor fuzzyComplete)
|
||||
(typeCompletor fuzzyComplete),
|
||||
suggestions = prefixCompleteTermOrType,
|
||||
globTargets = Set.fromList [Globbing.Term, Globbing.Type]
|
||||
}
|
||||
|
||||
definitionQueryArg :: ArgumentType
|
||||
definitionQueryArg = fuzzyDefinitionQueryArg {typeName = "definition query"}
|
||||
definitionQueryArg = exactDefinitionArg {typeName = "definition query"}
|
||||
|
||||
exactDefinitionTypeQueryArg :: ArgumentType
|
||||
exactDefinitionTypeQueryArg =
|
||||
ArgumentType
|
||||
{ typeName = "type definition query",
|
||||
suggestions = typeCompletor exactComplete,
|
||||
suggestions = prefixCompleteType,
|
||||
globTargets = Set.fromList [Globbing.Type]
|
||||
}
|
||||
|
||||
@ -2346,123 +2356,44 @@ exactDefinitionTermQueryArg :: ArgumentType
|
||||
exactDefinitionTermQueryArg =
|
||||
ArgumentType
|
||||
{ typeName = "term definition query",
|
||||
suggestions = termCompletor exactComplete,
|
||||
suggestions = prefixCompleteTerm,
|
||||
globTargets = Set.fromList [Globbing.Term]
|
||||
}
|
||||
|
||||
typeCompletor ::
|
||||
Applicative m =>
|
||||
(String -> [String] -> [Completion]) ->
|
||||
String ->
|
||||
Codebase m v a ->
|
||||
Branch.Branch m ->
|
||||
Path.Absolute ->
|
||||
m [Completion]
|
||||
typeCompletor filterQuery = pathCompletor filterQuery go
|
||||
where
|
||||
go = Set.map HQ.toText . R.dom . Names.hashQualifyTypesRelation . Names.types . Branch.toNames
|
||||
|
||||
termCompletor ::
|
||||
Applicative m =>
|
||||
(String -> [String] -> [Completion]) ->
|
||||
String ->
|
||||
Codebase m v a ->
|
||||
Branch.Branch m ->
|
||||
Path.Absolute ->
|
||||
m [Completion]
|
||||
termCompletor filterQuery = pathCompletor filterQuery go
|
||||
where
|
||||
go = Set.map HQ.toText . R.dom . Names.hashQualifyTermsRelation . Names.terms . Branch.toNames
|
||||
|
||||
patchArg :: ArgumentType
|
||||
patchArg =
|
||||
ArgumentType
|
||||
{ typeName = "patch",
|
||||
suggestions =
|
||||
pathCompletor
|
||||
exactComplete
|
||||
(Set.map Name.toText . Map.keysSet . Branch.deepEdits),
|
||||
suggestions = prefixCompletePatch,
|
||||
globTargets = Set.fromList []
|
||||
}
|
||||
|
||||
allCompletors ::
|
||||
Monad m =>
|
||||
( [String -> Codebase m v a -> Branch.Branch m -> Path.Absolute -> m [Completion]] ->
|
||||
(String -> Codebase m v a -> Branch.Branch m -> Path.Absolute -> m [Completion])
|
||||
)
|
||||
allCompletors = foldl' bothCompletors I.noSuggestions
|
||||
|
||||
bothCompletors ::
|
||||
(Monad m) =>
|
||||
(String -> t2 -> t3 -> t4 -> m [Completion]) ->
|
||||
(String -> t2 -> t3 -> t4 -> m [Completion]) ->
|
||||
String ->
|
||||
t2 ->
|
||||
t3 ->
|
||||
t4 ->
|
||||
m [Completion]
|
||||
bothCompletors c1 c2 q code b currentPath = do
|
||||
suggestions1 <- c1 q code b currentPath
|
||||
suggestions2 <- c2 q code b currentPath
|
||||
pure . fixupCompletion q
|
||||
. nubOrdOn Completion.display
|
||||
$ suggestions1 ++ suggestions2
|
||||
|
||||
-- | A completer for namespace paths.
|
||||
pathCompletor ::
|
||||
Applicative f =>
|
||||
-- | Turns a query and list of possible completions into a 'Completion'.
|
||||
(String -> [String] -> [Completion]) ->
|
||||
-- | Construct completions given ucm's current branch context, or the root namespace if
|
||||
-- the query is absolute.
|
||||
(Branch.Branch0 m -> Set Text) ->
|
||||
-- | The portion of this arg that the user has already typed.
|
||||
String ->
|
||||
codebase ->
|
||||
Branch.Branch m ->
|
||||
Path.Absolute ->
|
||||
f [Completion]
|
||||
pathCompletor filterQuery getNames query _code b p =
|
||||
let b0root = Branch.head b
|
||||
b0local = Branch.getAt0 (Path.unabsolute p) b0root
|
||||
in -- todo: if these sets are huge, maybe trim results
|
||||
pure . filterQuery query . map Text.unpack $
|
||||
toList (getNames b0local)
|
||||
++ if "." `isPrefixOf` query
|
||||
then map ("." <>) (toList (getNames b0root))
|
||||
else []
|
||||
|
||||
namespaceArg :: ArgumentType
|
||||
namespaceArg =
|
||||
ArgumentType
|
||||
{ typeName = "namespace",
|
||||
suggestions = pathCompletor completeWithinQueryNamespace (Set.fromList . allSubNamespaces),
|
||||
suggestions = prefixCompleteNamespace,
|
||||
globTargets = Set.fromList [Globbing.Namespace]
|
||||
}
|
||||
|
||||
-- | Recursively collects all names of namespaces which are children of the branch.
|
||||
allSubNamespaces :: Branch.Branch0 m -> [Text]
|
||||
allSubNamespaces b =
|
||||
flip Map.foldMapWithKey (Branch.nonEmptyChildren b) $
|
||||
\(NameSegment k) (Branch.head -> b') ->
|
||||
(k : fmap (\sn -> k <> "." <> sn) (allSubNamespaces b'))
|
||||
-- | 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)
|
||||
|
||||
newNameArg :: ArgumentType
|
||||
newNameArg =
|
||||
ArgumentType
|
||||
{ typeName = "new-name",
|
||||
suggestions =
|
||||
pathCompletor
|
||||
prefixIncomplete
|
||||
(Set.map ((<> ".") . Path.toText) . Branch.deepPaths),
|
||||
prefixCompleteNamespace,
|
||||
globTargets = mempty
|
||||
}
|
||||
|
||||
noCompletions :: ArgumentType
|
||||
noCompletions =
|
||||
noCompletionsArg :: ArgumentType
|
||||
noCompletionsArg =
|
||||
ArgumentType
|
||||
{ typeName = "word",
|
||||
suggestions = I.noSuggestions,
|
||||
suggestions = noCompletions,
|
||||
globTargets = mempty
|
||||
}
|
||||
|
||||
@ -2473,7 +2404,7 @@ gitUrlArg =
|
||||
{ typeName = "git-url",
|
||||
suggestions =
|
||||
let complete s = pure [Completion s s False]
|
||||
in \input _ _ _ -> case input of
|
||||
in \input _ _ -> case input of
|
||||
"gh" -> complete "git(https://github.com/"
|
||||
"gl" -> complete "git(https://gitlab.com/"
|
||||
"bb" -> complete "git(https://bitbucket.com/"
|
||||
@ -2491,7 +2422,7 @@ remoteNamespaceArg =
|
||||
{ typeName = "remote-namespace",
|
||||
suggestions =
|
||||
let complete s = pure [Completion s s False]
|
||||
in \input _ _ _ -> case input of
|
||||
in \input _ _ -> case input of
|
||||
"gh" -> complete "git(https://github.com/"
|
||||
"gl" -> complete "git(https://gitlab.com/"
|
||||
"bb" -> complete "git(https://bitbucket.com/"
|
||||
|
||||
@ -12,7 +12,6 @@ import Control.Monad.Catch (MonadMask)
|
||||
import qualified Crypto.Random as Random
|
||||
import Data.Configurator.Types (Config)
|
||||
import Data.IORef
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.Lazy.IO as Text.Lazy
|
||||
import qualified System.Console.Haskeline as Line
|
||||
@ -34,9 +33,8 @@ import Unison.Codebase.Editor.UCMVersion (UCMVersion)
|
||||
import qualified Unison.Codebase.Path as Path
|
||||
import qualified Unison.Codebase.Runtime as Runtime
|
||||
import Unison.CommandLine
|
||||
import Unison.CommandLine.InputPattern (ArgumentType (suggestions), InputPattern (aliases, patternName))
|
||||
import qualified Unison.CommandLine.InputPattern as IP
|
||||
import Unison.CommandLine.InputPatterns (validInputs)
|
||||
import Unison.CommandLine.Completion (haskelineTabComplete)
|
||||
import qualified Unison.CommandLine.InputPatterns as IP
|
||||
import Unison.CommandLine.OutputMessages (notifyNumbered, notifyUser)
|
||||
import qualified Unison.CommandLine.Welcome as Welcome
|
||||
import Unison.Parser.Ann (Ann)
|
||||
@ -52,13 +50,12 @@ import qualified UnliftIO
|
||||
getUserInput ::
|
||||
forall m v a.
|
||||
(MonadIO m, MonadMask m) =>
|
||||
Map String InputPattern ->
|
||||
Codebase m v a ->
|
||||
Branch m ->
|
||||
Path.Absolute ->
|
||||
[String] ->
|
||||
m Input
|
||||
getUserInput patterns codebase rootBranch currentPath numberedArgs =
|
||||
getUserInput codebase rootBranch currentPath numberedArgs =
|
||||
Line.runInputT
|
||||
settings
|
||||
(haskelineCtrlCHandling go)
|
||||
@ -81,25 +78,14 @@ getUserInput patterns codebase rootBranch currentPath numberedArgs =
|
||||
Just l -> case words l of
|
||||
[] -> go
|
||||
ws ->
|
||||
case parseInput (Branch.head rootBranch) currentPath numberedArgs patterns $ ws of
|
||||
case parseInput (Branch.head rootBranch) currentPath numberedArgs IP.patternMap $ ws of
|
||||
Left msg -> do
|
||||
liftIO $ putPrettyLn msg
|
||||
go
|
||||
Right i -> pure i
|
||||
settings :: Line.Settings m
|
||||
settings = Line.Settings tabComplete (Just ".unisonHistory") True
|
||||
tabComplete :: Line.CompletionFunc m
|
||||
tabComplete = Line.completeWordWithPrev Nothing " " $ \prev word ->
|
||||
-- User hasn't finished a command name, complete from command names
|
||||
if null prev
|
||||
then pure . exactComplete word $ Map.keys patterns
|
||||
else -- User has finished a command name; use completions for that command
|
||||
case words $ reverse prev of
|
||||
h : t -> fromMaybe (pure []) $ do
|
||||
p <- Map.lookup h patterns
|
||||
argType <- IP.argType p (length t)
|
||||
pure $ suggestions argType word codebase rootBranch currentPath
|
||||
_ -> pure []
|
||||
tabComplete = haskelineTabComplete IP.patternMap codebase currentPath
|
||||
|
||||
main ::
|
||||
FilePath ->
|
||||
@ -120,15 +106,9 @@ main dir welcome initialPath (config, cancelConfig) initialInputs runtime sbRunt
|
||||
initialInputsRef <- newIORef $ welcomeEvents ++ initialInputs
|
||||
pageOutput <- newIORef True
|
||||
cancelFileSystemWatch <- watchFileSystem eventQueue dir
|
||||
let patternMap :: Map String InputPattern
|
||||
patternMap =
|
||||
Map.fromList $
|
||||
validInputs
|
||||
>>= (\p -> (patternName p, p) : ((,p) <$> aliases p))
|
||||
let getInput :: Cli.LoopState -> IO Input
|
||||
getInput loopState = do
|
||||
getUserInput
|
||||
patternMap
|
||||
codebase
|
||||
(loopState ^. #root)
|
||||
(loopState ^. #currentPath)
|
||||
|
||||
@ -28,6 +28,7 @@ import qualified Network.HTTP.Types as Http
|
||||
import Network.URI (URI)
|
||||
import qualified Network.URI.Encode as URI
|
||||
import qualified Servant.Client as Servant
|
||||
import qualified System.Console.Haskeline.Completion as Completion
|
||||
import System.Directory
|
||||
( canonicalizePath,
|
||||
doesFileExist,
|
||||
@ -646,8 +647,8 @@ notifyUser dir o = case o of
|
||||
CachedTests 0 _ -> pure . P.callout "😶" $ "No tests to run."
|
||||
CachedTests n n'
|
||||
| n == n' ->
|
||||
pure $
|
||||
P.lines [cache, "", displayTestResults True ppe oks fails]
|
||||
pure $
|
||||
P.lines [cache, "", displayTestResults True ppe oks fails]
|
||||
CachedTests _n m ->
|
||||
pure $
|
||||
if m == 0
|
||||
@ -656,6 +657,7 @@ notifyUser dir o = case o of
|
||||
P.indentN 2 $
|
||||
P.lines ["", cache, "", displayTestResults False ppe oks fails, "", "✅ "]
|
||||
where
|
||||
|
||||
NewlyComputed -> do
|
||||
clearCurrentLine
|
||||
pure $
|
||||
@ -1726,6 +1728,16 @@ notifyUser dir o = case o of
|
||||
IntegrityCheck result -> pure $ case result of
|
||||
NoIntegrityErrors -> "🎉 No issues detected 🎉"
|
||||
IntegrityErrorDetected ns -> prettyPrintIntegrityErrors ns
|
||||
DisplayDebugCompletions completions ->
|
||||
pure $
|
||||
P.column2
|
||||
( completions <&> \comp ->
|
||||
let isCompleteTxt =
|
||||
if Completion.isFinished comp
|
||||
then "*"
|
||||
else ""
|
||||
in (isCompleteTxt, P.string (Completion.replacement comp))
|
||||
)
|
||||
where
|
||||
_nameChange _cmd _pastTenseCmd _oldName _newName _r = error "todo"
|
||||
expectedEmptyPushDest writeRemotePath =
|
||||
@ -2358,7 +2370,7 @@ showDiffNamespace ::
|
||||
(Pretty, NumberedArgs)
|
||||
showDiffNamespace _ _ _ _ diffOutput
|
||||
| OBD.isEmpty diffOutput =
|
||||
("The namespaces are identical.", mempty)
|
||||
("The namespaces are identical.", mempty)
|
||||
showDiffNamespace sn ppe oldPath newPath OBD.BranchDiffOutput {..} =
|
||||
(P.sepNonEmpty "\n\n" p, toList args)
|
||||
where
|
||||
|
||||
@ -5,7 +5,6 @@ import System.Environment (getArgs)
|
||||
import System.IO
|
||||
import System.IO.CodePage (withCP65001)
|
||||
import qualified Unison.Test.ClearCache as ClearCache
|
||||
import qualified Unison.Test.CommandLine as CommandLine
|
||||
import qualified Unison.Test.GitSync as GitSync
|
||||
import qualified Unison.Test.UriParser as UriParser
|
||||
import qualified Unison.Test.VersionParser as VersionParser
|
||||
@ -14,7 +13,6 @@ test :: Test ()
|
||||
test =
|
||||
tests
|
||||
[ ClearCache.test,
|
||||
CommandLine.test,
|
||||
GitSync.test,
|
||||
UriParser.test,
|
||||
VersionParser.test
|
||||
|
||||
@ -1,40 +0,0 @@
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Unison.Test.CommandLine where
|
||||
|
||||
import EasyTest
|
||||
import qualified System.Console.Haskeline as Line
|
||||
import Unison.CommandLine (completeWithinQueryNamespace)
|
||||
|
||||
data CompletionTest = CT {query :: String, expected :: [(String, Bool)], options :: [String]}
|
||||
|
||||
testCompletion :: (String -> [String] -> [Line.Completion]) -> CompletionTest -> Test ()
|
||||
testCompletion compl CT {..} =
|
||||
expectEqual expected ((\(Line.Completion {..}) -> (replacement, isFinished)) <$> compl query options)
|
||||
|
||||
test :: Test ()
|
||||
test = scope "commandline" $ do
|
||||
scope "completion" $ do
|
||||
scope "completeWithinQueryNamespace" $ do
|
||||
scope "only completes up to a single namespace boundary" $ do
|
||||
testCompletion completeWithinQueryNamespace $
|
||||
CT
|
||||
{ query = ".ba",
|
||||
expected = [(".base", False)],
|
||||
options = [".base", ".base.List", ".base.Map"]
|
||||
}
|
||||
scope "completes into the next namespace if query is a complete namespace" $ do
|
||||
testCompletion completeWithinQueryNamespace $
|
||||
CT
|
||||
{ query = ".base",
|
||||
expected = [(".base", True), (".base.List", False), (".base.Map", False)],
|
||||
options = [".base", ".base.List", ".base.Map"]
|
||||
}
|
||||
|
||||
scope "completes " $ do
|
||||
testCompletion completeWithinQueryNamespace $
|
||||
CT
|
||||
{ query = ".f",
|
||||
expected = [(".function", False), (".facade", False), (".fellows", False)],
|
||||
options = [".function", ".facade", ".fellows"]
|
||||
}
|
||||
@ -51,6 +51,7 @@ library
|
||||
Unison.Codebase.Editor.VersionParser
|
||||
Unison.Codebase.TranscriptParser
|
||||
Unison.CommandLine
|
||||
Unison.CommandLine.Completion
|
||||
Unison.CommandLine.DisplayValues
|
||||
Unison.CommandLine.FuzzySelect
|
||||
Unison.CommandLine.Globbing
|
||||
@ -496,7 +497,6 @@ test-suite cli-tests
|
||||
main-is: Main.hs
|
||||
other-modules:
|
||||
Unison.Test.ClearCache
|
||||
Unison.Test.CommandLine
|
||||
Unison.Test.GitSync
|
||||
Unison.Test.Ucm
|
||||
Unison.Test.UriParser
|
||||
|
||||
48
unison-src/transcripts/tab-completion.md
Normal file
48
unison-src/transcripts/tab-completion.md
Normal file
@ -0,0 +1,48 @@
|
||||
# Tab Completion
|
||||
|
||||
|
||||
Test that tab completion works as expected.
|
||||
|
||||
|
||||
## Tab Complete Command Names
|
||||
|
||||
```ucm
|
||||
.> debug.tab-complete vi
|
||||
.> debug.tab-complete delete.
|
||||
```
|
||||
|
||||
## Tab complete terms & types
|
||||
|
||||
```unison
|
||||
subnamespace.someName = 1
|
||||
subnamespace.someOtherName = 2
|
||||
othernamespace.someName = 3
|
||||
|
||||
unique type subnamespace.AType = A | B
|
||||
```
|
||||
|
||||
```ucm:hide
|
||||
.> add
|
||||
```
|
||||
|
||||
```ucm
|
||||
-- Should tab complete namespaces since they may contain terms/types
|
||||
.> debug.tab-complete view sub
|
||||
-- Should complete things from child namespaces of the current query
|
||||
.> debug.tab-complete view subnamespace
|
||||
.> debug.tab-complete view subnamespace.
|
||||
-- Should prefix-filter by query suffix
|
||||
.> debug.tab-complete view subnamespace.some
|
||||
.> debug.tab-complete view subnamespace.someOther
|
||||
-- Should tab complete absolute names
|
||||
.othernamespace> debug.tab-complete view .subnamespace.some
|
||||
```
|
||||
|
||||
## Tab complete namespaces
|
||||
|
||||
```ucm
|
||||
-- Should tab complete namespaces
|
||||
.> debug.tab-complete cd sub
|
||||
.> debug.tab-complete cd subnamespace
|
||||
.> debug.tab-complete cd subnamespace.
|
||||
```
|
||||
107
unison-src/transcripts/tab-completion.output.md
Normal file
107
unison-src/transcripts/tab-completion.output.md
Normal file
@ -0,0 +1,107 @@
|
||||
# Tab Completion
|
||||
|
||||
|
||||
Test that tab completion works as expected.
|
||||
|
||||
|
||||
## Tab Complete Command Names
|
||||
|
||||
```ucm
|
||||
.> debug.tab-complete vi
|
||||
|
||||
view
|
||||
view.patch
|
||||
|
||||
.> debug.tab-complete delete.
|
||||
|
||||
delete.link
|
||||
delete.namespace
|
||||
delete.namespace.force
|
||||
delete.patch
|
||||
delete.term
|
||||
delete.term-replacement
|
||||
delete.type
|
||||
delete.type-replacement
|
||||
|
||||
```
|
||||
## Tab complete terms & types
|
||||
|
||||
```unison
|
||||
subnamespace.someName = 1
|
||||
subnamespace.someOtherName = 2
|
||||
othernamespace.someName = 3
|
||||
|
||||
unique type subnamespace.AType = A | B
|
||||
```
|
||||
|
||||
```ucm
|
||||
|
||||
I found and typechecked these definitions in scratch.u. If you
|
||||
do an `add` or `update`, here's how your codebase would
|
||||
change:
|
||||
|
||||
⍟ These new definitions are ok to `add`:
|
||||
|
||||
unique type subnamespace.AType
|
||||
othernamespace.someName : ##Nat
|
||||
subnamespace.someName : ##Nat
|
||||
subnamespace.someOtherName : ##Nat
|
||||
|
||||
```
|
||||
```ucm
|
||||
-- Should tab complete namespaces since they may contain terms/types
|
||||
.> debug.tab-complete view sub
|
||||
|
||||
subnamespace.
|
||||
|
||||
-- Should complete things from child namespaces of the current query
|
||||
.> debug.tab-complete view subnamespace
|
||||
|
||||
subnamespace.
|
||||
* subnamespace.AType
|
||||
subnamespace.AType.
|
||||
* subnamespace.someName
|
||||
* subnamespace.someOtherName
|
||||
|
||||
.> debug.tab-complete view subnamespace.
|
||||
|
||||
* subnamespace.AType
|
||||
subnamespace.AType.
|
||||
* subnamespace.someName
|
||||
* subnamespace.someOtherName
|
||||
|
||||
-- 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
|
||||
|
||||
```ucm
|
||||
-- Should tab complete namespaces
|
||||
.> debug.tab-complete cd sub
|
||||
|
||||
subnamespace
|
||||
|
||||
.> debug.tab-complete cd subnamespace
|
||||
|
||||
subnamespace
|
||||
subnamespace.AType
|
||||
|
||||
.> debug.tab-complete cd subnamespace.
|
||||
|
||||
subnamespace.AType
|
||||
|
||||
```
|
||||
Loading…
Reference in New Issue
Block a user