Merge pull request #6123 from unisonweb/cp/history-comment-message

aryairani · web-flow · commit 9fb4b2fceed4 · 2026-01-15T23:04:43.000-07:00
diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
@@ -525,8 +525,8 @@ loop e = do
               else BranchEmpty branchEmpty
         HistoryI resultsCap diffCap from -> do
           handleHistory resultsCap diffCap from
-        HistoryCommentI toAnnotate -> do
-          handleHistoryComment toAnnotate
+        HistoryCommentI toAnnotate message -> do
+          handleHistoryComment toAnnotate message
         IOTestAllI -> Tests.handleAllIOTests
         IOTestI main -> Tests.handleIOTest main
         LibInstallI remind libdep -> handleInstallLib remind libdep
diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs
@@ -22,8 +22,8 @@ import UnliftIO.Directory (findExecutable)
 import UnliftIO.Environment qualified as Env
 import UnliftIO.Process qualified as Proc
 
-handleHistoryComment :: Maybe BranchId2 -> Cli ()
-handleHistoryComment mayThingToAnnotate = do
+handleHistoryComment :: Maybe BranchId2 -> Maybe Text -> Cli ()
+handleHistoryComment mayThingToAnnotate mayMessage = do
   authorName <-
     Cli.runTransaction Q.getAuthorName >>= \case
       Nothing -> Cli.returnEarly $ AuthorNameRequired
@@ -49,16 +49,24 @@ handleHistoryComment mayThingToAnnotate = do
     causalHashId <- Q.expectCausalHashIdByCausalHash causalHash
     mayExistingCommentInfo <- Q.getLatestCausalComment causalHashId
     pure (causalHashId, mayExistingCommentInfo)
-  let populatedMsg = fromMaybe commentInstructions $ do
-        HistoryComment {subject, content} <- mayHistoryComment
-        pure $ Text.unlines [subject, "", content, commentInstructions]
-  mayNewMessage <- liftIO (editMessage (Just populatedMsg))
-  case mayNewMessage of
-    Nothing -> Cli.respond $ CommentAborted
+  maySubjectContent <- case mayMessage of
+    Just msg -> do
+      let (subject, content) = cleanComment msg
+      pure $ Just (subject, content)
+    Nothing -> do
+      let populatedMsg = fromMaybe commentInstructions $ do
+            HistoryComment {subject, content} <- mayHistoryComment
+            pure $ Text.unlines [subject, "", content, commentInstructions]
+      mayNewMessage <- liftIO (editMessage (Just populatedMsg))
+      case mayNewMessage of
+        Nothing -> pure Nothing
+        Just (subject, content) -> pure $ Just (subject, content)
+  case maySubjectContent of
     Just (subject, content) -> do
       let historyComment = HistoryComment {author = Config.unAuthorName authorName, subject, content, commentId = (), causal = causalHashId}
       Cli.runTransaction $ Q.commentOnCausal historyComment
       Cli.respond $ CommentedSuccessfully
+    Nothing -> Cli.respond $ CommentAborted
   where
     commentInstructions =
       [r|
@@ -98,15 +106,18 @@ editMessage initialMessage = runMaybeT do
       Left _ -> empty
       Right () -> pure ()
     result <- liftIO (readUtf8 tempFilePath)
-    let cleanedResult =
-          result
-            & Text.lines
-            & filter (not . Text.isPrefixOf "--")
-            & Text.unlines
-            & Text.strip
-    guard $ not (Text.null cleanedResult)
-    let (subject, contents) =
-          case Text.lines cleanedResult of
-            [] -> ("", "")
-            (s : rest) -> (Text.strip s, Text.strip $ Text.unlines rest)
+    let (subject, contents) = cleanComment result
+    guard $ not (Text.null subject)
     pure (subject, contents)
+
+cleanComment :: Text -> (Text, Text)
+cleanComment txt =
+  txt
+    & Text.lines
+    & filter (not . Text.isPrefixOf "--")
+    & Text.unlines
+    & Text.strip
+    & Text.lines
+    & \case
+      [] -> ("", "")
+      (s : rest) -> (Text.strip s, Text.strip $ Text.unlines rest)
diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs
@@ -167,7 +167,7 @@ data Input
   | ForkLocalBranchI (Either ShortCausalHash BranchRelativePath) BranchRelativePath
   | HistoryI (Maybe Int {- cap on number of results -}) (Maybe Int {- cap on diff elements shown -}) BranchId
   | -- An optional causal hash or branch to annotate.
-    HistoryCommentI (Maybe BranchId2 {- causal to annotate -})
+    HistoryCommentI (Maybe BranchId2 {- causal to annotate -}) (Maybe Text {- comment -})
   | IOTestAllI
   | IOTestI (HQ.HashQualified Name)
   | LibInstallI
diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs
@@ -684,6 +684,14 @@ handleNameSegmentArg arg = do
     -- output them as numbered output.
     I.StructuredArg _ -> Left "Expected a name segment"
 
+-- | Just a single simple name segment. Useful for lib names, etc.
+handleTextArg :: I.Argument -> Either (P.Pretty CT.ColorText) Text
+handleTextArg arg = do
+  case arg of
+    I.RawArg txt -> pure $ Text.pack txt
+    -- There are no valid structured args for a raw text arg
+    I.StructuredArg _ -> Left "Expected a text argument"
+
 handleNameArg :: I.Argument -> Either (P.Pretty CT.ColorText) Name
 handleNameArg = \case
   I.RawArg raw -> first P.text . Name.parseTextEither . Text.pack $ raw
@@ -1758,22 +1766,32 @@ historyComment =
     "history.comment"
     ["comment", "comment.history"]
     I.Visible
-    (Parameters [] $ Optional [("hash or branch to create a comment after", namespaceOrProjectBranchArg config)] Nothing)
+    (Parameters [] $ Optional [("hash or branch to create a comment after", namespaceOrProjectBranchArg config), ("comment message", noCompletionsArg)] Nothing)
     ( P.wrapColumn2
         [ ( makeExample historyComment [],
             "Creates a comment after the head of the current branch."
           ),
-          ( makeExample historyComment ["/main"],
+          ( makeExample historyComment ["/main:"],
             "Creates a comment after the head of the `main` branch."
+          ),
+          ( makeExample historyComment ["#abcdefg"],
+            "Creates a comment in the history after #abcdefg"
+          ),
+          ( makeExample historyComment ["/main:", "\"Comment message\""],
+            "Creates a comment with the content 'Comment message' after the head of the `main` branch."
           )
         ]
     )
     \case
-      [] -> pure $ Input.HistoryCommentI Nothing
+      [] -> pure $ Input.HistoryCommentI Nothing Nothing
       [src] -> do
         target <- handleBranchId2Arg src
-        pure $ Input.HistoryCommentI (Just target)
-      _ -> wrongArgsLength "at most one argument" []
+        pure $ Input.HistoryCommentI (Just target) Nothing
+      [src, msg] -> do
+        target <- handleBranchId2Arg src
+        message <- handleTextArg msg
+        pure $ Input.HistoryCommentI (Just target) (Just message)
+      _ -> wrongArgsLength "at most two arguments" []
   where
     config =
       ProjectBranchSuggestionsConfig
diff --git a/unison-src/transcripts/idempotent/help.md b/unison-src/transcripts/idempotent/help.md
@@ -522,10 +522,21 @@
                                 The full hash must be provided.
 
   history.comment (or comment, comment.history)
-  `history.comment`        Creates a comment after the head of
-                           the current branch.
-  `history.comment /main`  Creates a comment after the head of
-                           the `main` branch.
+  `history.comment`                           Creates a comment
+                                              after the head of
+                                              the current
+                                              branch.
+  `history.comment /main:`                    Creates a comment
+                                              after the head of
+                                              the `main` branch.
+  `history.comment #abcdefg`                  Creates a comment
+                                              in the history
+                                              after #abcdefg
+  `history.comment /main: "Comment message"`  Creates a comment
+                                              with the content
+                                              'Comment message'
+                                              after the head of
+                                              the `main` branch.
 
   io.test (or test.io)
   `io.test mytest`  Runs `!mytest`, where `mytest` is a delayed
diff --git a/unison-src/transcripts/idempotent/history-comments.md b/unison-src/transcripts/idempotent/history-comments.md
@@ -0,0 +1,62 @@
+# History Comments transcript
+
+``` ucm :hide
+scratch/main> builtins.merge lib.builtins
+```
+
+``` unison :hide
+x = 1
+```
+
+``` ucm
+scratch/main> add
+
+  Okay, I'm searching the branch for code that needs to be
+  updated...
+
+  Done.
+
+scratch/main> config.set author.name Unison
+
+scratch/main> history.comment /main: "Initial commit with variable x set to 1"
+
+  Done.
+
+scratch/main> alias.term x y
+
+  Done.
+
+scratch/main> history.comment /main: "Renamed x to y"
+
+  Done.
+
+scratch/main> history
+
+  Note: The most recent namespace hash is immediately below this
+        message.
+
+  ⊙ Unison
+    ┃ Renamed x to y
+
+  ⊙ 1. #05mo7svj4c
+
+    + Adds / updates:
+    
+      y
+    
+    = Copies:
+    
+      Original name New name(s)
+      x             y
+
+  ⊙ Unison
+    ┃ Initial commit with variable x set to 1
+
+  ⊙ 2. #icsccouust
+
+    + Adds / updates:
+    
+      x
+
+  □ 3. #d7vlf0jooh (start of history)
+```
