mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-23 08:18:04 +03:00
Merge remote-tracking branch 'origin/master' into fix/view-suffixified
# Conflicts: # parser-typechecker/src/Unison/Codebase/Editor/HandleInput.hs # parser-typechecker/src/Unison/CommandLine/InputPatterns.hs
This commit is contained in:
Paul Chiusano
commit
6c0dc0d188
@ -212,21 +212,14 @@ loop = do
|
||||
getHQ'TermsIncludingHistorical p =
|
||||
getTermsIncludingHistorical (resolveSplit' p) root0
|
||||
|
||||
getHQ'TermReferences :: Path.HQSplit' -> Set Reference
|
||||
getHQ'TermReferences p =
|
||||
Set.fromList [ r | Referent.Ref r <- toList (getHQ'Terms p) ]
|
||||
getHQ'Terms :: Path.HQSplit' -> Set Referent
|
||||
getHQ'Terms p = BranchUtil.getTerm (resolveSplit' p) root0
|
||||
getHQ'Types :: Path.HQSplit' -> Set Reference
|
||||
getHQ'Types p = BranchUtil.getType (resolveSplit' p) root0
|
||||
resolveHHQS'Types :: HashOrHQSplit' -> Action' m v (Set Reference)
|
||||
resolveHHQS'Types = either
|
||||
resolveHHQS'Types = either
|
||||
(eval . TypeReferencesByShortHash)
|
||||
(pure . getHQ'Types)
|
||||
-- Term Refs only
|
||||
resolveHHQS'Terms = either
|
||||
(eval . TermReferencesByShortHash)
|
||||
(pure . getHQ'TermReferences)
|
||||
-- Term Refs and Cons
|
||||
resolveHHQS'Referents = either
|
||||
(eval . TermReferentsByShortHash)
|
||||
@ -309,6 +302,53 @@ loop = do
|
||||
typeConflicted src = nameConflicted src Set.empty
|
||||
termConflicted src tms = nameConflicted src tms Set.empty
|
||||
hashConflicted src = respond . HashAmbiguous src
|
||||
hqNameQuery' doSuffixify hqs = do
|
||||
parseNames0 <- makeHistoricalParsingNames $ Set.fromList hqs
|
||||
let parseNames = (if doSuffixify then Names3.suffixify else id) parseNames0
|
||||
let resultss = searchBranchExact hqLength parseNames hqs
|
||||
(misses, hits) =
|
||||
partition (\(_, results) -> null results) (zip hqs resultss)
|
||||
results = List.sort . uniqueBy SR.toReferent $ hits >>= snd
|
||||
pure (misses, results)
|
||||
hqNameQuery = hqNameQuery' False
|
||||
hqNameQuerySuffixify = hqNameQuery' True
|
||||
typeReferences :: [SearchResult] -> [Reference]
|
||||
typeReferences rs
|
||||
= [ r | SR.Tp (SR.TypeResult _ r _) <- rs ]
|
||||
termReferences :: [SearchResult] -> [Reference]
|
||||
termReferences rs =
|
||||
[ r | SR.Tm (SR.TermResult _ (Referent.Ref r) _) <- rs ]
|
||||
termResults rs = [ r | SR.Tm r <- rs ]
|
||||
typeResults rs = [ r | SR.Tp r <- rs ]
|
||||
doRemoveReplacement from patchPath isTerm = do
|
||||
let patchPath' = fromMaybe defaultPatchPath patchPath
|
||||
patch <- getPatchAt patchPath'
|
||||
(misses', hits) <- hqNameQuery [from]
|
||||
let tpRefs = Set.fromList $ typeReferences hits
|
||||
tmRefs = Set.fromList $ termReferences hits
|
||||
tmMisses = (fst <$> misses')
|
||||
<> (HQ'.toHQ . SR.termName <$> termResults hits)
|
||||
tpMisses = (fst <$> misses')
|
||||
<> (HQ'.toHQ . SR.typeName <$> typeResults hits)
|
||||
misses = if isTerm then tpMisses else tmMisses
|
||||
go :: Reference -> Action m (Either Event Input) v ()
|
||||
go fr = do
|
||||
let termPatch =
|
||||
over Patch.termEdits (R.deleteDom fr) patch
|
||||
typePatch =
|
||||
over Patch.typeEdits (R.deleteDom fr) patch
|
||||
(patchPath'', patchName) = resolveSplit' patchPath'
|
||||
-- Save the modified patch
|
||||
stepAtM inputDescription
|
||||
(patchPath'',
|
||||
Branch.modifyPatches
|
||||
patchName
|
||||
(const (if isTerm then termPatch else typePatch)))
|
||||
-- Say something
|
||||
success
|
||||
when (not $ null misses) $
|
||||
respond $ SearchTermsNotFound misses
|
||||
traverse_ go (if isTerm then tmRefs else tpRefs)
|
||||
branchExists dest _x = respond $ BranchAlreadyExists dest
|
||||
branchExistsSplit = branchExists . Path.unsplit'
|
||||
typeExists dest = respond . TypeAlreadyExists dest
|
||||
@ -333,13 +373,13 @@ loop = do
|
||||
DeleteTypeI def -> "delete.type " <> hqs' def
|
||||
DeleteBranchI opath -> "delete.namespace " <> ops' opath
|
||||
DeletePatchI path -> "delete.patch " <> ps' path
|
||||
ReplaceTermI srcH targetH p ->
|
||||
"replace.term " <> hhqs' srcH <> " "
|
||||
<> hhqs' targetH <> " "
|
||||
ReplaceTermI src target p ->
|
||||
"replace.term " <> HQ.toText src <> " "
|
||||
<> HQ.toText target <> " "
|
||||
<> opatch p
|
||||
ReplaceTypeI srcH targetH p ->
|
||||
"replace.type " <> hhqs' srcH <> " "
|
||||
<> hhqs' targetH <> " "
|
||||
ReplaceTypeI src target p ->
|
||||
"replace.type " <> HQ.toText src <> " "
|
||||
<> HQ.toText target <> " "
|
||||
<> opatch p
|
||||
ResolveTermNameI path -> "resolve.termName " <> hqs' path
|
||||
ResolveTypeNameI path -> "resolve.typeName " <> hqs' path
|
||||
@ -395,10 +435,10 @@ loop = do
|
||||
QuitI{} -> wat
|
||||
DeprecateTermI{} -> undefined
|
||||
DeprecateTypeI{} -> undefined
|
||||
AddTermReplacementI{} -> undefined
|
||||
AddTypeReplacementI{} -> undefined
|
||||
RemoveTermReplacementI{} -> undefined
|
||||
RemoveTypeReplacementI{} -> undefined
|
||||
RemoveTermReplacementI src p ->
|
||||
"delete.term-replacement" <> HQ.toText src <> " " <> opatch p
|
||||
RemoveTypeReplacementI src p ->
|
||||
"delete.type-replacement" <> HQ.toText src <> " " <> opatch p
|
||||
where
|
||||
hp' = either (Text.pack . show) p'
|
||||
p' = Text.pack . show . resolveToAbsolute
|
||||
@ -944,10 +984,10 @@ loop = do
|
||||
DeleteTypeI hq -> delete (const Set.empty) getHQ'Types hq
|
||||
DeleteTermI hq -> delete getHQ'Terms (const Set.empty) hq
|
||||
|
||||
DisplayI outputLoc (HQ.unsafeFromString -> hq) -> do
|
||||
DisplayI outputLoc hq -> do
|
||||
parseNames0 <- (`Names3.Names` mempty) <$> basicPrettyPrintNames0
|
||||
let parseNames = Names3.suffixify parseNames0
|
||||
-- use suffixed names for resolving the argument to display
|
||||
let parseNames = Names3.suffixify parseNames0
|
||||
let results = Names3.lookupHQTerm hq parseNames
|
||||
if Set.null results then
|
||||
respond $ SearchTermsNotFound [hq]
|
||||
@ -956,12 +996,8 @@ loop = do
|
||||
-- ... but use the unsuffixed names for display
|
||||
else doDisplay outputLoc parseNames0 (Set.findMin results)
|
||||
|
||||
ShowDefinitionI outputLoc (fmap HQ.unsafeFromString -> hqs) -> do
|
||||
parseNames0 <- makeHistoricalParsingNames $ Set.fromList hqs
|
||||
let parseNames = Names3.suffixify parseNames0
|
||||
let resultss = searchBranchExact hqLength parseNames hqs
|
||||
(misses, hits) = partition (\(_, results) -> null results) (zip hqs resultss)
|
||||
results = List.sort . uniqueBy SR.toReferent $ hits >>= snd
|
||||
ShowDefinitionI outputLoc query -> do
|
||||
(misses, results) <- hqNameQuerySuffixify query
|
||||
results' <- loadSearchResults results
|
||||
let termTypes :: Map.Map Reference (Type v Ann)
|
||||
termTypes =
|
||||
@ -1147,9 +1183,16 @@ loop = do
|
||||
ReplaceTermI from to patchPath -> do
|
||||
let patchPath' = fromMaybe defaultPatchPath patchPath
|
||||
patch <- getPatchAt patchPath'
|
||||
fromRefs <- resolveHHQS'Terms from
|
||||
toRefs <- resolveHHQS'Terms to
|
||||
let go :: Reference
|
||||
(fromMisses', fromHits) <- hqNameQuery [from]
|
||||
(toMisses', toHits) <- hqNameQuery [to]
|
||||
let fromRefs = termReferences fromHits
|
||||
toRefs = termReferences toHits
|
||||
-- Type hits are term misses
|
||||
fromMisses = (fst <$> fromMisses')
|
||||
<> (HQ'.toHQ . SR.typeName <$> typeResults fromHits)
|
||||
toMisses = (fst <$> toMisses')
|
||||
<> (HQ'.toHQ . SR.typeName <$> typeResults fromHits)
|
||||
go :: Reference
|
||||
-> Reference
|
||||
-> Action m (Either Event Input) v ()
|
||||
go fr tr = do
|
||||
@ -1179,29 +1222,34 @@ loop = do
|
||||
void $ propagatePatch inputDescription patch' currentPath'
|
||||
-- Say something
|
||||
success
|
||||
sayNotFound = respond
|
||||
. SearchTermsNotFound
|
||||
. pure
|
||||
. either
|
||||
HQ.HashOnly
|
||||
(fmap Path.toName' . HQ'.toHQ . Path.unsplitHQ')
|
||||
sayHashConflicted t = hashConflicted t . Set.map Referent.Ref
|
||||
sayTermConflicted t = termConflicted t . Set.map Referent.Ref
|
||||
zeroOneOrMore
|
||||
fromRefs
|
||||
(sayNotFound from)
|
||||
(\r -> zeroOneOrMore toRefs
|
||||
(sayNotFound to)
|
||||
(go r)
|
||||
(either sayHashConflicted sayTermConflicted to))
|
||||
(either sayHashConflicted sayTermConflicted from)
|
||||
|
||||
misses = fromMisses <> toMisses
|
||||
ambiguous t rs =
|
||||
let rs' = Set.map Referent.Ref $ Set.fromList rs
|
||||
in case t of
|
||||
HQ.HashOnly h ->
|
||||
hashConflicted h rs'
|
||||
(Path.parseHQSplit' . HQ.toString -> Right n) ->
|
||||
termConflicted n rs'
|
||||
_ -> respond . BadName $ HQ.toString t
|
||||
when (not $ null misses) $
|
||||
respond $ SearchTermsNotFound misses
|
||||
case (fromRefs, toRefs) of
|
||||
([fr], [tr]) -> go fr tr
|
||||
([_], tos) -> ambiguous to tos
|
||||
(frs, _) -> ambiguous from frs
|
||||
ReplaceTypeI from to patchPath -> do
|
||||
let patchPath' = fromMaybe defaultPatchPath patchPath
|
||||
(fromMisses', fromHits) <- hqNameQuery [from]
|
||||
(toMisses', toHits) <- hqNameQuery [to]
|
||||
patch <- getPatchAt patchPath'
|
||||
fromRefs <- resolveHHQS'Types from
|
||||
toRefs <- resolveHHQS'Types to
|
||||
let go :: Reference
|
||||
let fromRefs = typeReferences fromHits
|
||||
toRefs = typeReferences toHits
|
||||
-- Term hits are type misses
|
||||
fromMisses = (fst <$> fromMisses')
|
||||
<> (HQ'.toHQ . SR.termName <$> termResults fromHits)
|
||||
toMisses = (fst <$> toMisses')
|
||||
<> (HQ'.toHQ . SR.termName <$> termResults fromHits)
|
||||
go :: Reference
|
||||
-> Reference
|
||||
-> Action m (Either Event Input) v ()
|
||||
go fr tr = do
|
||||
@ -1218,22 +1266,24 @@ loop = do
|
||||
void $ propagatePatch inputDescription patch' currentPath'
|
||||
-- Say something
|
||||
success
|
||||
sayNotFound = respond
|
||||
. SearchTermsNotFound
|
||||
. pure
|
||||
. either
|
||||
HQ.HashOnly
|
||||
(fmap Path.toName' . HQ'.toHQ . Path.unsplitHQ')
|
||||
sayHashConflicted t = hashConflicted t . Set.map Referent.Ref
|
||||
zeroOneOrMore
|
||||
fromRefs
|
||||
(sayNotFound from)
|
||||
(\r -> zeroOneOrMore toRefs
|
||||
(sayNotFound to)
|
||||
(go r)
|
||||
(either sayHashConflicted typeConflicted to))
|
||||
(either sayHashConflicted typeConflicted from)
|
||||
|
||||
misses = fromMisses <> toMisses
|
||||
ambiguous t rs =
|
||||
let rs' = Set.map Referent.Ref $ Set.fromList rs
|
||||
in case t of
|
||||
HQ.HashOnly h ->
|
||||
hashConflicted h rs'
|
||||
(Path.parseHQSplit' . HQ.toString -> Right n) ->
|
||||
typeConflicted n $ Set.fromList rs
|
||||
-- This is unlikely to happen, as t has to be a parsed
|
||||
-- hash-qualified name already.
|
||||
-- Still, the types say we need to handle this case.
|
||||
_ -> respond . BadName $ HQ.toString t
|
||||
when (not $ null misses) $
|
||||
respond $ SearchTermsNotFound misses
|
||||
case (fromRefs, toRefs) of
|
||||
([fr], [tr]) -> go fr tr
|
||||
([_], tos) -> ambiguous to tos
|
||||
(frs, _) -> ambiguous from frs
|
||||
LoadI maybePath ->
|
||||
case maybePath <|> (fst <$> latestFile') of
|
||||
Nothing -> respond NoUnisonFile
|
||||
@ -1512,10 +1562,10 @@ loop = do
|
||||
|
||||
DeprecateTermI {} -> notImplemented
|
||||
DeprecateTypeI {} -> notImplemented
|
||||
AddTermReplacementI {} -> notImplemented
|
||||
AddTypeReplacementI {} -> notImplemented
|
||||
RemoveTermReplacementI {} -> notImplemented
|
||||
RemoveTypeReplacementI {} -> notImplemented
|
||||
RemoveTermReplacementI from patchPath ->
|
||||
doRemoveReplacement from patchPath True
|
||||
RemoveTypeReplacementI from patchPath ->
|
||||
doRemoveReplacement from patchPath False
|
||||
ShowDefinitionByPrefixI {} -> notImplemented
|
||||
UpdateBuiltinsI -> notImplemented
|
||||
QuitI -> MaybeT $ pure Nothing
|
||||
|
||||
@ -15,7 +15,6 @@ import qualified Unison.HashQualified' as HQ'
|
||||
import Unison.Codebase.Path ( Path' )
|
||||
import qualified Unison.Codebase.Path as Path
|
||||
import Unison.Codebase.Editor.RemoteRepo
|
||||
import Unison.Reference (Reference)
|
||||
import Unison.ShortHash (ShortHash)
|
||||
import Unison.Codebase.ShortBranchHash (ShortBranchHash)
|
||||
import qualified Unison.Codebase.ShortBranchHash as SBH
|
||||
@ -95,12 +94,10 @@ data Input
|
||||
-- -- create and remove update directives
|
||||
| DeprecateTermI PatchPath Path.HQSplit'
|
||||
| DeprecateTypeI PatchPath Path.HQSplit'
|
||||
| AddTermReplacementI PatchPath Reference Reference
|
||||
| AddTypeReplacementI PatchPath Reference Reference
|
||||
| RemoveTermReplacementI PatchPath Reference Reference
|
||||
| RemoveTypeReplacementI PatchPath Reference Reference
|
||||
| ReplaceTermI HashOrHQSplit' HashOrHQSplit' (Maybe PatchPath)
|
||||
| ReplaceTypeI HashOrHQSplit' HashOrHQSplit' (Maybe PatchPath)
|
||||
| ReplaceTermI HQ.HashQualified HQ.HashQualified (Maybe PatchPath)
|
||||
| ReplaceTypeI HQ.HashQualified HQ.HashQualified (Maybe PatchPath)
|
||||
| RemoveTermReplacementI HQ.HashQualified (Maybe PatchPath)
|
||||
| RemoveTypeReplacementI HQ.HashQualified (Maybe PatchPath)
|
||||
| UndoI
|
||||
-- First `Maybe Int` is cap on number of results, if any
|
||||
-- Second `Maybe Int` is cap on diff elements shown, if any
|
||||
@ -115,14 +112,14 @@ data Input
|
||||
| UnlinkI [Path.HQSplit'] Path.HQSplit'
|
||||
-- links from <type>
|
||||
| LinksI Path.HQSplit' (Maybe String)
|
||||
| DisplayI OutputLocation String
|
||||
| DisplayI OutputLocation HQ.HashQualified
|
||||
| DocsI Path.HQSplit'
|
||||
-- other
|
||||
| SearchByNameI Bool Bool [String] -- SearchByName isVerbose showAll query
|
||||
| FindShallowI Path'
|
||||
| FindPatchI
|
||||
| ShowDefinitionI OutputLocation [String]
|
||||
| ShowDefinitionByPrefixI OutputLocation [String]
|
||||
| ShowDefinitionI OutputLocation [HQ.HashQualified]
|
||||
| ShowDefinitionByPrefixI OutputLocation [HQ.HashQualified]
|
||||
| ShowReflogI
|
||||
| UpdateBuiltinsI
|
||||
| MergeBuiltinsI
|
||||
|
||||
@ -192,6 +192,7 @@ data Output v
|
||||
| NoBranchWithHash ShortBranchHash
|
||||
| DumpNumberedArgs NumberedArgs
|
||||
| DumpBitBooster Branch.Hash (Map Branch.Hash [Branch.Hash])
|
||||
| BadName String
|
||||
deriving (Show)
|
||||
|
||||
data ReflogEntry =
|
||||
@ -263,6 +264,7 @@ isFailure o = case o of
|
||||
TermAmbiguous{} -> True
|
||||
BranchHashAmbiguous{} -> True
|
||||
BadDestinationBranch{} -> True
|
||||
BadName{} -> True
|
||||
BranchNotFound{} -> True
|
||||
NameNotFound{} -> True
|
||||
PatchNotFound{} -> True
|
||||
|
||||
@ -258,28 +258,45 @@ patch = InputPattern
|
||||
)
|
||||
|
||||
view :: InputPattern
|
||||
view = InputPattern "view" [] [(OnePlus, definitionQueryArg)]
|
||||
"`view foo` prints the definition of `foo`."
|
||||
(pure . Input.ShowDefinitionI Input.ConsoleLocation)
|
||||
view = InputPattern
|
||||
"view"
|
||||
[]
|
||||
[(OnePlus, definitionQueryArg)]
|
||||
"`view foo` prints the definition of `foo`."
|
||||
( fmap (Input.ShowDefinitionI Input.ConsoleLocation)
|
||||
. traverse parseHashQualifiedName
|
||||
)
|
||||
|
||||
display :: InputPattern
|
||||
display = InputPattern "display" [] [(Required, definitionQueryArg)]
|
||||
"`display foo` prints a rendered version of the term `foo`."
|
||||
(\case
|
||||
[s] -> pure (Input.DisplayI Input.ConsoleLocation s)
|
||||
_ -> Left (I.help display))
|
||||
display = InputPattern
|
||||
"display"
|
||||
[]
|
||||
[(Required, definitionQueryArg)]
|
||||
"`display foo` prints a rendered version of the term `foo`."
|
||||
(\case
|
||||
[s] -> Input.DisplayI Input.ConsoleLocation <$> parseHashQualifiedName s
|
||||
_ -> Left (I.help display)
|
||||
)
|
||||
|
||||
|
||||
displayTo :: InputPattern
|
||||
displayTo = InputPattern "display.to" [] [(Required, noCompletions), (Required, definitionQueryArg)]
|
||||
(P.wrap $ makeExample displayTo ["<filename>", "foo"]
|
||||
<> "prints a rendered version of the term `foo` to the given file.")
|
||||
(\case
|
||||
[file,s] -> pure (Input.DisplayI (Input.FileLocation file) s)
|
||||
_ -> Left (I.help displayTo))
|
||||
displayTo = InputPattern
|
||||
"display.to"
|
||||
[]
|
||||
[(Required, noCompletions), (Required, definitionQueryArg)]
|
||||
( P.wrap
|
||||
$ makeExample displayTo ["<filename>", "foo"]
|
||||
<> "prints a rendered version of the term `foo` to the given file."
|
||||
)
|
||||
(\case
|
||||
[file, s] ->
|
||||
Input.DisplayI (Input.FileLocation file) <$> parseHashQualifiedName s
|
||||
_ -> Left (I.help displayTo)
|
||||
)
|
||||
|
||||
docs :: InputPattern
|
||||
docs = InputPattern "docs" [] [(Required, definitionQueryArg)]
|
||||
("`docs foo` shows documentation for the definition `foo`.")
|
||||
"`docs foo` shows documentation for the definition `foo`."
|
||||
(\case
|
||||
[s] -> first fromString $ Input.DocsI <$> Path.parseHQSplit' s
|
||||
_ -> Left (I.help docs))
|
||||
@ -290,10 +307,14 @@ undo = InputPattern "undo" [] []
|
||||
(const $ pure Input.UndoI)
|
||||
|
||||
viewByPrefix :: InputPattern
|
||||
viewByPrefix
|
||||
= InputPattern "view.recursive" [] [(OnePlus, definitionQueryArg)]
|
||||
"`view.recursive Foo` prints the definitions of `Foo` and `Foo.blah`."
|
||||
(pure . Input.ShowDefinitionByPrefixI Input.ConsoleLocation)
|
||||
viewByPrefix = InputPattern
|
||||
"view.recursive"
|
||||
[]
|
||||
[(OnePlus, definitionQueryArg)]
|
||||
"`view.recursive Foo` prints the definitions of `Foo` and `Foo.blah`."
|
||||
( fmap (Input.ShowDefinitionByPrefixI Input.ConsoleLocation)
|
||||
. traverse parseHashQualifiedName
|
||||
)
|
||||
|
||||
find :: InputPattern
|
||||
find = InputPattern
|
||||
@ -415,6 +436,70 @@ deleteType = InputPattern "delete.type" []
|
||||
"`delete.type` takes an argument, like `delete.type name`."
|
||||
)
|
||||
|
||||
deleteTermReplacementCommand :: String
|
||||
deleteTermReplacementCommand = "delete.term-replacement"
|
||||
|
||||
deleteTypeReplacementCommand :: String
|
||||
deleteTypeReplacementCommand = "delete.type-replacement"
|
||||
|
||||
deleteReplacement :: Bool -> InputPattern
|
||||
deleteReplacement isTerm = InputPattern
|
||||
commandName
|
||||
[]
|
||||
[(Required, if isTerm then exactDefinitionTermQueryArg else exactDefinitionTypeQueryArg), (Optional, patchArg)]
|
||||
( P.string
|
||||
$ commandName
|
||||
<> " <patch>` removes any edit of the "
|
||||
<> str
|
||||
<> " `foo` "
|
||||
<> "from the patch `patch`, or the default patch if none is specified."
|
||||
)
|
||||
(\case
|
||||
query : patch -> do
|
||||
patch <-
|
||||
first fromString
|
||||
. traverse (Path.parseSplit' Path.wordyNameSegment)
|
||||
$ listToMaybe patch
|
||||
q <- parseHashQualifiedName query
|
||||
pure $ input q patch
|
||||
_ ->
|
||||
Left
|
||||
. P.warnCallout
|
||||
. P.wrapString
|
||||
$ commandName
|
||||
<> " needs arguments. See `help "
|
||||
<> commandName
|
||||
<> "`."
|
||||
)
|
||||
where
|
||||
input = if isTerm
|
||||
then Input.RemoveTermReplacementI
|
||||
else Input.RemoveTypeReplacementI
|
||||
str = if isTerm then "term" else "type"
|
||||
commandName = if isTerm
|
||||
then deleteTermReplacementCommand
|
||||
else deleteTypeReplacementCommand
|
||||
|
||||
deleteTermReplacement :: InputPattern
|
||||
deleteTermReplacement = deleteReplacement True
|
||||
|
||||
deleteTypeReplacement :: InputPattern
|
||||
deleteTypeReplacement = deleteReplacement False
|
||||
|
||||
parseHashQualifiedName
|
||||
:: String -> Either (P.Pretty CT.ColorText) HQ.HashQualified
|
||||
parseHashQualifiedName s =
|
||||
maybe
|
||||
( Left
|
||||
. P.warnCallout
|
||||
. P.wrap
|
||||
$ P.string s
|
||||
<> " is not a well-formed name, hash, or hash-qualified name. "
|
||||
<> "I expected something like `foo`, `#abc123`, or `foo#abc123`."
|
||||
)
|
||||
Right
|
||||
$ HQ.fromString s
|
||||
|
||||
aliasTerm :: InputPattern
|
||||
aliasTerm = InputPattern "alias.term" []
|
||||
[(Required, exactDefinitionTermQueryArg), (Required, newNameArg)]
|
||||
@ -689,8 +774,8 @@ createPullRequest = InputPattern "pull-request.create" ["pr.create"]
|
||||
<> "will generate a request to merge the remote repo `head`"
|
||||
<> "into the remote repo `base`."
|
||||
, ""
|
||||
, "example: " <>
|
||||
makeExampleNoBackticks createPullRequest ["https://github.com/unisonweb/base",
|
||||
, "example: " <>
|
||||
makeExampleNoBackticks createPullRequest ["https://github.com/unisonweb/base",
|
||||
"https://github.com/me/unison:.libs.pr.base" ]
|
||||
])
|
||||
(\case
|
||||
@ -793,10 +878,7 @@ previewMergeLocal = InputPattern
|
||||
)
|
||||
|
||||
replaceEdit
|
||||
:: (Input.HashOrHQSplit'
|
||||
-> Input.HashOrHQSplit'
|
||||
-> Maybe Input.PatchPath
|
||||
-> Input)
|
||||
:: (HQ.HashQualified -> HQ.HashQualified -> Maybe Input.PatchPath -> Input)
|
||||
-> String
|
||||
-> InputPattern
|
||||
replaceEdit f s = self
|
||||
@ -825,12 +907,14 @@ replaceEdit f s = self
|
||||
]
|
||||
)
|
||||
(\case
|
||||
source : target : patch -> first fromString $ do
|
||||
src <- Path.parseShortHashOrHQSplit' source
|
||||
dest <- Path.parseShortHashOrHQSplit' target
|
||||
patch <- traverse (Path.parseSplit' Path.wordyNameSegment)
|
||||
$ listToMaybe patch
|
||||
pure $ f src dest patch
|
||||
source : target : patch -> do
|
||||
patch <-
|
||||
first fromString
|
||||
<$> traverse (Path.parseSplit' Path.wordyNameSegment)
|
||||
$ listToMaybe patch
|
||||
sourcehq <- parseHashQualifiedName source
|
||||
targethq <- parseHashQualifiedName target
|
||||
pure $ f sourcehq targethq patch
|
||||
_ -> Left $ I.help self
|
||||
)
|
||||
|
||||
@ -859,7 +943,9 @@ edit = InputPattern
|
||||
( "`edit foo` prepends the definition of `foo` to the top of the most "
|
||||
<> "recently saved file."
|
||||
)
|
||||
(pure . Input.ShowDefinitionI Input.LatestFileLocation)
|
||||
( fmap (Input.ShowDefinitionI Input.LatestFileLocation)
|
||||
. traverse parseHashQualifiedName
|
||||
)
|
||||
|
||||
topicNameArg :: ArgumentType
|
||||
topicNameArg =
|
||||
@ -1174,6 +1260,8 @@ validInputs =
|
||||
, links
|
||||
, replaceTerm
|
||||
, replaceType
|
||||
, deleteTermReplacement
|
||||
, deleteTypeReplacement
|
||||
, test
|
||||
, execute
|
||||
, viewReflog
|
||||
|
||||
@ -670,7 +670,9 @@ notifyUser dir o = case o of
|
||||
else "Edited Terms:" `P.hang`
|
||||
P.column2 (prettyTermEdit <$> R.toList terms),
|
||||
if R.null types && R.null terms then "This patch is empty."
|
||||
else mempty
|
||||
else tip . P.string $ "To remove entries from a patch, use "
|
||||
<> IP.deleteTermReplacementCommand <> " or "
|
||||
<> IP.deleteTypeReplacementCommand <> ", as appropriate."
|
||||
]
|
||||
BustedBuiltins (Set.toList -> new) (Set.toList -> old) ->
|
||||
-- todo: this could be prettier! Have a nice list like `find` gives, but
|
||||
@ -799,6 +801,8 @@ notifyUser dir o = case o of
|
||||
P.wrap "Try again with a few more hash characters to disambiguate."
|
||||
]
|
||||
BadDestinationBranch _ -> pure "That destination namespace is bad."
|
||||
BadName n ->
|
||||
pure . P.wrap $ P.string n <> " is not a kind of name I understand."
|
||||
TermNotFound' sh ->
|
||||
pure $ "I could't find a term with hash "
|
||||
<> (prettyShortHash sh)
|
||||
|
||||
@ -1,6 +1,5 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
|
||||
module Unison.Typechecker.TypeError where
|
||||
|
||||
|
||||
@ -159,7 +159,7 @@ requalify hq r = case hq of
|
||||
HashQualified n _ -> fromNamedReferent n r
|
||||
HashOnly _ -> fromReferent r
|
||||
|
||||
-- this implementation shows HashOnly before the others, because None < Some.
|
||||
-- this implementation shows HashOnly before the others, because None < Some.
|
||||
-- Flip it around carefully if HashOnly should come last.
|
||||
instance Ord n => Ord (HashQualified' n) where
|
||||
compare a b = case compare (toName a) (toName b) of
|
||||
|
||||
46
unison-src/transcripts/deleteReplacements.md
Normal file
46
unison-src/transcripts/deleteReplacements.md
Normal file
@ -0,0 +1,46 @@
|
||||
# Deleting term and type replacements from patches
|
||||
|
||||
```unison
|
||||
x = 1
|
||||
```
|
||||
|
||||
```ucm
|
||||
.> add
|
||||
```
|
||||
|
||||
```unison
|
||||
x = 2
|
||||
```
|
||||
|
||||
```ucm
|
||||
.> update
|
||||
.> view.patch
|
||||
```
|
||||
|
||||
```ucm
|
||||
.> delete.term-replacement #jk19
|
||||
.> view.patch
|
||||
```
|
||||
|
||||
```unison
|
||||
type Foo = Foo
|
||||
```
|
||||
|
||||
```ucm
|
||||
.> add
|
||||
```
|
||||
|
||||
```unison
|
||||
type Foo = Foo | Bar
|
||||
```
|
||||
|
||||
```ucm
|
||||
.> update
|
||||
.> view.patch
|
||||
```
|
||||
|
||||
```ucm
|
||||
.> delete.type-replacement #568rsi7o3g
|
||||
.> view.patch
|
||||
```
|
||||
|
||||
144
unison-src/transcripts/deleteReplacements.output.md
Normal file
144
unison-src/transcripts/deleteReplacements.output.md
Normal file
@ -0,0 +1,144 @@
|
||||
# Deleting term and type replacements from patches
|
||||
|
||||
```unison
|
||||
x = 1
|
||||
```
|
||||
|
||||
```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`:
|
||||
|
||||
x : ##Nat
|
||||
|
||||
Now evaluating any watch expressions (lines starting with
|
||||
`>`)... Ctrl+C cancels.
|
||||
|
||||
```
|
||||
```ucm
|
||||
.> add
|
||||
|
||||
⍟ I've added these definitions:
|
||||
|
||||
x : ##Nat
|
||||
|
||||
```
|
||||
```unison
|
||||
x = 2
|
||||
```
|
||||
|
||||
```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 names already exist. You can `update` them to your
|
||||
new definition:
|
||||
|
||||
x : ##Nat
|
||||
|
||||
Now evaluating any watch expressions (lines starting with
|
||||
`>`)... Ctrl+C cancels.
|
||||
|
||||
```
|
||||
```ucm
|
||||
.> update
|
||||
|
||||
⍟ I've updated these names to your new definition:
|
||||
|
||||
x : ##Nat
|
||||
|
||||
.> view.patch
|
||||
|
||||
Edited Terms: x#jk19sm5bf8 -> x
|
||||
|
||||
Tip: To remove entries from a patch, use
|
||||
delete.term-replacement or delete.type-replacement, as
|
||||
appropriate.
|
||||
|
||||
```
|
||||
```ucm
|
||||
.> delete.term-replacement #jk19
|
||||
|
||||
Done.
|
||||
|
||||
.> view.patch
|
||||
|
||||
This patch is empty.
|
||||
|
||||
```
|
||||
```unison
|
||||
type Foo = Foo
|
||||
```
|
||||
|
||||
```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`:
|
||||
|
||||
type Foo
|
||||
|
||||
Now evaluating any watch expressions (lines starting with
|
||||
`>`)... Ctrl+C cancels.
|
||||
|
||||
```
|
||||
```ucm
|
||||
.> add
|
||||
|
||||
⍟ I've added these definitions:
|
||||
|
||||
type Foo
|
||||
|
||||
```
|
||||
```unison
|
||||
type Foo = Foo | Bar
|
||||
```
|
||||
|
||||
```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 names already exist. You can `update` them to your
|
||||
new definition:
|
||||
|
||||
type Foo
|
||||
|
||||
Now evaluating any watch expressions (lines starting with
|
||||
`>`)... Ctrl+C cancels.
|
||||
|
||||
```
|
||||
```ucm
|
||||
.> update
|
||||
|
||||
⍟ I've updated these names to your new definition:
|
||||
|
||||
type Foo
|
||||
|
||||
.> view.patch
|
||||
|
||||
Edited Types: Foo#568rsi7o3g -> Foo
|
||||
|
||||
Tip: To remove entries from a patch, use
|
||||
delete.term-replacement or delete.type-replacement, as
|
||||
appropriate.
|
||||
|
||||
```
|
||||
```ucm
|
||||
.> delete.type-replacement #568rsi7o3g
|
||||
|
||||
Done.
|
||||
|
||||
.> view.patch
|
||||
|
||||
This patch is empty.
|
||||
|
||||
```
|
||||
@ -424,6 +424,10 @@ unique type Y a b = Y a b
|
||||
Edited Terms:
|
||||
ns1.b -> ns2.b
|
||||
ns1.fromJust' -> ns2.fromJust
|
||||
|
||||
Tip: To remove entries from a patch, use
|
||||
delete.term-replacement or delete.type-replacement, as
|
||||
appropriate.
|
||||
|
||||
.> fork ns2 ns3
|
||||
|
||||
|
||||
@ -71,9 +71,17 @@ Update
|
||||
.> view.patch patch
|
||||
|
||||
Edited Terms: hey#8e79ctircj -> hey
|
||||
|
||||
Tip: To remove entries from a patch, use
|
||||
delete.term-replacement or delete.type-replacement, as
|
||||
appropriate.
|
||||
|
||||
.> view.patch 1
|
||||
|
||||
Edited Terms: hey#8e79ctircj -> hey
|
||||
|
||||
Tip: To remove entries from a patch, use
|
||||
delete.term-replacement or delete.type-replacement, as
|
||||
appropriate.
|
||||
|
||||
```
|
||||
|
||||
@ -82,6 +82,10 @@ We used to have to know the full hash for a definition to be able to use the `re
|
||||
.> view.patch
|
||||
|
||||
Edited Terms: f#msp7bv40rv -> f
|
||||
|
||||
Tip: To remove entries from a patch, use
|
||||
delete.term-replacement or delete.type-replacement, as
|
||||
appropriate.
|
||||
|
||||
```
|
||||
The value of `h` should have been updated too:
|
||||
|
||||
@ -128,10 +128,18 @@ The `a` and `b` namespaces now each contain a patch named `patch`. We can view t
|
||||
.example.resolve> view.patch a.patch
|
||||
|
||||
Edited Terms: c.foo -> a.foo
|
||||
|
||||
Tip: To remove entries from a patch, use
|
||||
delete.term-replacement or delete.type-replacement, as
|
||||
appropriate.
|
||||
|
||||
.example.resolve> view.patch b.patch
|
||||
|
||||
Edited Terms: c.foo -> b.foo
|
||||
|
||||
Tip: To remove entries from a patch, use
|
||||
delete.term-replacement or delete.type-replacement, as
|
||||
appropriate.
|
||||
|
||||
```
|
||||
Let's now merge these namespaces into `c`:
|
||||
@ -215,6 +223,10 @@ This changes the merged `c.patch` so that only the edit from #44954ulpdf to #8e
|
||||
.example.resolve.c> view.patch
|
||||
|
||||
Edited Terms: foo#44954ulpdf -> foo#8e68dvpr0a
|
||||
|
||||
Tip: To remove entries from a patch, use
|
||||
delete.term-replacement or delete.type-replacement, as
|
||||
appropriate.
|
||||
|
||||
```
|
||||
We still have a remaining _name conflict_ since it just so happened that both of the definitions in the edits were named `foo`.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user