Deprecate root reflog behaviour in favour of project/branch reflogs

sellout · Jul 3, 2024 · a7820fe · a7820fe
1 parent 1dab376
commit a7820fe
Show file tree

Hide file tree

Showing 10 changed files with 119 additions and 80 deletions.
diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs
@@ -101,8 +101,7 @@ module U.Codebase.Sqlite.Operations
     expectProjectBranchHead,
 
     -- * reflog
-    getReflog,
-    appendReflog,
+    getDeprecatedRootReflog,
     getProjectReflog,
     appendProjectReflog,
 
@@ -1486,16 +1485,11 @@ namespaceStatsForDbBranch = \case
         expectNamespaceStatsByHashId bhId
 
 -- | Gets the specified number of reflog entries in chronological order, most recent first.
-getReflog :: Int -> Transaction [Reflog.Entry CausalHash Text]
-getReflog numEntries = do
-  entries <- Q.getReflog numEntries
+getDeprecatedRootReflog :: Int -> Transaction [Reflog.Entry CausalHash Text]
+getDeprecatedRootReflog numEntries = do
+  entries <- Q.getDeprecatedRootReflog numEntries
   traverse (bitraverse Q.expectCausalHash pure) entries
 
-appendReflog :: Reflog.Entry CausalHash Text -> Transaction ()
-appendReflog entry = do
-  dbEntry <- (bitraverse Q.saveCausalHash pure) entry
-  Q.appendReflog dbEntry
-
 -- | Gets the specified number of reflog entries in chronological order, most recent first.
 getProjectReflog :: Int -> Transaction [ProjectReflog.Entry CausalHash]
 getProjectReflog numEntries = do

diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs
@@ -211,8 +211,7 @@ module U.Codebase.Sqlite.Queries
     fuzzySearchTypes,
 
     -- * Reflog
-    appendReflog,
-    getReflog,
+    getDeprecatedRootReflog,
     appendProjectReflog,
     getProjectReflog,
 
@@ -3472,16 +3471,8 @@ loadNamespaceStatsByHashId bhId = do
       WHERE namespace_hash_id = :bhId
     |]
 
-appendReflog :: Reflog.Entry CausalHashId Text -> Transaction ()
-appendReflog entry =
-  execute
-    [sql|
-      INSERT INTO reflog (time, from_root_causal_id, to_root_causal_id, reason)
-      VALUES (@entry, @, @, @)
-    |]
-
-getReflog :: Int -> Transaction [Reflog.Entry CausalHashId Text]
-getReflog numEntries =
+getDeprecatedRootReflog :: Int -> Transaction [Reflog.Entry CausalHashId Text]
+getDeprecatedRootReflog numEntries =
   queryListRow
     [sql|
       SELECT time, from_root_causal_id, to_root_causal_id, reason

diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs
@@ -75,7 +75,7 @@ module Unison.Codebase
     Queries.clearWatches,
 
     -- * Reflog
-    Operations.getReflog,
+    Operations.getDeprecatedRootReflog,
 
     -- * Unambiguous hash length
     SqliteCodebase.Operations.hashLength,

diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema5To6.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema5To6.hs
@@ -1,11 +1,14 @@
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+
 module Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema5To6 (migrateSchema5To6) where
 
+import Data.Bitraversable
 import Data.Text qualified as Text
 import Data.Time (NominalDiffTime, UTCTime, addUTCTime, getCurrentTime)
 import System.FilePath ((</>))
 import U.Codebase.HashTags (CausalHash (CausalHash))
 import U.Codebase.Reflog qualified as Reflog
-import U.Codebase.Sqlite.Operations qualified as Ops
 import U.Codebase.Sqlite.Queries qualified as Q
 import Unison.Codebase (CodebasePath)
 import Unison.Hash qualified as Hash
@@ -30,12 +33,21 @@ migrateCurrentReflog codebasePath = do
     -- so we check first to avoid triggering a bad foreign key constraint.
     haveFrom <- isJust <$> Q.loadCausalByCausalHash (Reflog.fromRootCausalHash oldEntry)
     haveTo <- isJust <$> Q.loadCausalByCausalHash (Reflog.toRootCausalHash oldEntry)
-    when (haveFrom && haveTo) $ Ops.appendReflog oldEntry
+    when (haveFrom && haveTo) $ appendReflog oldEntry
   Sqlite.unsafeIO . putStrLn $ "I migrated old reflog entries from " <> reflogPath <> " into the codebase; you may delete that file now if you like."
   where
     reflogPath :: FilePath
     reflogPath = codebasePath </> "reflog"
 
+    appendReflog :: Reflog.Entry CausalHash Text -> Sqlite.Transaction ()
+    appendReflog entry = do
+      dbEntry <- (bitraverse Q.saveCausalHash pure) entry
+      Sqlite.execute
+        [Sqlite.sql|
+          INSERT INTO reflog (time, from_root_causal_id, to_root_causal_id, reason)
+          VALUES (@dbEntry, @, @, @)
+        |]
+
 oldReflogEntries :: CodebasePath -> UTCTime -> IO [Reflog.Entry CausalHash Text]
 oldReflogEntries reflogPath now =
   ( do

diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
@@ -210,11 +210,11 @@ loop e = do
                       ]
             CreateMessage pretty ->
               Cli.respond $ PrintMessage pretty
-            ShowReflogI -> do
+            ShowRootReflogI -> do
               let numEntriesToShow = 500
               (schLength, entries) <-
                 Cli.runTransaction $
-                  (,) <$> Codebase.branchHashLength <*> Codebase.getReflog numEntriesToShow
+                  (,) <$> Codebase.branchHashLength <*> Codebase.getDeprecatedRootReflog numEntriesToShow
               let moreEntriesToLoad = length entries == numEntriesToShow
               let expandedEntries = List.unfoldr expandEntries (entries, Nothing, moreEntriesToLoad)
               let (shortEntries, numberedEntries) =
@@ -1044,7 +1044,16 @@ inputDescription input =
     ShowDefinitionI {} -> wat
     EditNamespaceI paths ->
       pure $ Text.unwords ("edit.namespace" : (Path.toText <$> paths))
-    ShowReflogI {} -> wat
+    ShowRootReflogI {} -> pure "deprecated.root-reflog"
+    ShowProjectReflog mayProjName -> do
+      case mayProjName of
+        Nothing -> pure "project.reflog"
+        Just projName -> pure $ "project.reflog" <> into @Text projName
+    ShowProjectBranchReflog mayProjBranch -> do
+      case mayProjBranch of
+        Nothing -> pure "branch.reflog"
+        Just (PP.ProjectAndBranch Nothing branchName) -> pure $ "branch.reflog" <> into @Text branchName
+        Just (PP.ProjectAndBranch (Just projName) branchName) -> pure $ "branch.reflog" <> into @Text (PP.ProjectAndBranch projName branchName)
     SwitchBranchI {} -> wat
     TestI {} -> wat
     TodoI {} -> wat

diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs
@@ -191,7 +191,9 @@ data Input
   | StructuredFindReplaceI (HQ.HashQualified Name) -- sfind.replace rewriteQuery
   | -- Show provided definitions.
     ShowDefinitionI OutputLocation ShowDefinitionScope (NonEmpty (HQ.HashQualified Name))
-  | ShowReflogI
+  | ShowRootReflogI {- Deprecated -}
+  | ShowProjectReflog (Maybe ProjectName)
+  | ShowProjectBranchReflog (Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
   | UpdateBuiltinsI
   | MergeBuiltinsI (Maybe Path)
   | MergeIOBuiltinsI (Maybe Path)

diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs
@@ -121,7 +121,9 @@ module Unison.CommandLine.InputPatterns
     upgradeCommitInputPattern,
     view,
     viewGlobal,
-    viewReflog,
+    deprecatedViewRootReflog,
+    branchReflog,
+    projectReflog,
 
     -- * Misc
     formatStructuredArgument,
@@ -2246,19 +2248,58 @@ mergeOldPreviewInputPattern =
           branchInclusion = AllBranches
         }
 
-viewReflog :: InputPattern
-viewReflog =
+deprecatedViewRootReflog :: InputPattern
+deprecatedViewRootReflog =
   InputPattern
-    "reflog"
+    "deprecated.root-reflog"
     []
     I.Visible
     []
-    "`reflog` lists the changes that have affected the root namespace"
+    ( "`deprecated.root-reflog` lists the changes that have affected the root namespace. This has been deprecated in favor of "
+        <> makeExample branchReflog []
+        <> " which shows the reflog for the current project."
+    )
     ( \case
-        [] -> pure Input.ShowReflogI
+        [] -> pure Input.ShowRootReflogI
         _ ->
           Left . warn . P.string $
-            I.patternName viewReflog ++ " doesn't take any arguments."
+            I.patternName deprecatedViewRootReflog ++ " doesn't take any arguments."
+    )
+
+branchReflog :: InputPattern
+branchReflog =
+  InputPattern
+    "branch.reflog"
+    ["reflog.branch", "reflog"]
+    I.Visible
+    []
+    ( P.lines
+        [ "`branch.reflog` lists all the changes that have affected the current branch.",
+          "`branch.reflog /mybranch` lists all the changes that have affected /mybranch."
+        ]
+    )
+    ( \case
+        [] -> pure $ Input.ShowProjectBranchReflog Nothing
+        [branchRef] -> Input.ShowProjectBranchReflog <$> (Just <$> handleMaybeProjectBranchArg branchRef)
+        _ -> Left (I.help branchReflog)
+    )
+
+projectReflog :: InputPattern
+projectReflog =
+  InputPattern
+    "project.reflog"
+    ["reflog.project"]
+    I.Visible
+    []
+    ( P.lines
+        [ "`project.reflog` lists all the changes that have affected any branches in the current project.",
+          "`project.reflog myproject` lists all the changes that have affected any branches in myproject."
+        ]
+    )
+    ( \case
+        [] -> pure $ Input.ShowProjectReflog Nothing
+        [projectRef] -> Input.ShowProjectReflog <$> (Just <$> handleProjectArg projectRef)
+        _ -> Left (I.help projectReflog)
     )
 
 edit :: InputPattern
@@ -3421,7 +3462,9 @@ validInputs =
       upgradeCommitInputPattern,
       view,
       viewGlobal,
-      viewReflog
+      deprecatedViewRootReflog,
+      branchReflog,
+      projectReflog
     ]
 
 -- | A map of all command patterns by pattern name or alias.

diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs
@@ -222,8 +222,8 @@ notifyNumbered = \case
                   <> "to run the tests."
                   <> "Or you can use"
                   <> IP.makeExample' IP.undo
-                  <> " or"
-                  <> IP.makeExample' IP.viewReflog
+                  <> " or use a hash from "
+                  <> IP.makeExample' IP.branchReflog
                   <> " to undo the results of this merge."
             ]
       )
@@ -249,8 +249,8 @@ notifyNumbered = \case
                   <> "to run the tests."
                   <> "Or you can use"
                   <> IP.makeExample' IP.undo
-                  <> " or"
-                  <> IP.makeExample' IP.viewReflog
+                  <> " or use a hash from "
+                  <> IP.makeExample' IP.branchReflog
                   <> " to undo the results of this merge."
             ]
       )
@@ -561,8 +561,8 @@ undoTip =
   tip $
     "You can use"
       <> IP.makeExample' IP.undo
-      <> "or"
-      <> IP.makeExample' IP.viewReflog
+      <> " or use a hash from "
+      <> IP.makeExample' IP.branchReflog
       <> "to undo this change."
 
 notifyUser :: FilePath -> Output -> IO Pretty

diff --git a/unison-src/transcripts/reflog.md b/unison-src/transcripts/reflog.md
@@ -1,5 +1,5 @@
 ```ucm:hide
-.> builtins.merge
+scratch/main> builtins.merge lib.builtins
 ```
 
 First we make two changes to the codebase, so that there's more than one line
@@ -9,23 +9,23 @@ for the `reflog` command to display:
 x = 1
 ```
 ```ucm
-.> add
+scratch/main> add
 ```
 ```unison
 y = 2
 ```
 ```ucm
-.> add
-.> view y
+scratch/main> add
+scratch/main> view y
 ```
 ```ucm
-.> reflog
+scratch/main> reflog
 ```
 
 If we `reset-root` to its previous value, `y` disappears.
 ```ucm
-.> reset-root 2
+scratch/main> reset-root 2
 ```
 ```ucm:error
-.> view y
+scratch/main> view y
 ```
diff --git a/unison-src/transcripts/reflog.output.md b/unison-src/transcripts/reflog.output.md
@@ -19,7 +19,7 @@ x = 1
 
 ```
 ```ucm
-.> add
+scratch/main> add
 
   ⍟ I've added these definitions:
   
@@ -44,55 +44,43 @@ y = 2
 
 ```
 ```ucm
-.> add
+scratch/main> add
 
   ⍟ I've added these definitions:
   
     y : Nat
 
-.> view y
+scratch/main> view y
 
   y : Nat
   y = 2
 
 ```
 ```ucm
-.> reflog
+scratch/main> reflog
 
-  Here is a log of the root namespace hashes, starting with the
-  most recent, along with the command that got us there. Try:
-  
-    `fork 2 .old`             
-    `fork #p611n6o5ve .old`   to make an old namespace
-                              accessible again,
-                              
-    `reset-root #p611n6o5ve`  to reset the root namespace and
-                              its history to that of the
-                              specified namespace.
-  
-       When   Root Hash     Action
-  1.   now    #rmu2vgm86a   add
-  2.   now    #p611n6o5ve   add
-  3.   now    #4bigcpnl7t   builtins.merge
-  4.          #sg60bvjo91   history starts here
+  ⚠️
   
-  Tip: Use `diff.namespace 1 7` to compare namespaces between
-       two points in history.
+  The reflog is empty
 
 ```
 If we `reset-root` to its previous value, `y` disappears.
 ```ucm
-.> reset-root 2
-
-  Done.
+scratch/main> reset-root 2
 
 ```
 ```ucm
-.> view y
+scratch/main> view y
 
-  ⚠️
-  
-  The following names were not found in the codebase. Check your spelling.
-    y
+  y : Nat
+  y = 2
+
+```
 
 ```
+
+
+
+🛑
+
+The transcript was expecting an error in the stanza above, but did not encounter one.