mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 02:25:39 +03:00
Add reflog.global command
This commit is contained in:
parent
2db50ad848
commit
31874bd199
@ -114,7 +114,6 @@ import Unison.CommandLine.InputPatterns qualified as IP
|
||||
import Unison.CommandLine.InputPatterns qualified as InputPatterns
|
||||
import Unison.ConstructorReference (GConstructorReference (..))
|
||||
import Unison.DataDeclaration qualified as DD
|
||||
import Unison.Hash qualified as Hash
|
||||
import Unison.HashQualified qualified as HQ
|
||||
import Unison.HashQualified' qualified as HQ'
|
||||
import Unison.LabeledDependency (LabeledDependency)
|
||||
@ -250,8 +249,6 @@ loop e = do
|
||||
Reflogs.showGlobalReflog
|
||||
ShowProjectReflogI mayProj -> do
|
||||
Reflogs.showProjectReflog mayProj
|
||||
ShowProjectReflogI mayProj -> do
|
||||
Reflogs.showProjectReflog mayProj
|
||||
ResetI newRoot mtarget -> do
|
||||
newRoot <-
|
||||
case newRoot of
|
||||
@ -1054,6 +1051,7 @@ inputDescription input =
|
||||
EditNamespaceI paths ->
|
||||
pure $ Text.unwords ("edit.namespace" : (Path.toText <$> paths))
|
||||
ShowRootReflogI {} -> pure "deprecated.root-reflog"
|
||||
ShowGlobalReflogI {} -> pure "reflog.global"
|
||||
ShowProjectReflogI mayProjName -> do
|
||||
case mayProjName of
|
||||
Nothing -> pure "project.reflog"
|
||||
|
@ -1,75 +1,56 @@
|
||||
-- | Helpers for working with various kinds of reflogs.
|
||||
module Unison.Codebase.Editor.HandleInput.Reflogs
|
||||
( showProjectBranchReflog,
|
||||
showProjectReflog,
|
||||
showGlobalReflog,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Arrow ((&&&))
|
||||
import Data.Time (UTCTime)
|
||||
import Data.Time (getCurrentTime)
|
||||
import U.Codebase.HashTags (CausalHash)
|
||||
import U.Codebase.Reflog qualified as Reflog
|
||||
import U.Codebase.Sqlite.Project (Project)
|
||||
import U.Codebase.Sqlite.ProjectBranch (ProjectBranch)
|
||||
import U.Codebase.Sqlite.ProjectReflog qualified as ProjectReflog
|
||||
import Unison.Cli.Monad (Cli)
|
||||
import Unison.Cli.Monad qualified as Cli
|
||||
import Unison.Cli.MonadUtils qualified as Cli
|
||||
import Unison.Cli.ProjectUtils qualified as ProjectUtils
|
||||
import Unison.Codebase qualified as Codebase
|
||||
import Unison.Codebase.Editor.Output (Output (..))
|
||||
import Unison.Codebase.Editor.Output qualified as Output
|
||||
import Unison.Codebase.Editor.StructuredArgument qualified as SA
|
||||
import Unison.Codebase.ShortCausalHash qualified as SCH
|
||||
import Unison.Core.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName)
|
||||
import Unison.Prelude
|
||||
|
||||
-- showRootReflog :: Cli ()
|
||||
-- showRootReflog = do
|
||||
-- let numEntriesToShow = 500
|
||||
-- (schLength, entries) <-
|
||||
-- Cli.runTransaction $
|
||||
-- (,) <$> Codebase.branchHashLength <*> Codebase.getDeprecatedRootReflog numEntriesToShow
|
||||
-- let moreEntriesToLoad = length entries == numEntriesToShow
|
||||
-- let expandedEntries = List.unfoldr expandEntries (entries, Nothing, moreEntriesToLoad)
|
||||
-- let (shortEntries, numberedEntries) =
|
||||
-- unzip $
|
||||
-- expandedEntries <&> \(time, hash, reason) ->
|
||||
-- let (exp, sa) = (SCH.fromHash schLength &&& SA.Namespace) hash
|
||||
-- in ((time, exp, reason), sa)
|
||||
-- Cli.setNumberedArgs numberedEntries
|
||||
-- Cli.respond $ ShowReflog shortEntries
|
||||
-- where
|
||||
-- expandEntries ::
|
||||
-- ([Reflog.Entry CausalHash Text], Maybe CausalHash, Bool) ->
|
||||
-- Maybe ((Maybe UTCTime, CausalHash, Text), ([Reflog.Entry CausalHash Text], Maybe CausalHash, Bool))
|
||||
-- expandEntries ([], Just expectedHash, moreEntriesToLoad) =
|
||||
-- if moreEntriesToLoad
|
||||
-- then Nothing
|
||||
-- else Just ((Nothing, expectedHash, "history starts here"), ([], Nothing, moreEntriesToLoad))
|
||||
-- expandEntries ([], Nothing, _moreEntriesToLoad) = Nothing
|
||||
-- expandEntries (entries@(Reflog.Entry {time, fromRootCausalHash, toRootCausalHash, reason} : rest), mayExpectedHash, moreEntriesToLoad) =
|
||||
-- Just $
|
||||
-- case mayExpectedHash of
|
||||
-- Just expectedHash
|
||||
-- | expectedHash == toRootCausalHash -> ((Just time, toRootCausalHash, reason), (rest, Just fromRootCausalHash, moreEntriesToLoad))
|
||||
-- -- Historical discontinuity, insert a synthetic entry
|
||||
-- | otherwise -> ((Nothing, toRootCausalHash, "(external change)"), (entries, Nothing, moreEntriesToLoad))
|
||||
-- -- No expectation, either because this is the most recent entry or
|
||||
-- -- because we're recovering from a discontinuity
|
||||
-- Nothing -> ((Just time, toRootCausalHash, reason), (rest, Just fromRootCausalHash, moreEntriesToLoad))
|
||||
import Unison.Sqlite qualified as Sqlite
|
||||
|
||||
showProjectBranchReflog :: Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) -> Cli ()
|
||||
showProjectBranchReflog mayProjectAndBranch = do
|
||||
ProjectAndBranch project branch <- case mayProjectAndBranch of
|
||||
ProjectAndBranch _project branch <- case mayProjectAndBranch of
|
||||
Nothing -> Cli.getCurrentProjectAndBranch
|
||||
Just pab -> ProjectUtils.resolveProjectBranch (second Just pab)
|
||||
reflogHelper (\n -> Codebase.getProjectBranchReflog n (branch ^. #branchId))
|
||||
|
||||
showProjectReflog :: Maybe ProjectName -> Cli ()
|
||||
showProjectReflog mayProject = do
|
||||
ProjectAndBranch project _ <- ProjectUtils.resolveProjectBranch (ProjectAndBranch mayProject Nothing)
|
||||
reflogHelper (\n -> Codebase.getProjectReflog n (project ^. #projectId))
|
||||
|
||||
showGlobalReflog :: Cli ()
|
||||
showGlobalReflog = do
|
||||
reflogHelper Codebase.getGlobalReflog
|
||||
|
||||
reflogHelper :: (Int -> Sqlite.Transaction [ProjectReflog.Entry Project ProjectBranch CausalHash]) -> Cli ()
|
||||
reflogHelper getEntries = do
|
||||
let numEntriesToShow = 500
|
||||
entries <-
|
||||
Cli.runTransaction $ do
|
||||
schLength <- Codebase.branchHashLength
|
||||
entries <- Codebase.getProjectBranchReflog numEntriesToShow branch.branchId
|
||||
entries <- getEntries numEntriesToShow
|
||||
entries
|
||||
& (fmap . fmap) SCH.fromHash schLength
|
||||
& (fmap . fmap) (\ch -> (ch, SCH.fromHash schLength ch))
|
||||
& pure
|
||||
let moreEntriesToLoad =
|
||||
if length entries == numEntriesToShow
|
||||
then Output.MoreEntriesThanShown
|
||||
else Output.AllEntriesShown
|
||||
Cli.respondNumbered $ ShowProjectBranchReflog moreEntriesToLoad shortEntries
|
||||
now <- liftIO getCurrentTime
|
||||
Cli.respondNumbered $ Output.ShowProjectBranchReflog now moreEntriesToLoad entries
|
||||
|
@ -124,6 +124,7 @@ module Unison.CommandLine.InputPatterns
|
||||
deprecatedViewRootReflog,
|
||||
branchReflog,
|
||||
projectReflog,
|
||||
globalReflog,
|
||||
|
||||
-- * Misc
|
||||
formatStructuredArgument,
|
||||
@ -2302,6 +2303,22 @@ projectReflog =
|
||||
_ -> Left (I.help projectReflog)
|
||||
)
|
||||
|
||||
globalReflog :: InputPattern
|
||||
globalReflog =
|
||||
InputPattern
|
||||
"reflog.global"
|
||||
[]
|
||||
I.Visible
|
||||
[]
|
||||
( P.lines
|
||||
[ "`reflog.global` lists all recent changes across all projects and branches."
|
||||
]
|
||||
)
|
||||
( \case
|
||||
[] -> pure $ Input.ShowGlobalReflogI
|
||||
_ -> Left (I.help globalReflog)
|
||||
)
|
||||
|
||||
edit :: InputPattern
|
||||
edit =
|
||||
InputPattern
|
||||
|
Loading…
Reference in New Issue
Block a user