mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-24 00:39:58 +03:00
getting started with alias.many
This commit is contained in:
parent
dc26ff0e07
commit
ea3c35a8d5
@ -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
|
||||||
|
@ -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'
|
||||||
|
@ -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
|
||||||
|
@ -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 =
|
||||||
|
Loading…
Reference in New Issue
Block a user