module Unison.Codebase.Editor.HandleInput.SyncV2
  ( handleSyncToFile,
    handleSyncFromFile,
    handleSyncFromCodebase,
    handleSyncFromCodeserver,
  )
where

import Control.Lens
import Control.Monad.Reader (MonadReader (..))
import Data.These (These (..))
import U.Codebase.HashTags (CausalHash)
import U.Codebase.Sqlite.Project qualified as Projects
import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..))
import U.Codebase.Sqlite.Queries qualified as Q
import Unison.Cli.DownloadUtils (downloadProjectBranchFromShare)
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 Project
import Unison.Cli.Share.Projects qualified as ShareProjects
import Unison.Codebase (CodebasePath)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Editor.HandleInput.Branch (CreateFrom (..))
import Unison.Codebase.Editor.HandleInput.Branch qualified as Branch
import Unison.Codebase.Editor.Output qualified as Output
import Unison.Codebase.Init qualified as Init
import Unison.Codebase.ProjectPath (ProjectPathG (..))
import Unison.Codebase.SqliteCodebase qualified as SqliteCodebase
import Unison.Prelude
import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName)
import Unison.Share.SyncV2 qualified as SyncV2
import Unison.SyncV2.Types (BranchRef)

handleSyncToFile :: FilePath -> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName) -> Cli ()
handleSyncToFile :: FilePath
-> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)
-> Cli ()
handleSyncToFile FilePath
destSyncFile ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)
branchToSync = do
  pp <- Cli ProjectPath
Cli.getCurrentProjectPath
  projectBranch <- Project.resolveProjectBranchInProject (pp ^. #project) (over #branch (Just . fromMaybe (pp.branch.name)) branchToSync)
  causalHash <- Cli.runTransaction $ Project.getProjectBranchCausalHash (projectBranch ^. #branch)
  let branchRef = forall target source. From source target => source -> target
into @BranchRef (ProjectAndBranch ProjectName ProjectBranchName -> BranchRef)
-> ProjectAndBranch ProjectName ProjectBranchName -> BranchRef
forall a b. (a -> b) -> a -> b
$ ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch (ProjectAndBranch Project ProjectBranch
projectBranch ProjectAndBranch Project ProjectBranch
-> Getting
     ProjectName (ProjectAndBranch Project ProjectBranch) ProjectName
-> ProjectName
forall s a. s -> Getting a s a -> a
^. (Project -> Const ProjectName Project)
-> ProjectAndBranch Project ProjectBranch
-> Const ProjectName (ProjectAndBranch Project ProjectBranch)
#project ((Project -> Const ProjectName Project)
 -> ProjectAndBranch Project ProjectBranch
 -> Const ProjectName (ProjectAndBranch Project ProjectBranch))
-> ((ProjectName -> Const ProjectName ProjectName)
    -> Project -> Const ProjectName Project)
-> Getting
     ProjectName (ProjectAndBranch Project ProjectBranch) ProjectName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProjectName -> Const ProjectName ProjectName)
-> Project -> Const ProjectName Project
#name) (ProjectAndBranch Project ProjectBranch
projectBranch ProjectAndBranch Project ProjectBranch
-> Getting
     ProjectBranchName
     (ProjectAndBranch Project ProjectBranch)
     ProjectBranchName
-> ProjectBranchName
forall s a. s -> Getting a s a -> a
^. (ProjectBranch -> Const ProjectBranchName ProjectBranch)
-> ProjectAndBranch Project ProjectBranch
-> Const ProjectBranchName (ProjectAndBranch Project ProjectBranch)
#branch ((ProjectBranch -> Const ProjectBranchName ProjectBranch)
 -> ProjectAndBranch Project ProjectBranch
 -> Const
      ProjectBranchName (ProjectAndBranch Project ProjectBranch))
-> ((ProjectBranchName
     -> Const ProjectBranchName ProjectBranchName)
    -> ProjectBranch -> Const ProjectBranchName ProjectBranch)
-> Getting
     ProjectBranchName
     (ProjectAndBranch Project ProjectBranch)
     ProjectBranchName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProjectBranchName -> Const ProjectBranchName ProjectBranchName)
-> ProjectBranch -> Const ProjectBranchName ProjectBranch
#name)
  Cli.Env {codebase} <- ask
  liftIO (SyncV2.syncToFile codebase causalHash (Just branchRef) destSyncFile) >>= \case
    Left SyncError PullError
err -> Output -> Cli ()
Cli.respond (SyncError PullError -> Output
Output.SyncPullError SyncError PullError
err)
    Right ()
_ -> () -> Cli ()
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

handleSyncFromFile :: Text -> FilePath -> ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli ()
handleSyncFromFile :: Text
-> FilePath
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> Cli ()
handleSyncFromFile Text
description FilePath
srcSyncFile ProjectAndBranch (Maybe ProjectName) ProjectBranchName
destBranch = do
  let shouldValidate :: Bool
shouldValidate = Bool
True
  Bool
-> FilePath
-> Cli (Either (SyncError PullError) (CausalHash, CausalHashId))
SyncV2.syncFromFile Bool
shouldValidate FilePath
srcSyncFile Cli (Either (SyncError PullError) (CausalHash, CausalHashId))
-> (Either (SyncError PullError) (CausalHash, CausalHashId)
    -> Cli ())
-> Cli ()
forall a b. Cli a -> (a -> Cli b) -> Cli b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left SyncError PullError
err -> Output -> Cli ()
Cli.respond (SyncError PullError -> Output
Output.SyncPullError SyncError PullError
err)
    Right (CausalHash
causalHash, CausalHashId
_chId) -> do
      Text
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> CausalHash
-> Cli ()
createOrUpdateBranch Text
description ProjectAndBranch (Maybe ProjectName) ProjectBranchName
destBranch CausalHash
causalHash

handleSyncFromCodebase :: Text -> CodebasePath -> ProjectAndBranch ProjectName ProjectBranchName -> ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli ()
handleSyncFromCodebase :: Text
-> FilePath
-> ProjectAndBranch ProjectName ProjectBranchName
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> Cli ()
handleSyncFromCodebase Text
description FilePath
srcCodebasePath ProjectAndBranch ProjectName ProjectBranchName
srcBranch ProjectAndBranch (Maybe ProjectName) ProjectBranchName
destBranch = do
  Cli.Env {codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  r <- liftIO $ Init.withOpenCodebase SqliteCodebase.init "sync-src" srcCodebasePath Init.DontLock (Init.MigrateAfterPrompt Init.Backup Init.Vacuum) \Codebase IO Symbol Ann
srcCodebase -> do
    Codebase IO Symbol Ann -> forall x. (Connection -> IO x) -> IO x
forall (m :: * -> *) v a.
Codebase m v a -> forall x. (Connection -> m x) -> m x
Codebase.withConnection Codebase IO Symbol Ann
srcCodebase \Connection
srcConn -> do
      maySrcCausalHash <- Codebase IO Symbol Ann
-> Transaction (Maybe CausalHash) -> IO (Maybe CausalHash)
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
srcCodebase (Transaction (Maybe CausalHash) -> IO (Maybe CausalHash))
-> Transaction (Maybe CausalHash) -> IO (Maybe CausalHash)
forall a b. (a -> b) -> a -> b
$ do
        let ProjectAndBranch ProjectName
srcProjName ProjectBranchName
srcBranchName = ProjectAndBranch ProjectName ProjectBranchName
srcBranch
        MaybeT Transaction CausalHash -> Transaction (Maybe CausalHash)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
          project <- Transaction (Maybe Project) -> MaybeT Transaction Project
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ProjectName -> Transaction (Maybe Project)
Q.loadProjectByName ProjectName
srcProjName)
          branch <- MaybeT (Q.loadProjectBranchByName (project ^. #projectId) srcBranchName)
          lift $ Project.getProjectBranchCausalHash branch
      case maySrcCausalHash of
        Maybe CausalHash
Nothing -> Either Output (Either (SyncError PullError) CausalHash)
-> IO (Either Output (Either (SyncError PullError) CausalHash))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Output (Either (SyncError PullError) CausalHash)
 -> IO (Either Output (Either (SyncError PullError) CausalHash)))
-> Either Output (Either (SyncError PullError) CausalHash)
-> IO (Either Output (Either (SyncError PullError) CausalHash))
forall a b. (a -> b) -> a -> b
$ Output -> Either Output (Either (SyncError PullError) CausalHash)
forall a b. a -> Either a b
Left (ProjectAndBranch ProjectName ProjectBranchName -> Output
Output.SyncFromCodebaseMissingProjectBranch ProjectAndBranch ProjectName ProjectBranchName
srcBranch)
        Just CausalHash
srcCausalHash -> do
          let shouldValidate :: Bool
shouldValidate = Bool
True
          Either (SyncError PullError) CausalHash
-> Either Output (Either (SyncError PullError) CausalHash)
forall a b. b -> Either a b
Right (Either (SyncError PullError) CausalHash
 -> Either Output (Either (SyncError PullError) CausalHash))
-> (Either (SyncError PullError) (CausalHash, CausalHashId)
    -> Either (SyncError PullError) CausalHash)
-> Either (SyncError PullError) (CausalHash, CausalHashId)
-> Either Output (Either (SyncError PullError) CausalHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CausalHash, CausalHashId) -> CausalHash)
-> Either (SyncError PullError) (CausalHash, CausalHashId)
-> Either (SyncError PullError) CausalHash
forall a b.
(a -> b)
-> Either (SyncError PullError) a -> Either (SyncError PullError) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CausalHash -> (CausalHash, CausalHashId) -> CausalHash
forall a b. a -> b -> a
const CausalHash
srcCausalHash) (Either (SyncError PullError) (CausalHash, CausalHashId)
 -> Either Output (Either (SyncError PullError) CausalHash))
-> IO (Either (SyncError PullError) (CausalHash, CausalHashId))
-> IO (Either Output (Either (SyncError PullError) CausalHash))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either (SyncError PullError) (CausalHash, CausalHashId))
-> IO (Either (SyncError PullError) (CausalHash, CausalHashId))
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Bool
-> Connection
-> Codebase IO Symbol Ann
-> CausalHash
-> IO (Either (SyncError PullError) (CausalHash, CausalHashId))
forall v a.
Bool
-> Connection
-> Codebase IO v a
-> CausalHash
-> IO (Either (SyncError PullError) (CausalHash, CausalHashId))
SyncV2.syncFromCodebase Bool
shouldValidate Connection
srcConn Codebase IO Symbol Ann
codebase CausalHash
srcCausalHash)

  case r of
    Left OpenCodebaseError
openCodebaseErr -> Output -> Cli ()
Cli.respond (FilePath -> OpenCodebaseError -> Output
Output.OpenCodebaseError FilePath
srcCodebasePath OpenCodebaseError
openCodebaseErr)
    Right (Left Output
errOutput) -> Output -> Cli ()
Cli.respond Output
errOutput
    Right (Right (Right CausalHash
causalHash)) -> do
      Text
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> CausalHash
-> Cli ()
createOrUpdateBranch Text
description ProjectAndBranch (Maybe ProjectName) ProjectBranchName
destBranch CausalHash
causalHash
    Right (Right (Left SyncError PullError
syncErr)) -> do
      Output -> Cli ()
Cli.respond (SyncError PullError -> Output
Output.SyncPullError SyncError PullError
syncErr)

createOrUpdateBranch :: Text -> ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> CausalHash -> Cli ()
createOrUpdateBranch :: Text
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> CausalHash
-> Cli ()
createOrUpdateBranch Text
description ProjectAndBranch (Maybe ProjectName) ProjectBranchName
destBranch CausalHash
causalHash = do
  theseNames <- case ProjectAndBranch (Maybe ProjectName) ProjectBranchName
destBranch of
    ProjectAndBranch (Just ProjectName
projName) ProjectBranchName
branchName -> do
      These ProjectName ProjectBranchName
-> Cli (These ProjectName ProjectBranchName)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectName
-> ProjectBranchName -> These ProjectName ProjectBranchName
forall a b. a -> b -> These a b
These ProjectName
projName ProjectBranchName
branchName)
    ProjectAndBranch Maybe ProjectName
Nothing ProjectBranchName
branchName -> do
      These ProjectName ProjectBranchName
-> Cli (These ProjectName ProjectBranchName)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectBranchName -> These ProjectName ProjectBranchName
forall a b. b -> These a b
That ProjectBranchName
branchName)
  Project.getProjectAndBranchByTheseNames theseNames >>= \case
    Just ProjectAndBranch Project ProjectBranch
projectBranch -> do
      HasCallStack => ProjectBranch -> Text -> CausalHash -> Cli ()
ProjectBranch -> Text -> CausalHash -> Cli ()
Cli.setProjectBranchRootToCausalHash (ProjectAndBranch Project ProjectBranch
projectBranch ProjectAndBranch Project ProjectBranch
-> Getting
     ProjectBranch
     (ProjectAndBranch Project ProjectBranch)
     ProjectBranch
-> ProjectBranch
forall s a. s -> Getting a s a -> a
^. Getting
  ProjectBranch
  (ProjectAndBranch Project ProjectBranch)
  ProjectBranch
#branch) Text
description CausalHash
causalHash
      ProjectAndBranch ProjectId ProjectBranchId -> Cli ()
Cli.switchProject ((Project -> ProjectId)
-> (ProjectBranch -> ProjectBranchId)
-> ProjectAndBranch Project ProjectBranch
-> ProjectAndBranch ProjectId ProjectBranchId
forall a b c d.
(a -> b)
-> (c -> d) -> ProjectAndBranch a c -> ProjectAndBranch b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Project -> ProjectId
Projects.projectId ProjectBranch -> ProjectBranchId
branchId ProjectAndBranch Project ProjectBranch
projectBranch)
    Maybe (ProjectAndBranch Project ProjectBranch)
Nothing -> do
      let createFrom :: CreateFrom
createFrom = CausalHash -> CreateFrom
CreateFrom'CausalHash CausalHash
causalHash
      pp <- Cli ProjectPath
Cli.getCurrentProjectPath
      void $ Branch.createBranch description createFrom pp.project (pure destBranch.branch)

handleSyncFromCodeserver :: ShareProjects.IncludeSquashedHead -> ShareProjects.RemoteProjectBranch -> Bool -> Cli (Either Output.ShareError CausalHash)
handleSyncFromCodeserver :: IncludeSquashedHead
-> RemoteProjectBranch
-> Bool
-> Cli (Either ShareError CausalHash)
handleSyncFromCodeserver = HasCallStack =>
IncludeSquashedHead
-> RemoteProjectBranch
-> Bool
-> Cli (Either ShareError CausalHash)
IncludeSquashedHead
-> RemoteProjectBranch
-> Bool
-> Cli (Either ShareError CausalHash)
downloadProjectBranchFromShare