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

import Control.Lens
import Control.Monad.Reader (MonadReader (..))
import U.Codebase.HashTags (CausalHash)
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 Projects
import Unison.Codebase (CodebasePath)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Editor.Output qualified as Output
import Unison.Codebase.Init qualified as Init
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
  ProjectPath
pp <- Cli ProjectPath
Cli.getCurrentProjectPath
  ProjectAndBranch Project ProjectBranch
projectBranch <- Project
-> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)
-> Cli (ProjectAndBranch Project ProjectBranch)
Project.resolveProjectBranchInProject (ProjectPath
pp ProjectPath -> Getting Project ProjectPath Project -> Project
forall s a. s -> Getting a s a -> a
^. Getting Project ProjectPath Project
#project) ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)
branchToSync
  CausalHash
causalHash <- Transaction CausalHash -> Cli CausalHash
forall a. Transaction a -> Cli a
Cli.runTransaction (Transaction CausalHash -> Cli CausalHash)
-> Transaction CausalHash -> Cli CausalHash
forall a b. (a -> b) -> a -> b
$ ProjectBranch -> Transaction CausalHash
Project.getProjectBranchCausalHash (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)
  let branchRef :: BranchRef
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 IO Symbol Ann
codebase :: Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO (Either (SyncError PullError) ())
-> Cli (Either (SyncError PullError) ())
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Codebase IO Symbol Ann
-> CausalHash
-> Maybe BranchRef
-> FilePath
-> IO (Either (SyncError PullError) ())
forall v a.
Codebase IO v a
-> CausalHash
-> Maybe BranchRef
-> FilePath
-> IO (Either (SyncError PullError) ())
SyncV2.syncToFile Codebase IO Symbol Ann
codebase CausalHash
causalHash (BranchRef -> Maybe BranchRef
forall a. a -> Maybe a
Just BranchRef
branchRef) FilePath
destSyncFile) Cli (Either (SyncError PullError) ())
-> (Either (SyncError PullError) () -> 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 ()
_ -> () -> 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
branchToSync = do
  ProjectPath
pp <- Cli ProjectPath
Cli.getCurrentProjectPath
  ProjectAndBranch Project ProjectBranch
projectBranch <- Project
-> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)
-> Cli (ProjectAndBranch Project ProjectBranch)
Project.resolveProjectBranchInProject (ProjectPath
pp ProjectPath -> Getting Project ProjectPath Project -> Project
forall s a. s -> Getting a s a -> a
^. Getting Project ProjectPath Project
#project) (ASetter
  (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
  (ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName))
  ProjectBranchName
  (Maybe ProjectBranchName)
-> (ProjectBranchName -> Maybe ProjectBranchName)
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
  (ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName))
  ProjectBranchName
  (Maybe ProjectBranchName)
#branch ProjectBranchName -> Maybe ProjectBranchName
forall a. a -> Maybe a
Just ProjectAndBranch (Maybe ProjectName) ProjectBranchName
branchToSync)
  let shouldValidate :: Bool
shouldValidate = Bool
True
  Bool -> FilePath -> Cli (Either (SyncError PullError) CausalHash)
SyncV2.syncFromFile Bool
shouldValidate FilePath
srcSyncFile Cli (Either (SyncError PullError) CausalHash)
-> (Either (SyncError PullError) CausalHash -> 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 -> do
      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

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 IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  ProjectPath
pp <- Cli ProjectPath
Cli.getCurrentProjectPath
  ProjectAndBranch Project ProjectBranch
projectBranch <- Project
-> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)
-> Cli (ProjectAndBranch Project ProjectBranch)
Project.resolveProjectBranchInProject (ProjectPath
pp ProjectPath -> Getting Project ProjectPath Project -> Project
forall s a. s -> Getting a s a -> a
^. Getting Project ProjectPath Project
#project) (ASetter
  (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
  (ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName))
  ProjectBranchName
  (Maybe ProjectBranchName)
-> (ProjectBranchName -> Maybe ProjectBranchName)
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
  (ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName))
  ProjectBranchName
  (Maybe ProjectBranchName)
#branch ProjectBranchName -> Maybe ProjectBranchName
forall a. a -> Maybe a
Just ProjectAndBranch (Maybe ProjectName) ProjectBranchName
destBranch)
  Either
  OpenCodebaseError
  (Either Output (Either (SyncError PullError) CausalHash))
r <- IO
  (Either
     OpenCodebaseError
     (Either Output (Either (SyncError PullError) CausalHash)))
-> Cli
     (Either
        OpenCodebaseError
        (Either Output (Either (SyncError PullError) CausalHash)))
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (Either
      OpenCodebaseError
      (Either Output (Either (SyncError PullError) CausalHash)))
 -> Cli
      (Either
         OpenCodebaseError
         (Either Output (Either (SyncError PullError) CausalHash))))
-> IO
     (Either
        OpenCodebaseError
        (Either Output (Either (SyncError PullError) CausalHash)))
-> Cli
     (Either
        OpenCodebaseError
        (Either Output (Either (SyncError PullError) CausalHash)))
forall a b. (a -> b) -> a -> b
$ Init IO Symbol Ann
-> forall r.
   FilePath
   -> FilePath
   -> CodebaseLockOption
   -> MigrationStrategy
   -> (Codebase IO Symbol Ann -> IO r)
   -> IO (Either OpenCodebaseError r)
forall (m :: * -> *) v a.
Init m v a
-> forall r.
   FilePath
   -> FilePath
   -> CodebaseLockOption
   -> MigrationStrategy
   -> (Codebase m v a -> m r)
   -> m (Either OpenCodebaseError r)
Init.withOpenCodebase Init IO Symbol Ann
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m) =>
Init m Symbol Ann
SqliteCodebase.init FilePath
"sync-src" FilePath
srcCodebasePath CodebaseLockOption
Init.DontLock (BackupStrategy -> VacuumStrategy -> MigrationStrategy
Init.MigrateAfterPrompt BackupStrategy
Init.Backup VacuumStrategy
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
      Maybe CausalHash
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
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)
          ProjectBranch
branch <- Transaction (Maybe ProjectBranch)
-> MaybeT Transaction ProjectBranch
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ProjectId -> ProjectBranchName -> Transaction (Maybe ProjectBranch)
Q.loadProjectBranchByName (Project
project Project -> Getting ProjectId Project ProjectId -> ProjectId
forall s a. s -> Getting a s a -> a
^. Getting ProjectId Project ProjectId
#projectId) ProjectBranchName
srcBranchName)
          Transaction CausalHash -> MaybeT Transaction CausalHash
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction CausalHash -> MaybeT Transaction CausalHash)
-> Transaction CausalHash -> MaybeT Transaction CausalHash
forall a b. (a -> b) -> a -> b
$ ProjectBranch -> Transaction CausalHash
Project.getProjectBranchCausalHash ProjectBranch
branch
      case Maybe CausalHash
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) ()
    -> Either (SyncError PullError) CausalHash)
-> Either (SyncError PullError) ()
-> Either Output (Either (SyncError PullError) CausalHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> CausalHash)
-> Either (SyncError PullError) ()
-> 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
forall a b. a -> b -> a
const CausalHash
srcCausalHash) (Either (SyncError PullError) ()
 -> Either Output (Either (SyncError PullError) CausalHash))
-> IO (Either (SyncError PullError) ())
-> IO (Either Output (Either (SyncError PullError) CausalHash))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either (SyncError PullError) ())
-> IO (Either (SyncError PullError) ())
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) ())
forall v a.
Bool
-> Connection
-> Codebase IO v a
-> CausalHash
-> IO (Either (SyncError PullError) ())
SyncV2.syncFromCodebase Bool
shouldValidate Connection
srcConn Codebase IO Symbol Ann
codebase CausalHash
srcCausalHash)

  case Either
  OpenCodebaseError
  (Either Output (Either (SyncError PullError) CausalHash))
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
      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
    Right (Right (Left SyncError PullError
syncErr)) -> do
      Output -> Cli ()
Cli.respond (SyncError PullError -> Output
Output.SyncPullError SyncError PullError
syncErr)

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