Merge pull request #5895 from unisonweb/cp/change-comments

Change Comments

Author: ChrisPenner

codebase2/codebase-sqlite/U/Codebase/Config.hs

@@ -0,0 +1,49 @@
+module U.Codebase.Config
+  ( AuthorName,
+    ConfigKey (..),
+    allKeys,
+    mkAuthorName,
+    unAuthorName,
+    keyToText,
+    keyFromText,
+    allKeysText,
+  )
+where
+
+import Data.Text qualified as Text
+import Unison.Prelude
+import Unison.Sqlite qualified as Sqlite
+
+data ConfigKey = AuthorNameKey
+  deriving stock (Eq, Enum, Bounded)
+
+instance Show ConfigKey where
+  show k = Text.unpack . keyToText $ k
+
+allKeys :: [ConfigKey]
+allKeys = [minBound .. maxBound]
+
+allKeysText :: [Text]
+allKeysText = keyToText <$> allKeys
+
+keyToText :: ConfigKey -> Text
+keyToText = \case
+  AuthorNameKey -> "author.name"
+
+keyFromText :: Text -> Maybe ConfigKey
+keyFromText t = case t of
+  "author.name" -> Just AuthorNameKey
+  _ -> Nothing
+
+instance Sqlite.ToField ConfigKey where
+  toField AuthorNameKey = Sqlite.toField (keyToText AuthorNameKey)
+
+mkAuthorName :: Text -> Either Text AuthorName
+mkAuthorName name
+  | Text.null (Text.strip name) = Left "Author name cannot be empty."
+  | Text.length name > 100 = Left "Author name cannot exceed 100 characters."
+  | otherwise = Right (AuthorName name)
+
+newtype AuthorName = AuthorName {unAuthorName :: Text}
+  deriving stock (Eq, Show)
+  deriving newtype (Sqlite.ToField, Sqlite.FromField)

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

@@ -66,3 +66,7 @@ instance Show BranchHashId where
 
 instance Show CausalHashId where
   show h = "CausalHashId (" ++ show (unCausalHashId h) ++ ")"
+
+newtype HistoryCommentId = HistoryCommentId Word64
+  deriving (Eq, Ord, Show)
+  deriving (Num, Real, Enum, Integral, Bits, FromField, ToField) via Word64

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

@@ -0,0 +1,12 @@
+module U.Codebase.Sqlite.HistoryComment (HistoryComment (..)) where
+
+import Data.Text (Text)
+
+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

@@ -233,6 +233,10 @@ module U.Codebase.Sqlite.Queries
     expectCurrentProjectPath,
     setCurrentProjectPath,
 
+    -- * History Comments
+    commentOnCausal,
+    getLatestCausalComment,
+
     -- * migrations
     runCreateSql,
     addTempEntityTables,
@@ -254,6 +258,7 @@ module U.Codebase.Sqlite.Queries
     addUpdateBranchTable,
     addDerivedDependentsByDependencyIndex,
     addUpgradeBranchTable,
+    addHistoryComments,
 
     -- ** schema version
     currentSchemaVersion,
@@ -284,6 +289,12 @@ module U.Codebase.Sqlite.Queries
     x2cDecl,
     checkBranchExistsForCausalHash,
 
+    -- * Config
+    getAuthorName,
+    setAuthorName,
+    getConfigValue,
+    setConfigValue,
+
     -- * Types
     TextPathSegments,
     JsonParseFailure (..),
@@ -319,6 +330,8 @@ import Data.Time qualified as Time
 import Data.Vector qualified as Vector
 import Network.URI (URI)
 import U.Codebase.Branch.Type (NamespaceStats (..))
+import U.Codebase.Config (AuthorName, ConfigKey)
+import U.Codebase.Config qualified as Config
 import U.Codebase.Decl qualified as C
 import U.Codebase.Decl qualified as C.Decl
 import U.Codebase.HashTags (BranchHash (..), CausalHash (..), PatchHash (..))
@@ -336,6 +349,7 @@ import U.Codebase.Sqlite.DbId
     CausalHashId (..),
     HashId (..),
     HashVersion,
+    HistoryCommentId,
     ObjectId (..),
     PatchObjectId (..),
     ProjectBranchId (..),
@@ -351,6 +365,7 @@ import U.Codebase.Sqlite.Decode
 import U.Codebase.Sqlite.Entity (SyncEntity)
 import U.Codebase.Sqlite.Entity qualified as Entity
 import U.Codebase.Sqlite.HashHandle (HashHandle (..))
+import U.Codebase.Sqlite.HistoryComment (HistoryComment (..))
 import U.Codebase.Sqlite.LocalIds
   ( LocalDefnId (..),
     LocalIds,
@@ -413,7 +428,7 @@ type TextPathSegments = [Text]
 -- * main squeeze
 
 currentSchemaVersion :: SchemaVersion
-currentSchemaVersion = 22
+currentSchemaVersion = 23
 
 runCreateSql :: Transaction ()
 runCreateSql =
@@ -499,6 +514,10 @@ addUpgradeBranchTable :: Transaction ()
 addUpgradeBranchTable =
   executeStatements $(embedProjectStringFile "sql/019-add-upgrade-branch-table.sql")
 
+addHistoryComments :: Transaction ()
+addHistoryComments =
+  executeStatements $(embedProjectStringFile "sql/020-add-history-comments.sql")
+
 schemaVersion :: Transaction SchemaVersion
 schemaVersion =
   queryOneCol
@@ -4022,3 +4041,73 @@ saveSquashResult bhId chId =
         )
       ON CONFLICT DO NOTHING
     |]
+
+getLatestCausalComment ::
+  CausalHashId ->
+  Transaction (Maybe (HistoryComment CausalHashId HistoryCommentId))
+getLatestCausalComment causalHashId =
+  queryMaybeRow @(HistoryCommentId, CausalHashId, Text, Text, Text)
+    [sql|
+      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 \(commentId, causal, author, subject, content) ->
+      HistoryComment {author, subject, content, commentId, causal}
+
+commentOnCausal :: HistoryComment CausalHashId () -> Transaction ()
+commentOnCausal HistoryComment {author, content, subject, causal = causalHashId} = do
+  mayExistingCommentId <-
+    queryMaybeCol @HistoryCommentId
+      [sql|
+      SELECT id
+        FROM history_comments
+        WHERE causal_hash_id = :causalHashId
+    |]
+  commentId <- case mayExistingCommentId of
+    Nothing ->
+      queryOneCol @HistoryCommentId
+        [sql|
+            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 history_comment_revisions (comment_id, subject, contents, created_at)
+      VALUES (:commentId, :subject, :content, strftime('%s', 'now', 'subsec'))
+    |]
+
+getAuthorName :: Transaction (Maybe AuthorName)
+getAuthorName = do
+  r <- getConfigValue Config.AuthorNameKey <&> fmap Config.mkAuthorName
+  case r of
+    Just (Left err) -> error $ "getAuthorName: " <> Text.unpack err
+    Just (Right authorName) -> pure (Just authorName)
+    Nothing -> pure Nothing
+
+setAuthorName :: AuthorName -> Transaction ()
+setAuthorName authorName =
+  setConfigValue Config.AuthorNameKey (Config.unAuthorName authorName)
+
+setConfigValue :: ConfigKey -> Text -> Transaction ()
+setConfigValue key value =
+  execute
+    [sql|
+      INSERT INTO config (key, value)
+      VALUES (:key, :value)
+      ON CONFLICT (key) DO UPDATE SET value = excluded.value
+    |]
+
+getConfigValue :: ConfigKey -> Transaction (Maybe Text)
+getConfigValue key =
+  queryMaybeCol
+    [sql|
+      SELECT value
+      FROM config
+      WHERE key = :key
+    |]

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

@@ -0,0 +1,40 @@
+-- A simple table for storing user preferences as key/value pairs.
+CREATE TABLE config (
+  key TEXT NOT NULL PRIMARY KEY,
+  value TEXT NOT NULL
+);
+
+-- 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 history_comments (
+  id INTEGER PRIMARY KEY,
+  causal_hash_id INTEGER REFERENCES hash(id) NOT NULL,
+  author TEXT NOT NULL,
+
+  -- Remember that SQLITE doesn't have any actual 'time' type,
+  -- This column contains float values constructed
+  -- using strftime('%s', 'now', 'subsec')
+  created_at TEXT NOT NULL
+);
+
+CREATE INDEX history_comments_by_causal_hash_id ON history_comments(causal_hash_id, created_at DESC);
+
+CREATE TABLE history_comment_revisions (
+  id INTEGER PRIMARY KEY,
+  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,
+  -- This column contains float values constructed
+  -- using strftime('%s', 'now', 'subsec')
+  created_at TEXT NOT NULL,
+
+  -- - In a distributed system you really can’t ever truly delete comments,
+  -- but you can ask to hide them.
+  hidden BOOL NOT NULL DEFAULT FALSE
+);
+
+CREATE INDEX history_comment_revisions_by_comment_id_and_created_at ON history_comment_revisions(comment_id, created_at DESC);

codebase2/codebase-sqlite/unison-codebase-sqlite.cabal

@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.36.0.
+-- This file has been generated from package.yaml by hpack version 0.38.1.
 --
 -- see: https://github.com/sol/hpack
 
@@ -29,6 +29,7 @@ extra-source-files:
     sql/017-add-update-branch-table.sql
     sql/018-add-derived-dependents-by-dependency-index.sql
     sql/019-add-upgrade-branch-table.sql
+    sql/020-add-history-comments.sql
     sql/create.sql
 
 source-repository head
@@ -39,6 +40,7 @@ library
   exposed-modules:
       U.Codebase.Branch
       U.Codebase.Causal.Squash
+      U.Codebase.Config
       U.Codebase.Sqlite.Branch.Diff
       U.Codebase.Sqlite.Branch.Format
       U.Codebase.Sqlite.Branch.Full
@@ -48,6 +50,7 @@ library
       U.Codebase.Sqlite.Decode
       U.Codebase.Sqlite.Entity
       U.Codebase.Sqlite.HashHandle
+      U.Codebase.Sqlite.HistoryComment
       U.Codebase.Sqlite.LocalIds
       U.Codebase.Sqlite.LocalizeObject
       U.Codebase.Sqlite.ObjectType

parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs

@@ -89,7 +89,8 @@ migrations regionVar getDeclType termBuffer declBuffer rootCodebasePath =
       sqlMigration 19 Q.addMergeBranchTables,
       sqlMigration 20 Q.addUpdateBranchTable,
       sqlMigration 21 Q.addDerivedDependentsByDependencyIndex,
-      sqlMigration 22 Q.addUpgradeBranchTable
+      sqlMigration 22 Q.addUpgradeBranchTable,
+      sqlMigration 23 Q.addHistoryComments
     ]
   where
     runT :: Sqlite.Transaction () -> Sqlite.Connection -> IO ()

parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs

@@ -85,6 +85,7 @@ createSchema = do
   Q.addUpdateBranchTable
   Q.addDerivedDependentsByDependencyIndex
   Q.addUpgradeBranchTable
+  Q.addHistoryComments
   (_, emptyCausalHashId) <- emptyCausalHash
   (_, ProjectBranchRow {projectId, branchId}) <-
     insertProjectAndBranch scratchProjectName scratchBranchName emptyCausalHashId

parser-typechecker/unison-parser-typechecker.cabal

@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.36.0.
+-- This file has been generated from package.yaml by hpack version 0.38.1.
 --
 -- see: https://github.com/sol/hpack
 

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

@@ -50,6 +50,7 @@ import Unison.Codebase.Editor.HandleInput.BranchRename (handleBranchRename)
 import Unison.Codebase.Editor.HandleInput.BranchSquash (handleBranchSquash)
 import Unison.Codebase.Editor.HandleInput.Branches (handleBranches)
 import Unison.Codebase.Editor.HandleInput.Cancel (handleCancel)
+import Unison.Codebase.Editor.HandleInput.Config (handleConfigGet, handleConfigSet)
 import Unison.Codebase.Editor.HandleInput.DebugDefinition qualified as DebugDefinition
 import Unison.Codebase.Editor.HandleInput.DebugFoldRanges qualified as DebugFoldRanges
 import Unison.Codebase.Editor.HandleInput.DebugSynhashTerm (handleDebugSynhashTerm)
@@ -64,6 +65,8 @@ import Unison.Codebase.Editor.HandleInput.EditNamespace (handleEditNamespace)
 import Unison.Codebase.Editor.HandleInput.FindAndReplace (handleStructuredFindI, handleStructuredFindReplaceI, handleTextFindI)
 import Unison.Codebase.Editor.HandleInput.FormatFile qualified as Format
 import Unison.Codebase.Editor.HandleInput.Global qualified as Global
+import Unison.Codebase.Editor.HandleInput.History (handleHistory)
+import Unison.Codebase.Editor.HandleInput.HistoryComment (handleHistoryComment)
 import Unison.Codebase.Editor.HandleInput.InstallLib (handleInstallLib, handleInstallLocalLib)
 import Unison.Codebase.Editor.HandleInput.LSPDebug qualified as LSPDebug
 import Unison.Codebase.Editor.HandleInput.Load (EvalMode (Sandboxed), evalUnisonFile, handleLoad, loadUnisonFile)
@@ -297,29 +300,9 @@ loop e = do
           success <- Cli.popd
           when (not success) (Cli.respond StartOfCurrentPathHistory)
         HistoryI resultsCap diffCap from -> do
-          branch <-
-            case from of
-              BranchAtSCH hash -> Cli.resolveShortCausalHash hash
-              BranchAtPath path' -> do
-                pp <- Cli.resolvePath' path'
-                Cli.getBranchFromProjectPath pp
-              BranchAtProjectPath pp -> Cli.getBranchFromProjectPath pp
-          schLength <- Cli.runTransaction Codebase.branchHashLength
-          history <- liftIO (doHistory schLength 0 branch [])
-          Cli.respondNumbered history
-          where
-            doHistory :: Int -> Int -> Branch IO -> [(CausalHash, Names.Diff)] -> IO NumberedOutput
-            doHistory schLength !n b acc =
-              if maybe False (n >=) resultsCap
-                then pure (History diffCap schLength acc (PageEnd (Branch.headHash b) n))
-                else case Branch._history b of
-                  Causal.One {} -> pure (History diffCap schLength acc (EndOfLog $ Branch.headHash b))
-                  Causal.Merge _ _ _ tails ->
-                    pure (History diffCap schLength acc (MergeTail (Branch.headHash b) $ Map.keys tails))
-                  Causal.Cons _ _ _ tail -> do
-                    b' <- fmap Branch.Branch $ snd tail
-                    let elem = (Branch.headHash b, Branch.namesDiff b' b)
-                    doHistory schLength (n + 1) b' (elem : acc)
+          handleHistory resultsCap diffCap from
+        HistoryCommentI toAnnotate -> do
+          handleHistoryComment toAnnotate
         UndoI -> do
           rootBranch <- Cli.getCurrentProjectRoot
           (_, prev) <-
@@ -736,6 +719,8 @@ loop e = do
         BranchRenameI name -> handleBranchRename name
         BranchesI name -> handleBranches name
         CloneI remoteNames localNames -> handleClone remoteNames localNames
+        ConfigGetI key -> handleConfigGet key
+        ConfigSetI key value -> handleConfigSet key value
         BranchSquashI branchToSquash destBranch -> handleBranchSquash branchToSquash destBranch
         ReleaseDraftI semver -> handleReleaseDraft semver
         UpgradeI libs -> handleUpgrade libs
@@ -817,6 +802,8 @@ inputDescription input =
     BranchesI {} -> wat
     ClearI {} -> wat
     CloneI {} -> wat
+    ConfigSetI {} -> wat
+    ConfigGetI {} -> wat
     CreateMessage {} -> wat
     DebugClearWatchI {} -> wat
     DebugDoctorI {} -> wat
@@ -842,6 +829,7 @@ inputDescription input =
     HistoryI {} -> wat
     IOTestAllI -> wat
     IOTestI {} -> wat
+    HistoryCommentI {} -> wat
     LibInstallI {} -> wat
     LibInstallLocalI {} -> wat
     ListDependenciesI {} -> wat