Finish implementing more commit comments

Author: ChrisPenner

codebase2/codebase-sqlite/U/Codebase/Sqlite/HistoryComment.hs

@@ -2,10 +2,12 @@ module U.Codebase.Sqlite.HistoryComment (HistoryComment (..)) where
 
 import Data.Text (Text)
 
-data HistoryComment id = HistoryComment
+data HistoryComment causal id
+  = HistoryComment
   { author :: Text,
     subject :: Text,
     content :: Text,
+    causal :: causal,
     commentId :: id
   }
   deriving (Show, Eq, Functor)

codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs

@@ -4044,42 +4044,42 @@ saveSquashResult bhId chId =
 
 getLatestCausalComment ::
   CausalHashId ->
-  Transaction (Maybe (HistoryComment HistoryCommentId))
+  Transaction (Maybe (HistoryComment CausalHashId HistoryCommentId))
 getLatestCausalComment causalHashId =
-  queryMaybeRow @(Text, Text, Text, HistoryCommentId)
+  queryMaybeRow @(HistoryCommentId, CausalHashId, Text, Text, Text)
     [sql|
-      SELECT cc.id, ccr.contents
-        FROM change_comments AS cc
-        JOIN change_comment_revisions AS ccr ON cc.id = ccr.comment_id
+      SELECT cc.id, cc.causal_hash_id, cc.author, ccr.subject, ccr.contents
+        FROM history_comments AS cc
+        JOIN history_comment_revisions AS ccr ON cc.id = ccr.comment_id
         WHERE cc.causal_hash_id = :causalHashId
         ORDER BY ccr.created_at DESC
         LIMIT 1
     |]
-    <&> fmap \(author, subject, content, commentId) ->
-      HistoryComment {author, subject, content, commentId}
+    <&> fmap \(commentId, causal, author, subject, content) ->
+      HistoryComment {author, subject, content, commentId, causal}
 
-commentOnCausal :: AuthorName -> CausalHashId -> Text -> Transaction ()
-commentOnCausal authorName causalHashId contents = do
+commentOnCausal :: HistoryComment CausalHashId () -> Transaction ()
+commentOnCausal HistoryComment {author, content, subject, causal = causalHashId} = do
   mayExistingCommentId <-
     queryMaybeCol @HistoryCommentId
       [sql|
       SELECT id
-        FROM change_comments
+        FROM history_comments
         WHERE causal_hash_id = :causalHashId
     |]
   commentId <- case mayExistingCommentId of
     Nothing ->
       queryOneCol @HistoryCommentId
         [sql|
-            INSERT INTO change_comments (author, causal_hash_id, created_at)
-            VALUES (:authorName, :causalHashId, strftime('%s', 'now', 'subsec'))
+            INSERT INTO history_comments (author, causal_hash_id, created_at)
+            VALUES (:author, :causalHashId, strftime('%s', 'now', 'subsec'))
             RETURNING id
           |]
     Just cid -> pure cid
   execute
     [sql|
-      INSERT INTO change_comment_revisions (comment_id, contents, created_at)
-      VALUES (:commentId, :contents, strftime('%s', 'now', 'subsec'))
+      INSERT INTO history_comment_revisions (comment_id, subject, contents, created_at)
+      VALUES (:commentId, :subject, :content, strftime('%s', 'now', 'subsec'))
     |]
 
 getAuthorName :: Transaction (Maybe AuthorName)

codebase2/codebase-sqlite/sql/020-add-history-comments.sql

@@ -4,11 +4,11 @@ CREATE TABLE config (
   value TEXT NOT NULL
 );
 
--- Add tables for storing change comments
+-- Add tables for storing history comments
 -- These tables deliberately contain less information than we'll probably need, with the
 -- plan that we'll migrate them and add new features on the way.
 
-CREATE TABLE change_comments (
+CREATE TABLE history_comments (
   id INTEGER PRIMARY KEY,
   causal_hash_id INTEGER REFERENCES hash(id) NOT NULL,
   author TEXT NOT NULL,
@@ -19,10 +19,11 @@ CREATE TABLE change_comments (
   created_at TEXT NOT NULL
 );
 
-CREATE INDEX change_comments_by_causal_hash_id ON change_comments(causal_hash_id, created_at DESC);
+CREATE INDEX history_comments_by_causal_hash_id ON history_comments(causal_hash_id, created_at DESC);
 
-CREATE TABLE change_comment_revisions (
-  comment_id INTEGER REFERENCES change_comments(id),
+CREATE TABLE history_comment_revisions (
+  comment_id INTEGER REFERENCES history_comments(id),
+  subject TEXT NOT NULL,
   contents TEXT NOT NULL,
 
   -- Remember that SQLITE doesn't have any actual 'time' type,
@@ -35,4 +36,4 @@ CREATE TABLE change_comment_revisions (
   hidden BOOL NOT NULL DEFAULT FALSE
 );
 
-CREATE INDEX change_comment_revisions_by_comment_id_and_created_at ON change_comment_revisions(comment_id, created_at DESC);
+CREATE INDEX history_comment_revisions_by_comment_id_and_created_at ON history_comment_revisions(comment_id, created_at DESC);

unison-cli/src/Unison/Codebase/Editor/HandleInput/History.hs

@@ -2,7 +2,7 @@ module Unison.Codebase.Editor.HandleInput.History (handleHistory) where
 
 import Data.Map qualified as Map
 import U.Codebase.HashTags
-import U.Codebase.Sqlite.HistoryComment (HistoryComment)
+import U.Codebase.Sqlite.HistoryComment (HistoryComment (..))
 import U.Codebase.Sqlite.Queries qualified as Q
 import Unison.Cli.Monad qualified as Cli
 import Unison.Cli.MonadUtils qualified as Cli
@@ -30,7 +30,7 @@ handleHistory resultsCap diffCap from = do
   history <- doHistory schLength 0 branch []
   Cli.respondNumbered history
   where
-    doHistory :: Int -> Int -> Branch IO -> [(CausalHash, Maybe (HistoryComment ()), Names.Diff)] -> Cli.Cli NumberedOutput
+    doHistory :: Int -> Int -> Branch IO -> [(CausalHash, Maybe (HistoryComment () ()), Names.Diff)] -> Cli.Cli NumberedOutput
     doHistory schLength !n b acc =
       if maybe False (n >=) resultsCap
         then do
@@ -49,8 +49,8 @@ handleHistory resultsCap diffCap from = do
             mayComment <- getComment causalHash
             let elem = (causalHash, mayComment, Branch.namesDiff b' b)
             doHistory schLength (n + 1) b' (elem : acc)
-    getComment :: CausalHash -> Cli.Cli (Maybe (HistoryComment ()))
+    getComment :: CausalHash -> Cli.Cli (Maybe (HistoryComment () ()))
     getComment ch = Cli.runTransaction $ do
       causalHashId <- Q.expectCausalHashIdByCausalHash ch
       Q.getLatestCausalComment causalHashId
-        <&> fmap void
+        <&> fmap \hc -> hc {causal = (), commentId = ()}

unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs

@@ -3,6 +3,7 @@ module Unison.Codebase.Editor.HandleInput.HistoryComment (handleHistoryComment)
 import Data.Text qualified as Text
 import Data.Text.IO qualified as Text
 import Text.RawString.QQ (r)
+import U.Codebase.Config qualified as Config
 import U.Codebase.Sqlite.HistoryComment (HistoryComment (..))
 import U.Codebase.Sqlite.Queries qualified as Q
 import Unison.Cli.Monad (Cli)
@@ -54,8 +55,9 @@ handleHistoryComment mayThingToAnnotate = do
   mayNewMessage <- liftIO (editMessage (Just populatedMsg))
   case mayNewMessage of
     Nothing -> Cli.respond $ CommentAborted
-    Just newMessage -> do
-      Cli.runTransaction $ Q.commentOnCausal authorName causalHashId newMessage
+    Just (subject, content) -> do
+      let historyComment = HistoryComment {author = Config.unAuthorName authorName, subject, content, commentId = (), causal = causalHashId}
+      Cli.runTransaction $ Q.commentOnCausal historyComment
       Cli.respond $ CommentedSuccessfully
   where
     commentInstructions =
@@ -84,7 +86,7 @@ getEditorProgram = runMaybeT $ do
 
 -- | Trigger the user's preferred editing workflow to edit a message, using the provided message to pre-populate the editor.
 -- Returns Nothing if the editor was closed with a non-zero exit code, or the message is empty.
-editMessage :: (MonadUnliftIO m) => Maybe Text -> m (Maybe Text)
+editMessage :: (MonadUnliftIO m) => Maybe Text -> m (Maybe (Text, Text))
 editMessage initialMessage = runMaybeT do
   editorProg <- MaybeT getEditorProgram
   MaybeT $ UnliftIO.withSystemTempFile "ucm-history-comment" $ \tempFilePath tempHandle -> runMaybeT do
@@ -103,4 +105,8 @@ editMessage initialMessage = runMaybeT do
             & Text.unlines
             & Text.strip
     guard $ not (Text.null cleanedResult)
-    pure cleanedResult
+    let (subject, contents) =
+          case Text.lines cleanedResult of
+            [] -> ("", "")
+            (s : rest) -> (Text.strip s, Text.strip $ Text.unlines rest)
+    pure (subject, contents)

unison-cli/src/Unison/Codebase/Editor/Output.hs

@@ -131,8 +131,8 @@ data NumberedOutput
     History
       (Maybe Int) -- Amount of history to print
       HashLength
-      [(CausalHash, Maybe (HistoryComment ()), Names.Diff)]
-      (Maybe (HistoryComment ()), HistoryTail) -- 'origin point' of this view of history.
+      [(CausalHash, Maybe (HistoryComment () ()), Names.Diff)]
+      (Maybe (HistoryComment () ()), HistoryTail) -- 'origin point' of this view of history.
   | ListProjects [Sqlite.Project]
   | ListBranches ProjectName [(ProjectBranchName, [(URI, ProjectName, ProjectBranchName)])]
   | AmbiguousSwitch ProjectName (ProjectAndBranch ProjectName ProjectBranchName)

unison-cli/src/Unison/CommandLine/OutputMessages.hs

@@ -302,15 +302,20 @@ notifyNumbered = \case
       reversedHistory = reverse history
       showNum :: Int -> Pretty
       showNum n = P.shown n <> ". "
-      displayComment :: Bool -> Maybe (HistoryComment ()) -> [Pretty]
+      displayComment :: Bool -> Maybe (HistoryComment () ()) -> [Pretty]
       displayComment prefixSpacer mayComment = case mayComment of
         Nothing -> []
         Just (HistoryComment {author, subject, content}) ->
           Monoid.whenM prefixSpacer [""]
-            <> [ P.bold (P.text author),
-                 P.indent (P.blue (P.text "> ")) (P.yellow $ P.text subject),
-                 P.indent (P.blue (P.text "> ")) (P.text content),
-                 ""
+            <> [P.bold (P.text $ "⊙ " <> author <> " 💬")]
+            <> [ P.indent (P.blue "  > ") (P.yellow $ P.text subject)
+               ]
+            <> Monoid.whenM
+              (not (Text.null content))
+              [ (P.blue "  > "),
+                P.indent (P.blue "  > ") (P.text content)
+              ]
+            <> [ ""
                ]
       handleTail :: Int -> (Pretty, [CausalHash])
       handleTail n = case tail of
@@ -913,20 +918,19 @@ notifyUser dir issueFn = \case
       --       defs in the codebase.  In some cases it's fine for bindings to
       --       shadow codebase names, but you don't want it to capture them in
       --       the decompiled output.
-
         let prettyBindings =
               P.bracket . P.lines $
                 P.wrap "The watch expression(s) reference these definitions:"
                   : ""
                   : [ P.syntaxToColor $ TermPrinter.prettyBinding ppe (HQ.unsafeFromVar v) b
-                      | (v, b) <- bindings
+                    | (v, b) <- bindings
                     ]
             prettyWatches =
               P.sep
                 "\n\n"
                 [ watchPrinter fileContents ppe ann kind evald isCacheHit
-                  | (ann, kind, evald, isCacheHit) <-
-                      sortOn (\(a, _, _, _) -> a) . toList $ watches
+                | (ann, kind, evald, isCacheHit) <-
+                    sortOn (\(a, _, _, _) -> a) . toList $ watches
                 ]
          in -- todo: use P.nonempty
             pure $
@@ -3584,13 +3588,13 @@ listOfDefinitions' fscope ppe detailed results =
     --   where sigs0 = (\(name, _, typ) -> (name, typ)) <$> terms
     termsWithMissingTypes =
       [ (name, Reference.idToShortHash r)
-        | SR'.Tm name Nothing (Referent.Ref (Reference.DerivedId r)) _ <- results
+      | SR'.Tm name Nothing (Referent.Ref (Reference.DerivedId r)) _ <- results
       ]
     missingTypes =
       nubOrdOn snd $
         [(name, r) | SR'.Tp name (MissingObject r) _ _ <- results]
           <> [ (name, Reference.toShortHash r)
-               | SR'.Tm name Nothing (Referent.toTypeReference -> Just r) _ <- results
+             | SR'.Tm name Nothing (Referent.toTypeReference -> Just r) _ <- results
              ]
     missingBuiltins =
       results >>= \case
@@ -3744,7 +3748,7 @@ prettyDiff diff =
                     P.column2 $
                       (P.hiBlack "Original name", P.hiBlack "New name(s)")
                         : [ (prettyName n, P.sep " " (prettyName <$> ns))
-                            | (n, ns) <- copied
+                          | (n, ns) <- copied
                           ]
                 ]
             else mempty