-- | 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 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)
  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 _ <- 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)
  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
  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
      schLength <- Transaction Int
Codebase.branchHashLength
      entries <- getEntries numEntriesToShow
      entries
        & (fmap . fmap) (\CausalHash
ch -> (CausalHash
ch, Int -> CausalHash -> ShortCausalHash
SCH.fromHash Int
schLength CausalHash
ch))
        & pure
  let 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
  mayNow <-
    asks Cli.isTranscriptTest >>= \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
  Cli.respondNumbered $ Output.ShowProjectBranchReflog mayNow moreEntriesToLoad entries