getting started with alias.many

This commit is contained in:
Arya Irani 2020-02-11 22:40:44 -05:00
parent dc26ff0e07
commit ea3c35a8d5
4 changed files with 50 additions and 1 deletions

View File

@ -125,6 +125,7 @@ import Data.Tuple.Extra (uncurry3)
import qualified Unison.CommandLine.DisplayValues as DisplayValues import qualified Unison.CommandLine.DisplayValues as DisplayValues
import qualified Control.Error.Util as ErrorUtil import qualified Control.Error.Util as ErrorUtil
import Unison.Codebase.GitError (GitError) import Unison.Codebase.GitError (GitError)
import Unison.Util.Monoid (intercalateMap)
type F m i v = Free (Command m i v) type F m i v = Free (Command m i v)
type Term v a = Term.AnnotatedTerm v a type Term v a = Term.AnnotatedTerm v a
@ -293,6 +294,8 @@ loop = do
ResetRootI src -> "reset-root " <> hp' src ResetRootI src -> "reset-root " <> hp' src
AliasTermI src dest -> "alias.term " <> hqs' src <> " " <> ps' dest AliasTermI src dest -> "alias.term " <> hqs' src <> " " <> ps' dest
AliasTypeI src dest -> "alias.type" <> hqs' src <> " " <> ps' dest AliasTypeI src dest -> "alias.type" <> hqs' src <> " " <> ps' dest
AliasManyI srcs dest ->
"alias.many " <> intercalateMap " " hqs srcs <> " " <> p' dest
MoveTermI src dest -> "move.term " <> hqs' src <> " " <> ps' dest MoveTermI src dest -> "move.term " <> hqs' src <> " " <> ps' dest
MoveTypeI src dest -> "move.type " <> hqs' src <> " " <> ps' dest MoveTypeI src dest -> "move.type " <> hqs' src <> " " <> ps' dest
MoveBranchI src dest -> "move.namespace " <> ops' src <> " " <> ps' dest MoveBranchI src dest -> "move.namespace " <> ops' src <> " " <> ps' dest
@ -376,6 +379,7 @@ loop = do
wat = error $ show input ++ " is not expected to alter the branch" wat = error $ show input ++ " is not expected to alter the branch"
hqs' (p, hq) = hqs' (p, hq) =
Monoid.unlessM (Path.isRoot' p) (p' p) <> "." <> Text.pack (show hq) Monoid.unlessM (Path.isRoot' p) (p' p) <> "." <> Text.pack (show hq)
hqs (p, hq) = hqs' (Path' . Right . Path.Relative $ p, hq)
ps' = p' . Path.unsplit' ps' = p' . Path.unsplit'
stepAt = Unison.Codebase.Editor.HandleInput.stepAt inputDescription stepAt = Unison.Codebase.Editor.HandleInput.stepAt inputDescription
stepManyAt = Unison.Codebase.Editor.HandleInput.stepManyAt inputDescription stepManyAt = Unison.Codebase.Editor.HandleInput.stepManyAt inputDescription
@ -735,6 +739,19 @@ loop = do
p = resolveSplit' src p = resolveSplit' src
oldMD r = BranchUtil.getTypeMetadataAt p r root0 oldMD r = BranchUtil.getTypeMetadataAt p r root0
AliasManyI srcs dest' -> do
(unknown, actions) <- foldM go mempty srcs
if null unknown then stepManyAt actions
else respond . SearchTermsNotFound . fmap fixupOutput $ unknown
where
go :: ([Path.HQSplit], [(Path, Branch0 m -> Branch0 m)])
-> Path.HQSplit
-> Action' m v ([Path.HQSplit], [(Path, Branch0 m -> Branch0 m)])
go = error "todo" dest'
fixupOutput :: Path.HQSplit -> HQ.HashQualified
fixupOutput = error "todo"
NamesI thing -> do NamesI thing -> do
parseNames0 <- Names3.suffixify0 <$> basicParseNames0 parseNames0 <- Names3.suffixify0 <$> basicParseNames0
let filtered = case thing of let filtered = case thing of

View File

@ -62,6 +62,7 @@ data Input
| NamesI HQ.HashQualified | NamesI HQ.HashQualified
| AliasTermI Path.HQSplit' Path.Split' | AliasTermI Path.HQSplit' Path.Split'
| AliasTypeI Path.HQSplit' Path.Split' | AliasTypeI Path.HQSplit' Path.Split'
| AliasManyI [Path.HQSplit] Path'
-- Move = Rename; It's an HQSplit' not an HQSplit', meaning the arg has to have a name. -- Move = Rename; It's an HQSplit' not an HQSplit', meaning the arg has to have a name.
| MoveTermI Path.HQSplit' Path.Split' | MoveTermI Path.HQSplit' Path.Split'
| MoveTypeI Path.HQSplit' Path.Split' | MoveTypeI Path.HQSplit' Path.Split'

View File

@ -184,11 +184,18 @@ parseShortHashOrHQSplit' s =
where where
shError s = "couldn't parse shorthash from " <> s shError s = "couldn't parse shorthash from " <> s
parseHQSplit :: String -> Either String HQSplit
parseHQSplit s = case parseHQSplit' s of
Right (Path' (Right (Relative p)), hqseg) -> Right (p, hqseg)
Right (Path' Left{}, _) ->
Left $ "Sorry, you can't use an absolute name like " <> s <> " here."
Left e -> Left e
parseHQSplit' :: String -> Either String HQSplit' parseHQSplit' :: String -> Either String HQSplit'
parseHQSplit' s = parseHQSplit' s =
case Text.breakOn "#" $ Text.pack s of case Text.breakOn "#" $ Text.pack s of
("","") -> error $ "encountered empty string parsing '" <> s <> "'" ("","") -> error $ "encountered empty string parsing '" <> s <> "'"
("", _) -> Left "HQSplit' doesn't have a hash-only option." ("", _) -> Left "Sorry, you can't use a hash-only reference here."
(n, "") -> do (n, "") -> do
(p, rem) <- parsePath'Impl (Text.unpack n) (p, rem) <- parsePath'Impl (Text.unpack n)
seg <- definitionNameSegment rem seg <- definitionNameSegment rem

View File

@ -8,6 +8,7 @@ module Unison.CommandLine.InputPatterns where
import Unison.Prelude import Unison.Prelude
import qualified Control.Lens.Cons as Cons
import Data.Bifunctor (first) import Data.Bifunctor (first)
import Data.List (intercalate, sortOn, isPrefixOf) import Data.List (intercalate, sortOn, isPrefixOf)
import Data.List.Extra (nubOrdOn) import Data.List.Extra (nubOrdOn)
@ -439,6 +440,20 @@ aliasType = InputPattern "alias.type" []
"`alias.type` takes two arguments, like `alias.type oldname newname`." "`alias.type` takes two arguments, like `alias.type oldname newname`."
) )
aliasMany :: InputPattern
aliasMany = InputPattern "alias.many" ["copy"]
[(Required, exactDefinitionQueryArg), (OnePlus, exactDefinitionOrPathArg)]
(P.group (makeExample aliasMany ["foo.foo", "bar.bar", "quux"])
<> "creates aliases `quux.foo.foo` and `quux.bar.bar`.")
(\case
srcs@(_:_) Cons.:> dest -> first fromString $ do
sourceDefinitions <- traverse Path.parseHQSplit srcs
destNamespace <- Path.parsePath' dest
pure $ Input.AliasManyI sourceDefinitions destNamespace
_ -> Left (I.help aliasMany)
)
cd :: InputPattern cd :: InputPattern
cd = InputPattern "namespace" ["cd", "j"] [(Required, pathArg)] cd = InputPattern "namespace" ["cd", "j"] [(Required, pathArg)]
(P.wrapColumn2 (P.wrapColumn2
@ -1175,6 +1190,15 @@ fuzzyDefinitionQueryArg =
bothCompletors (termCompletor fuzzyComplete) bothCompletors (termCompletor fuzzyComplete)
(typeCompletor fuzzyComplete) (typeCompletor fuzzyComplete)
exactDefinitionOrPathArg :: ArgumentType
exactDefinitionOrPathArg =
ArgumentType "definition or path" $
bothCompletors
(bothCompletors
(termCompletor exactComplete)
(typeCompletor exactComplete))
(pathCompletor exactComplete (Set.map Path.toText . Branch.deepPaths))
-- todo: support absolute paths? -- todo: support absolute paths?
exactDefinitionQueryArg :: ArgumentType exactDefinitionQueryArg :: ArgumentType
exactDefinitionQueryArg = exactDefinitionQueryArg =