-- | Helpers for working with various kinds of reflogs.
module Unison.Codebase.Editor.HandleInput.Reflogs
  ( showProjectBranchReflog,
    showProjectReflog,
    showGlobalReflog,
  )
where

import Control.Monad.Reader
import Data.Time (getCurrentTime)
import U.Codebase.HashTags (CausalHash)
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 qualified as Output
import Unison.Codebase.ShortCausalHash qualified as SCH
import Unison.Core.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName)
import Unison.Prelude
import Unison.Sqlite qualified as Sqlite

showProjectBranchReflog :: Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) -> Cli ()
showProjectBranchReflog :: Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Cli ()
showProjectBranchReflog Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
mayProjectAndBranch = do
  ProjectAndBranch Project
_project ProjectBranch
branch <- case Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
mayProjectAndBranch of
    Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
Nothing -> Cli (ProjectAndBranch Project ProjectBranch)
Cli.getCurrentProjectAndBranch
    Just ProjectAndBranch (Maybe ProjectName) ProjectBranchName
pab -> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)
-> Cli (ProjectAndBranch Project ProjectBranch)
ProjectUtils.resolveProjectBranch ((ProjectBranchName -> Maybe ProjectBranchName)
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)
forall b c a.
(b -> c) -> ProjectAndBranch a b -> ProjectAndBranch a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ProjectBranchName -> Maybe ProjectBranchName
forall a. a -> Maybe a
Just ProjectAndBranch (Maybe ProjectName) ProjectBranchName
pab)
  (Int -> Transaction [Entry Project ProjectBranch CausalHash])
-> Cli ()
reflogHelper (\Int
n -> Int
-> ProjectBranchId
-> Transaction [Entry Project ProjectBranch CausalHash]
Codebase.getProjectBranchReflog Int
n (ProjectBranch
branch ProjectBranch
-> Getting ProjectBranchId ProjectBranch ProjectBranchId
-> ProjectBranchId
forall s a. s -> Getting a s a -> a
^. Getting ProjectBranchId ProjectBranch ProjectBranchId
#branchId))

showProjectReflog :: Maybe ProjectName -> Cli ()
showProjectReflog :: Maybe ProjectName -> Cli ()
showProjectReflog Maybe ProjectName
mayProject = do
  ProjectAndBranch Project
project ProjectBranch
_ <- ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)
-> Cli (ProjectAndBranch Project ProjectBranch)
ProjectUtils.resolveProjectBranch (Maybe ProjectName
-> Maybe ProjectBranchName
-> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch Maybe ProjectName
mayProject Maybe ProjectBranchName
forall a. Maybe a
Nothing)
  (Int -> Transaction [Entry Project ProjectBranch CausalHash])
-> Cli ()
reflogHelper (\Int
n -> Int
-> ProjectId
-> Transaction [Entry Project ProjectBranch CausalHash]
Codebase.getProjectReflog Int
n (Project
project Project -> Getting ProjectId Project ProjectId -> ProjectId
forall s a. s -> Getting a s a -> a
^. Getting ProjectId Project ProjectId
#projectId))

showGlobalReflog :: Cli ()
showGlobalReflog :: Cli ()
showGlobalReflog = do
  (Int -> Transaction [Entry Project ProjectBranch CausalHash])
-> Cli ()
reflogHelper Int -> Transaction [Entry Project ProjectBranch CausalHash]
Codebase.getGlobalReflog

reflogHelper :: (Int -> Sqlite.Transaction [ProjectReflog.Entry Project ProjectBranch CausalHash]) -> Cli ()
reflogHelper :: (Int -> Transaction [Entry Project ProjectBranch CausalHash])
-> Cli ()
reflogHelper Int -> Transaction [Entry Project ProjectBranch CausalHash]
getEntries = do
  let numEntriesToShow :: Int
numEntriesToShow = Int
500
  [Entry Project ProjectBranch (CausalHash, ShortCausalHash)]
entries <-
    Transaction
  [Entry Project ProjectBranch (CausalHash, ShortCausalHash)]
-> Cli [Entry Project ProjectBranch (CausalHash, ShortCausalHash)]
forall a. Transaction a -> Cli a
Cli.runTransaction (Transaction
   [Entry Project ProjectBranch (CausalHash, ShortCausalHash)]
 -> Cli [Entry Project ProjectBranch (CausalHash, ShortCausalHash)])
-> Transaction
     [Entry Project ProjectBranch (CausalHash, ShortCausalHash)]
-> Cli [Entry Project ProjectBranch (CausalHash, ShortCausalHash)]
forall a b. (a -> b) -> a -> b
$ do
      Int
schLength <- Transaction Int
Codebase.branchHashLength
      [Entry Project ProjectBranch CausalHash]
entries <- Int -> Transaction [Entry Project ProjectBranch CausalHash]
getEntries Int
numEntriesToShow
      [Entry Project ProjectBranch CausalHash]
entries
        [Entry Project ProjectBranch CausalHash]
-> ([Entry Project ProjectBranch CausalHash]
    -> [Entry Project ProjectBranch (CausalHash, ShortCausalHash)])
-> [Entry Project ProjectBranch (CausalHash, ShortCausalHash)]
forall a b. a -> (a -> b) -> b
& ((Entry Project ProjectBranch CausalHash
 -> Entry Project ProjectBranch (CausalHash, ShortCausalHash))
-> [Entry Project ProjectBranch CausalHash]
-> [Entry Project ProjectBranch (CausalHash, ShortCausalHash)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Entry Project ProjectBranch CausalHash
  -> Entry Project ProjectBranch (CausalHash, ShortCausalHash))
 -> [Entry Project ProjectBranch CausalHash]
 -> [Entry Project ProjectBranch (CausalHash, ShortCausalHash)])
-> ((CausalHash -> (CausalHash, ShortCausalHash))
    -> Entry Project ProjectBranch CausalHash
    -> Entry Project ProjectBranch (CausalHash, ShortCausalHash))
-> (CausalHash -> (CausalHash, ShortCausalHash))
-> [Entry Project ProjectBranch CausalHash]
-> [Entry Project ProjectBranch (CausalHash, ShortCausalHash)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CausalHash -> (CausalHash, ShortCausalHash))
-> Entry Project ProjectBranch CausalHash
-> Entry Project ProjectBranch (CausalHash, ShortCausalHash)
forall a b.
(a -> b)
-> Entry Project ProjectBranch a -> Entry Project ProjectBranch b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (\CausalHash
ch -> (CausalHash
ch, Int -> CausalHash -> ShortCausalHash
SCH.fromHash Int
schLength CausalHash
ch))
        [Entry Project ProjectBranch (CausalHash, ShortCausalHash)]
-> ([Entry Project ProjectBranch (CausalHash, ShortCausalHash)]
    -> Transaction
         [Entry Project ProjectBranch (CausalHash, ShortCausalHash)])
-> Transaction
     [Entry Project ProjectBranch (CausalHash, ShortCausalHash)]
forall a b. a -> (a -> b) -> b
& [Entry Project ProjectBranch (CausalHash, ShortCausalHash)]
-> Transaction
     [Entry Project ProjectBranch (CausalHash, ShortCausalHash)]
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  let moreEntriesToLoad :: MoreEntriesThanShown
moreEntriesToLoad =
        if [Entry Project ProjectBranch (CausalHash, ShortCausalHash)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Entry Project ProjectBranch (CausalHash, ShortCausalHash)]
entries Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
numEntriesToShow
          then MoreEntriesThanShown
Output.MoreEntriesThanShown
          else MoreEntriesThanShown
Output.AllEntriesShown
  Maybe UTCTime
mayNow <-
    (Env -> Bool) -> Cli Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Bool
Cli.isTranscriptTest Cli Bool -> (Bool -> Cli (Maybe UTCTime)) -> Cli (Maybe UTCTime)
forall a b. Cli a -> (a -> Cli b) -> Cli b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Bool
True -> Maybe UTCTime -> Cli (Maybe UTCTime)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe UTCTime
forall a. Maybe a
Nothing
      Bool
False -> UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just (UTCTime -> Maybe UTCTime) -> Cli UTCTime -> Cli (Maybe UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime -> Cli UTCTime
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  NumberedOutput -> Cli ()
Cli.respondNumbered (NumberedOutput -> Cli ()) -> NumberedOutput -> Cli ()
forall a b. (a -> b) -> a -> b
$ Maybe UTCTime
-> MoreEntriesThanShown
-> [Entry Project ProjectBranch (CausalHash, ShortCausalHash)]
-> NumberedOutput
Output.ShowProjectBranchReflog Maybe UTCTime
mayNow MoreEntriesThanShown
moreEntriesToLoad [Entry Project ProjectBranch (CausalHash, ShortCausalHash)]
entries