From ea3c35a8d5374ea48bad73dc6ad0c3c8a8f05cef Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Tue, 11 Feb 2020 22:40:44 -0500 Subject: [PATCH] getting started with `alias.many` --- .../src/Unison/Codebase/Editor/HandleInput.hs | 17 +++++++++++++ .../src/Unison/Codebase/Editor/Input.hs | 1 + .../src/Unison/Codebase/Path.hs | 9 ++++++- .../src/Unison/CommandLine/InputPatterns.hs | 24 +++++++++++++++++++ 4 files changed, 50 insertions(+), 1 deletion(-) diff --git a/parser-typechecker/src/Unison/Codebase/Editor/HandleInput.hs b/parser-typechecker/src/Unison/Codebase/Editor/HandleInput.hs index 80ba560ba..130bc3c0f 100644 --- a/parser-typechecker/src/Unison/Codebase/Editor/HandleInput.hs +++ b/parser-typechecker/src/Unison/Codebase/Editor/HandleInput.hs @@ -125,6 +125,7 @@ import Data.Tuple.Extra (uncurry3) import qualified Unison.CommandLine.DisplayValues as DisplayValues import qualified Control.Error.Util as ErrorUtil import Unison.Codebase.GitError (GitError) +import Unison.Util.Monoid (intercalateMap) type F m i v = Free (Command m i v) type Term v a = Term.AnnotatedTerm v a @@ -293,6 +294,8 @@ loop = do ResetRootI src -> "reset-root " <> hp' src AliasTermI src dest -> "alias.term " <> 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 MoveTypeI src dest -> "move.type " <> hqs' 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" hqs' (p, 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' stepAt = Unison.Codebase.Editor.HandleInput.stepAt inputDescription stepManyAt = Unison.Codebase.Editor.HandleInput.stepManyAt inputDescription @@ -735,6 +739,19 @@ loop = do p = resolveSplit' src 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 parseNames0 <- Names3.suffixify0 <$> basicParseNames0 let filtered = case thing of diff --git a/parser-typechecker/src/Unison/Codebase/Editor/Input.hs b/parser-typechecker/src/Unison/Codebase/Editor/Input.hs index 5ddabe1d9..765ede4ff 100644 --- a/parser-typechecker/src/Unison/Codebase/Editor/Input.hs +++ b/parser-typechecker/src/Unison/Codebase/Editor/Input.hs @@ -62,6 +62,7 @@ data Input | NamesI HQ.HashQualified | AliasTermI 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. | MoveTermI Path.HQSplit' Path.Split' | MoveTypeI Path.HQSplit' Path.Split' diff --git a/parser-typechecker/src/Unison/Codebase/Path.hs b/parser-typechecker/src/Unison/Codebase/Path.hs index 7b8a0e8e0..d67a558b8 100644 --- a/parser-typechecker/src/Unison/Codebase/Path.hs +++ b/parser-typechecker/src/Unison/Codebase/Path.hs @@ -184,11 +184,18 @@ parseShortHashOrHQSplit' s = where 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' s = case Text.breakOn "#" $ Text.pack s of ("","") -> 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 (p, rem) <- parsePath'Impl (Text.unpack n) seg <- definitionNameSegment rem diff --git a/parser-typechecker/src/Unison/CommandLine/InputPatterns.hs b/parser-typechecker/src/Unison/CommandLine/InputPatterns.hs index 4e6e2ba45..23663037d 100644 --- a/parser-typechecker/src/Unison/CommandLine/InputPatterns.hs +++ b/parser-typechecker/src/Unison/CommandLine/InputPatterns.hs @@ -8,6 +8,7 @@ module Unison.CommandLine.InputPatterns where import Unison.Prelude +import qualified Control.Lens.Cons as Cons import Data.Bifunctor (first) import Data.List (intercalate, sortOn, isPrefixOf) import Data.List.Extra (nubOrdOn) @@ -439,6 +440,20 @@ aliasType = InputPattern "alias.type" [] "`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 "namespace" ["cd", "j"] [(Required, pathArg)] (P.wrapColumn2 @@ -1175,6 +1190,15 @@ fuzzyDefinitionQueryArg = bothCompletors (termCompletor 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? exactDefinitionQueryArg :: ArgumentType exactDefinitionQueryArg =