From 5c675df566d9cf122ef3012eac9b6da5b699b0b2 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 2 Jul 2024 10:28:59 -0700 Subject: [PATCH] Revive ability to delete root namespace --- .../src/Unison/Codebase/Editor/HandleInput.hs | 22 ++++++-- .../src/Unison/Codebase/Editor/Input.hs | 2 +- .../src/Unison/CommandLine/InputPatterns.hs | 3 +- .../src/Unison/CommandLine/OutputMessages.hs | 6 ++- .../transcripts/delete-namespace.output.md | 53 ++++++++++++++----- 5 files changed, 65 insertions(+), 21 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 6247d42b8..ec8ed7cb4 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -575,7 +575,16 @@ loop e = do delete input doutput getTerms getTypes hqs DeleteTarget'Type doutput hqs -> delete input doutput (const (pure Set.empty)) getTypes hqs DeleteTarget'Term doutput hqs -> delete input doutput getTerms (const (pure Set.empty)) hqs - DeleteTarget'Namespace insistence p@(parentPath, childName) -> do + DeleteTarget'Namespace insistence Nothing -> do + hasConfirmed <- confirmedCommand input + if hasConfirmed || insistence == Force + then do + description <- inputDescription input + pp <- Cli.getCurrentProjectPath + _ <- Cli.updateAt description pp (const Branch.empty) + Cli.respond DeletedEverything + else Cli.respond DeleteEverythingConfirmation + DeleteTarget'Namespace insistence (Just p@(parentPath, childName)) -> do branch <- Cli.expectBranchAtPath (Path.unsplit p) description <- inputDescription input let toDelete = @@ -947,10 +956,10 @@ inputDescription input = thing <- traverse hqs' thing0 pure ("delete.type.verbose " <> Text.intercalate " " thing) DeleteTarget'Namespace Try opath0 -> do - opath <- ps opath0 + opath <- ops opath0 pure ("delete.namespace " <> opath) DeleteTarget'Namespace Force opath0 -> do - opath <- ps opath0 + opath <- ops opath0 pure ("delete.namespace.force " <> opath) DeleteTarget'ProjectBranch _ -> wat DeleteTarget'Project _ -> wat @@ -1053,6 +1062,8 @@ inputDescription input = p' = fmap tShow . Cli.resolvePath' brp :: BranchRelativePath -> Cli Text brp = fmap (into @Text) . ProjectUtils.resolveBranchRelativePath + ops :: Maybe Path.Split -> Cli Text + ops = maybe (pure ".") ps wat = error $ show input ++ " is not expected to alter the branch" hhqs' :: Either SH.ShortHash Path.HQSplit' -> Cli Text hhqs' = \case @@ -1326,6 +1337,11 @@ doDisplay outputLoc names tm = do else do writeUtf8 filePath txt +confirmedCommand :: Input -> Cli Bool +confirmedCommand i = do + loopState <- State.get + pure $ Just i == (loopState ^. #lastInput) + -- return `name` and `name....` _searchBranchPrefix :: Branch m -> Name -> [SearchResult] _searchBranchPrefix b n = case Path.unsnoc (Path.fromName n) of diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 774e840d9..739482c84 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -312,7 +312,7 @@ data DeleteTarget = DeleteTarget'TermOrType DeleteOutput [Path.HQSplit'] | DeleteTarget'Term DeleteOutput [Path.HQSplit'] | DeleteTarget'Type DeleteOutput [Path.HQSplit'] - | DeleteTarget'Namespace Insistence (Path.Split) + | DeleteTarget'Namespace Insistence (Maybe Path.Split) | DeleteTarget'ProjectBranch (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) | DeleteTarget'Project ProjectName deriving stock (Eq, Show) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 43ff94738..d93fac27f 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -1542,7 +1542,8 @@ deleteNamespaceForce = deleteNamespaceParser :: P.Pretty CT.ColorText -> Input.Insistence -> I.Arguments -> Either (P.Pretty CT.ColorText) Input deleteNamespaceParser helpText insistence = \case - [p] -> Input.DeleteI . DeleteTarget'Namespace insistence <$> handleSplitArg p + [Left "."] -> first fromString . pure $ Input.DeleteI (DeleteTarget'Namespace insistence Nothing) + [p] -> Input.DeleteI . DeleteTarget'Namespace insistence <$> (Just <$> handleSplitArg p) _ -> Left helpText renameBranch :: InputPattern diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index c56fe14c8..8ad81af88 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -815,9 +815,11 @@ notifyUser dir = \case DeleteEverythingConfirmation -> pure . P.warnCallout . P.lines $ [ "Are you sure you want to clear away everything?", - "You could use " + P.wrap ("You could use " <> IP.makeExample' IP.projectCreate - <> " to switch to a new project instead." + <> " to switch to a new project instead," + <> " or delete the current branch with " <> IP.makeExample' IP.deleteBranch + ) ] DeleteBranchConfirmation _uniqueDeletions -> error "todo" -- let diff --git a/unison-src/transcripts/delete-namespace.output.md b/unison-src/transcripts/delete-namespace.output.md index b350e13f2..d4ea0436b 100644 --- a/unison-src/transcripts/delete-namespace.output.md +++ b/unison-src/transcripts/delete-namespace.output.md @@ -75,21 +75,46 @@ Deleting the root namespace should require confirmation if not forced. ```ucm scratch/main> delete.namespace . + ⚠️ + + Are you sure you want to clear away everything? + You could use `project.create` to switch to a new project + instead, or delete the current branch with `delete.branch` + +scratch/main> delete.namespace . + + Okay, I deleted everything except the history. Use `undo` to + undo, or `builtins.merge` to restore the absolute basics to + the current path. + +-- Should have an empty history +scratch/main> history . + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #sg60bvjo91 (start of history) + ``` +Deleting the root namespace shouldn't require confirmation if forced. ```ucm -scratch/main> delete.namespace .scratch/main> delete.namespace .-- Should have an empty historyscratch/main> history . +scratch/main> delete.namespace.force . + + Okay, I deleted everything except the history. Use `undo` to + undo, or `builtins.merge` to restore the absolute basics to + the current path. + +-- Should have an empty history +scratch/main> history . + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #sg60bvjo91 (start of history) + ``` - - -🛑 - -The transcript failed due to an error in the stanza above. The error is: - -1:1: - | -1 | . - | ^ -unexpected '.' -expecting '`' or operator (valid characters: !$%&*+-/:<=>\^|~) -