module Unison.Codebase.Editor.HandleInput.History (handleHistory) where

import Data.Map qualified as Map
import U.Codebase.HashTags
import U.Codebase.Sqlite.Queries qualified as Q
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils qualified as Cli
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Branch.Names qualified as Branch
import Unison.Codebase.Causal qualified as Causal
import Unison.Codebase.Editor.Input
import Unison.Codebase.Editor.Output
import Unison.Codebase.Path (Path')
import Unison.HistoryComment (HistoryComment (..), HistoryCommentRevision (..), LatestHistoryComment)
import Unison.NamesWithHistory qualified as Names
import Unison.Prelude

handleHistory :: Maybe Int -> Maybe Int -> BranchIdG Path' -> Cli.Cli ()
handleHistory :: Maybe Int -> Maybe Int -> BranchIdG Path' -> Cli ()
handleHistory Maybe Int
resultsCap Maybe Int
diffCap BranchIdG Path'
from = do
  branch <-
    case BranchIdG Path'
from of
      BranchAtSCH ShortCausalHash
hash -> ShortCausalHash -> Cli (Branch IO)
Cli.resolveShortCausalHash ShortCausalHash
hash
      BranchAtPath Path'
path' -> do
        pp <- Path' -> Cli ProjectPath
Cli.resolvePath' Path'
path'
        Cli.getBranchFromProjectPath pp
      BranchAtProjectPath ProjectPath
pp -> ProjectPath -> Cli (Branch IO)
Cli.getBranchFromProjectPath ProjectPath
pp
  schLength <- Cli.runTransaction Codebase.branchHashLength
  history <- doHistory schLength 0 branch []
  Cli.respondNumbered history
  where
    doHistory :: Int -> Int -> Branch IO -> [(CausalHash, Maybe (LatestHistoryComment () () () ()), Names.Diff)] -> Cli.Cli NumberedOutput
    doHistory :: Int
-> Int
-> Branch IO
-> [(CausalHash, Maybe (LatestHistoryComment () () () ()), Diff)]
-> Cli NumberedOutput
doHistory Int
schLength !Int
n Branch IO
b [(CausalHash, Maybe (LatestHistoryComment () () () ()), Diff)]
acc =
      if Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=) Maybe Int
resultsCap
        then do
          mayComment <- CausalHash -> Cli (Maybe (LatestHistoryComment () () () ()))
getComment (CausalHash -> Cli (Maybe (LatestHistoryComment () () () ())))
-> CausalHash -> Cli (Maybe (LatestHistoryComment () () () ()))
forall a b. (a -> b) -> a -> b
$ Branch IO -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash Branch IO
b
          pure (History diffCap schLength acc (mayComment, PageEnd (Branch.headHash b) n))
        else case Branch IO -> UnwrappedBranch IO
forall (m :: * -> *). Branch m -> UnwrappedBranch m
Branch._history Branch IO
b of
          Causal.One {} -> do
            mayComment <- CausalHash -> Cli (Maybe (LatestHistoryComment () () () ()))
getComment (CausalHash -> Cli (Maybe (LatestHistoryComment () () () ())))
-> CausalHash -> Cli (Maybe (LatestHistoryComment () () () ()))
forall a b. (a -> b) -> a -> b
$ Branch IO -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash Branch IO
b
            pure (History diffCap schLength acc (mayComment, EndOfLog $ Branch.headHash b))
          Causal.Merge CausalHash
_ HashFor (Branch0 IO)
_ Branch0 IO
_ Map CausalHash (IO (UnwrappedBranch IO))
tails -> do
            mayComment <- CausalHash -> Cli (Maybe (LatestHistoryComment () () () ()))
getComment (CausalHash -> Cli (Maybe (LatestHistoryComment () () () ())))
-> CausalHash -> Cli (Maybe (LatestHistoryComment () () () ()))
forall a b. (a -> b) -> a -> b
$ Branch IO -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash Branch IO
b
            pure (History diffCap schLength acc (mayComment, MergeTail (Branch.headHash b) $ Map.keys tails))
          Causal.Cons CausalHash
_ HashFor (Branch0 IO)
_ Branch0 IO
_ (CausalHash, IO (UnwrappedBranch IO))
tail -> do
            b' <- IO (Branch IO) -> Cli (Branch IO)
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Branch IO) -> Cli (Branch IO))
-> IO (Branch IO) -> Cli (Branch IO)
forall a b. (a -> b) -> a -> b
$ (UnwrappedBranch IO -> Branch IO)
-> IO (UnwrappedBranch IO) -> IO (Branch IO)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnwrappedBranch IO -> Branch IO
forall (m :: * -> *). UnwrappedBranch m -> Branch m
Branch.Branch (IO (UnwrappedBranch IO) -> IO (Branch IO))
-> IO (UnwrappedBranch IO) -> IO (Branch IO)
forall a b. (a -> b) -> a -> b
$ (CausalHash, IO (UnwrappedBranch IO)) -> IO (UnwrappedBranch IO)
forall a b. (a, b) -> b
snd (CausalHash, IO (UnwrappedBranch IO))
tail
            let causalHash = Branch IO -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash Branch IO
b
            mayComment <- getComment causalHash
            let elem = (CausalHash
causalHash, Maybe (LatestHistoryComment () () () ())
mayComment, Branch IO -> Branch IO -> Diff
forall (m :: * -> *). Branch m -> Branch m -> Diff
Branch.namesDiff Branch IO
b' Branch IO
b)
            doHistory schLength (n + 1) b' (elem : acc)
    getComment :: CausalHash -> Cli.Cli (Maybe (LatestHistoryComment () () () ()))
    getComment :: CausalHash -> Cli (Maybe (LatestHistoryComment () () () ()))
getComment CausalHash
ch = Transaction (Maybe (LatestHistoryComment () () () ()))
-> Cli (Maybe (LatestHistoryComment () () () ()))
forall a. Transaction a -> Cli a
Cli.runTransaction (Transaction (Maybe (LatestHistoryComment () () () ()))
 -> Cli (Maybe (LatestHistoryComment () () () ())))
-> Transaction (Maybe (LatestHistoryComment () () () ()))
-> Cli (Maybe (LatestHistoryComment () () () ()))
forall a b. (a -> b) -> a -> b
$ do
      causalHashId <- CausalHash -> Transaction CausalHashId
Q.expectCausalHashIdByCausalHash CausalHash
ch
      Q.getLatestCausalComment causalHashId
        <&> fmap \LatestHistoryComment
  KeyThumbprintId
  CausalHash
  HistoryCommentRevisionId
  HistoryCommentHash
hcr ->
          let comment :: HistoryComment UTCTime () () ()
comment = LatestHistoryComment
  KeyThumbprintId
  CausalHash
  HistoryCommentRevisionId
  HistoryCommentHash
hcr.comment {authorThumbprint = (), causal = (), commentId = ()}
           in LatestHistoryComment
  KeyThumbprintId
  CausalHash
  HistoryCommentRevisionId
  HistoryCommentHash
hcr {comment = comment, revisionId = ()}