make DownloadUtils module, shared by pull and clone

parser-typechecker/src/Unison/Codebase.hs

@@ -88,8 +88,6 @@ module Unison.Codebase
 
     -- ** Remote sync
     viewRemoteBranch,
-    importRemoteBranch,
-    Preprocessing (..),
     pushGitBranch,
 
     -- * Codebase path
@@ -112,8 +110,6 @@ module Unison.Codebase
   )
 where
 
-import Control.Monad.Except (ExceptT (ExceptT), runExceptT)
-import Control.Monad.Trans.Except (throwE)
 import Data.Map qualified as Map
 import Data.Set qualified as Set
 import U.Codebase.Branch qualified as V2
@@ -128,15 +124,13 @@ import Unison.Codebase.Branch (Branch)
 import Unison.Codebase.Branch qualified as Branch
 import Unison.Codebase.BuiltinAnnotation (BuiltinAnnotation (builtinAnnotation))
 import Unison.Codebase.CodeLookup qualified as CL
-import Unison.Codebase.Editor.Git (withStatus)
 import Unison.Codebase.Editor.Git qualified as Git
 import Unison.Codebase.Editor.RemoteRepo (ReadGitRemoteNamespace)
-import Unison.Codebase.GitError qualified as GitError
 import Unison.Codebase.Path
 import Unison.Codebase.Path qualified as Path
 import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv
 import Unison.Codebase.SqliteCodebase.Operations qualified as SqliteCodebase.Operations
-import Unison.Codebase.Type (Codebase (..), GitError (GitCodebaseError))
+import Unison.Codebase.Type (Codebase (..), GitError)
 import Unison.CodebasePath (CodebasePath, getCodebaseDir)
 import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..))
 import Unison.DataDeclaration (Decl)
@@ -160,7 +154,6 @@ import Unison.Typechecker.TypeLookup (TypeLookup (TypeLookup))
 import Unison.Typechecker.TypeLookup qualified as TL
 import Unison.UnisonFile qualified as UF
 import Unison.Util.Relation qualified as Rel
-import Unison.Util.Timing (time)
 import Unison.Var (Var)
 import Unison.WatchKind qualified as WK
 
@@ -475,39 +468,6 @@ isType c r = case r of
 
 -- * Git stuff
 
--- | An optional preprocessing step to run on branches
--- before they're imported into the local codebase.
-data Preprocessing m
-  = Unmodified
-  | Preprocessed (Branch m -> m (Branch m))
-
--- | Sync elements as needed from a remote git codebase into the local one.
--- If `sch` is supplied, we try to load the specified branch hash;
--- otherwise we try to load the root branch.
-importRemoteBranch ::
-  forall m v a.
-  (MonadUnliftIO m) =>
-  Codebase m v a ->
-  ReadGitRemoteNamespace ->
-  Preprocessing m ->
-  m (Either GitError (Branch m))
-importRemoteBranch codebase ns preprocess = runExceptT $ do
-  branchHash <- ExceptT . viewRemoteBranch' codebase ns Git.RequireExistingBranch $ \(branch, cacheDir) -> do
-    withStatus "Importing downloaded files into local codebase..." $ do
-      processedBranch <- preprocessOp branch
-      time "SyncFromDirectory" $ do
-        syncFromDirectory codebase cacheDir processedBranch
-        pure $ Branch.headHash processedBranch
-  time "load fresh local branch after sync" $ do
-    lift (getBranchForHash codebase branchHash) >>= \case
-      Nothing -> throwE . GitCodebaseError $ GitError.CouldntLoadSyncedBranch ns branchHash
-      Just result -> pure $ result
-  where
-    preprocessOp :: Branch m -> m (Branch m)
-    preprocessOp = case preprocess of
-      Preprocessed f -> f
-      Unmodified -> pure
-
 -- | Pull a git branch and view it from the cache, without syncing into the
 -- local codebase.
 viewRemoteBranch ::

parser-typechecker/src/Unison/Codebase/GitError.hs

@@ -1,9 +1,12 @@
-{-# LANGUAGE DeriveAnyClass #-}
+module Unison.Codebase.GitError
+  ( CodebasePath,
+    GitProtocolError (..),
+    GitCodebaseError (..),
+  )
+where
 
-module Unison.Codebase.GitError where
-
-import Unison.Codebase.Editor.RemoteRepo (ReadGitRemoteNamespace, ReadGitRepo, WriteGitRepo)
-import Unison.Codebase.Path
+import Unison.Codebase.Editor.RemoteRepo (ReadGitRepo, WriteGitRepo)
+import Unison.Codebase.Path (Path)
 import Unison.Codebase.ShortCausalHash (ShortCausalHash)
 import Unison.Prelude
 
@@ -30,8 +33,5 @@ data GitProtocolError
 data GitCodebaseError h
   = NoRemoteNamespaceWithHash ReadGitRepo ShortCausalHash
   | RemoteNamespaceHashAmbiguous ReadGitRepo ShortCausalHash (Set h)
-  | CouldntLoadRootBranch ReadGitRepo h
-  | CouldntParseRemoteBranch ReadGitRepo String
-  | CouldntLoadSyncedBranch ReadGitRemoteNamespace h
   | CouldntFindRemoteBranch ReadGitRepo Path
   deriving (Show)

unison-cli/package.yaml

@@ -179,6 +179,7 @@ default-extensions:
   - NamedFieldPuns
   - NumericUnderscores
   - OverloadedLabels
+  - OverloadedRecordDot
   - OverloadedStrings
   - PatternSynonyms
   - RankNTypes

unison-cli/src/Unison/Cli/DownloadUtils.hs

@@ -0,0 +1,139 @@
+-- | Utility functions for downloading remote entities and storing them locally in SQLite.
+--
+-- These are shared by commands like `pull` and `clone`.
+module Unison.Cli.DownloadUtils
+  ( downloadProjectBranchFromShare,
+    downloadLooseCodeFromShare,
+    GitNamespaceHistoryTreatment (..),
+    downloadLooseCodeFromGitRepo,
+  )
+where
+
+import Control.Concurrent.STM (atomically)
+import Control.Concurrent.STM.TVar (modifyTVar', newTVarIO, readTVar, readTVarIO)
+import Data.List.NonEmpty (pattern (:|))
+import System.Console.Regions qualified as Console.Regions
+import U.Codebase.HashTags (CausalHash)
+import U.Codebase.Sqlite.Queries qualified as Queries
+import Unison.Cli.Monad (Cli)
+import Unison.Cli.Monad qualified as Cli
+import Unison.Cli.Share.Projects qualified as Share
+import Unison.Codebase (Codebase)
+import Unison.Codebase qualified as Codebase
+import Unison.Codebase.Branch qualified as Branch
+import Unison.Codebase.Editor.Git qualified as Git
+import Unison.Codebase.Editor.HandleInput.AuthLogin (ensureAuthenticatedWithCodeserver)
+import Unison.Codebase.Editor.Output qualified as Output
+import Unison.Codebase.Editor.RemoteRepo (ReadGitRemoteNamespace, ReadShareLooseCode, shareUserHandleToText)
+import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo
+import Unison.Codebase.Path qualified as Path
+import Unison.Codebase.Type (GitError)
+import Unison.Codebase.Type qualified as Codebase (viewRemoteBranch')
+import Unison.Core.Project (ProjectAndBranch (..))
+import Unison.NameSegment qualified as NameSegment
+import Unison.Parser.Ann (Ann)
+import Unison.Prelude
+import Unison.Share.API.Hash qualified as Share
+import Unison.Share.Codeserver qualified as Codeserver
+import Unison.Share.Sync qualified as Share
+import Unison.Share.Sync.Types qualified as Share
+import Unison.Share.Types (codeserverBaseURL)
+import Unison.Symbol (Symbol)
+import Unison.Sync.Common qualified as Sync.Common
+import Unison.Sync.Types qualified as Share
+
+-- | Download a project/branch from Share.
+downloadProjectBranchFromShare ::
+  HasCallStack =>
+  Bool ->
+  Share.RemoteProjectBranch ->
+  Cli (Either Output.ShareError CausalHash)
+downloadProjectBranchFromShare useSquashedIfAvailable branch =
+  Cli.labelE \done -> do
+    let remoteProjectBranchName = branch.branchName
+    let repoInfo = Share.RepoInfo (into @Text (ProjectAndBranch branch.projectName remoteProjectBranchName))
+    causalHashJwt <-
+      if useSquashedIfAvailable
+        then case branch.squashedBranchHead of
+          Nothing -> done Output.ShareExpectedSquashedHead
+          Just squashedHead -> pure squashedHead
+        else pure branch.branchHead
+    exists <- Cli.runTransaction (Queries.causalExistsByHash32 (Share.hashJWTHash causalHashJwt))
+    when (not exists) do
+      (result, numDownloaded) <-
+        Cli.with withEntitiesDownloadedProgressCallback \(downloadedCallback, getNumDownloaded) -> do
+          result <- Share.downloadEntities Share.hardCodedBaseUrl repoInfo causalHashJwt downloadedCallback
+          numDownloaded <- liftIO getNumDownloaded
+          pure (result, numDownloaded)
+      result & onLeft \err0 -> do
+        done case err0 of
+          Share.SyncError err -> Output.ShareErrorDownloadEntities err
+          Share.TransportError err -> Output.ShareErrorTransport err
+      Cli.respond (Output.DownloadedEntities numDownloaded)
+    pure (Sync.Common.hash32ToCausalHash (Share.hashJWTHash causalHashJwt))
+
+-- | Download loose code from Share.
+downloadLooseCodeFromShare :: ReadShareLooseCode -> Cli (Either Output.ShareError CausalHash)
+downloadLooseCodeFromShare namespace = do
+  let codeserver = Codeserver.resolveCodeserver namespace.server
+  let baseURL = codeserverBaseURL codeserver
+
+  -- Auto-login to share if pulling from a non-public path
+  when (not (RemoteRepo.isPublic namespace)) do
+    _userInfo <- ensureAuthenticatedWithCodeserver codeserver
+    pure ()
+
+  let shareFlavoredPath =
+        Share.Path $
+          shareUserHandleToText namespace.repo
+            :| map NameSegment.toUnescapedText (Path.toList namespace.path)
+
+  Cli.labelE \done -> do
+    (causalHash, numDownloaded) <-
+      Cli.with withEntitiesDownloadedProgressCallback \(downloadedCallback, getNumDownloaded) -> do
+        causalHash <-
+          Share.pull baseURL shareFlavoredPath downloadedCallback & onLeftM \err0 ->
+            done case err0 of
+              Share.SyncError err -> Output.ShareErrorPull err
+              Share.TransportError err -> Output.ShareErrorTransport err
+        numDownloaded <- liftIO getNumDownloaded
+        pure (causalHash, numDownloaded)
+    Cli.respond (Output.DownloadedEntities numDownloaded)
+    pure causalHash
+
+-- Provide the given action a callback that display to the terminal.
+withEntitiesDownloadedProgressCallback :: ((Int -> IO (), IO Int) -> IO a) -> IO a
+withEntitiesDownloadedProgressCallback action = do
+  entitiesDownloadedVar <- newTVarIO 0
+  Console.Regions.displayConsoleRegions do
+    Console.Regions.withConsoleRegion Console.Regions.Linear \region -> do
+      Console.Regions.setConsoleRegion region do
+        entitiesDownloaded <- readTVar entitiesDownloadedVar
+        pure $
+          "\n  Downloaded "
+            <> tShow entitiesDownloaded
+            <> " entities...\n\n"
+      action ((\n -> atomically (modifyTVar' entitiesDownloadedVar (+ n))), readTVarIO entitiesDownloadedVar)
+
+data GitNamespaceHistoryTreatment
+  = -- | Don't touch the history
+    GitNamespaceHistoryTreatment'LetAlone
+  | -- | Throw away all history at all levels
+    GitNamespaceHistoryTreatment'DiscardAllHistory
+
+-- | Download loose code that's in a SQLite codebase in a Git repo.
+downloadLooseCodeFromGitRepo ::
+  MonadIO m =>
+  Codebase IO Symbol Ann ->
+  GitNamespaceHistoryTreatment ->
+  ReadGitRemoteNamespace ->
+  m (Either GitError CausalHash)
+downloadLooseCodeFromGitRepo codebase historyTreatment namespace = liftIO do
+  Codebase.viewRemoteBranch' codebase namespace Git.RequireExistingBranch \(branch0, cacheDir) -> do
+    let branch =
+          case historyTreatment of
+            GitNamespaceHistoryTreatment'LetAlone -> branch0
+            GitNamespaceHistoryTreatment'DiscardAllHistory -> Branch.discardHistory branch0
+
+    Codebase.syncFromDirectory codebase cacheDir branch
+    pure (Branch.headHash branch)

unison-cli/src/Unison/Cli/Monad.hs

@@ -25,6 +25,7 @@ module Unison.Cli.Monad
 
     -- * Short-circuiting
     label,
+    labelE,
     returnEarly,
     returnEarlyWithoutOutput,
     haltRepl,
@@ -336,6 +337,12 @@ label f =
         | otherwise -> throwIO err
       Right a -> feed k a
 
+-- | A variant of @label@ for the common case that early-return values are tagged with a Left.
+labelE :: ((forall void. a -> Cli void) -> Cli b) -> Cli (Either a b)
+labelE f =
+  label \goto ->
+    Right <$> f (goto . Left)
+
 -- | Time an action.
 time :: String -> Cli a -> Cli a
 time label action =

unison-cli/src/Unison/Codebase/Editor/HandleInput.hs

@@ -76,7 +76,7 @@ import Unison.Codebase.Editor.HandleInput.ProjectCreate (projectCreate)
 import Unison.Codebase.Editor.HandleInput.ProjectRename (handleProjectRename)
 import Unison.Codebase.Editor.HandleInput.ProjectSwitch (projectSwitch)
 import Unison.Codebase.Editor.HandleInput.Projects (handleProjects)
-import Unison.Codebase.Editor.HandleInput.Pull (doPullRemoteBranch, mergeBranchAndPropagateDefaultPatch, propagatePatch)
+import Unison.Codebase.Editor.HandleInput.Pull (handlePull, mergeBranchAndPropagateDefaultPatch, propagatePatch)
 import Unison.Codebase.Editor.HandleInput.Push (handleGist, handlePushRemoteBranch)
 import Unison.Codebase.Editor.HandleInput.ReleaseDraft (handleReleaseDraft)
 import Unison.Codebase.Editor.HandleInput.Run (handleRun)
@@ -1021,7 +1021,7 @@ loop e = do
               pped <- Cli.currentPrettyPrintEnvDecl
               let suffixifiedPPE = PPED.suffixifiedPPE pped
               Cli.respondNumbered $ ListEdits patch suffixifiedPPE
-            PullRemoteBranchI sourceTarget pMode verbosity -> doPullRemoteBranch sourceTarget pMode verbosity
+            PullRemoteBranchI sourceTarget pMode verbosity -> handlePull sourceTarget pMode verbosity
             PushRemoteBranchI pushRemoteBranchInput -> handlePushRemoteBranch pushRemoteBranchInput
             ListDependentsI hq -> handleDependents hq
             ListDependenciesI hq -> handleDependencies hq

unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs

@@ -13,6 +13,7 @@ import U.Codebase.Sqlite.DbId qualified as Sqlite
 import U.Codebase.Sqlite.Project qualified as Sqlite (Project)
 import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite
 import U.Codebase.Sqlite.Queries qualified as Queries
+import Unison.Cli.DownloadUtils (downloadProjectBranchFromShare)
 import Unison.Cli.Monad (Cli)
 import Unison.Cli.Monad qualified as Cli
 import Unison.Cli.MonadUtils qualified as Cli (updateAt)
@@ -20,17 +21,11 @@ import Unison.Cli.ProjectUtils (projectBranchPath)
 import Unison.Cli.ProjectUtils qualified as ProjectUtils
 import Unison.Cli.Share.Projects qualified as Share
 import Unison.Codebase qualified as Codebase
-import Unison.Codebase.Editor.HandleInput.Pull qualified as HandleInput.Pull
 import Unison.Codebase.Editor.Output qualified as Output
 import Unison.Codebase.Path (Path)
 import Unison.Prelude
 import Unison.Project (ProjectAndBranch (..), ProjectAndBranchNames (..), ProjectBranchName, ProjectName, projectNameUserSlug)
-import Unison.Share.API.Hash qualified as Share.API
-import Unison.Share.Sync qualified as Share (downloadEntities)
-import Unison.Share.Sync.Types qualified as Share
 import Unison.Sqlite qualified as Sqlite
-import Unison.Sync.Common (hash32ToCausalHash)
-import Unison.Sync.Types qualified as Share
 import Witch (unsafeFrom)
 
 data LocalProjectKey
@@ -241,24 +236,9 @@ cloneInto localProjectBranch remoteProjectBranch = do
   let remoteBranchName = remoteProjectBranch ^. #branchName
   let remoteProjectBranchNames = ProjectAndBranch remoteProjectName remoteBranchName
 
-  -- Pull the remote branch's contents
-  let remoteBranchHeadJwt = remoteProjectBranch ^. #branchHead
-  (result, numDownloaded) <-
-    Cli.with HandleInput.Pull.withEntitiesDownloadedProgressCallback \(downloadedCallback, getNumDownloaded) -> do
-      result <-
-        Share.downloadEntities
-          Share.hardCodedBaseUrl
-          (Share.RepoInfo (into @Text remoteProjectBranchNames))
-          remoteBranchHeadJwt
-          downloadedCallback
-      numDownloaded <- liftIO getNumDownloaded
-      pure (result, numDownloaded)
-  case result of
-    Left err0 ->
-      (Cli.returnEarly . Output.ShareError) case err0 of
-        Share.SyncError err -> Output.ShareErrorDownloadEntities err
-        Share.TransportError err -> Output.ShareErrorTransport err
-    Right () -> Cli.respond (Output.DownloadedEntities numDownloaded)
+  branchHead <-
+    downloadProjectBranchFromShare False {- use squashed -} remoteProjectBranch
+      & onLeftM (Cli.returnEarly . Output.ShareError)
 
   localProjectAndBranch <-
     Cli.runTransactionWithRollback \rollback -> do
@@ -299,7 +279,6 @@ cloneInto localProjectBranch remoteProjectBranch = do
 
   -- Manipulate the root namespace and cd
   Cli.Env {codebase} <- ask
-  let branchHead = hash32ToCausalHash (Share.API.hashJWTHash remoteBranchHeadJwt)
   theBranch <- liftIO (Codebase.expectBranchForHash codebase branchHead)
   let path = projectBranchPath (over #project fst localProjectAndBranch)
   Cli.updateAt ("clone " <> into @Text remoteProjectBranchNames) path (const theBranch)

unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs

@@ -13,6 +13,7 @@ import System.Random.Shuffle qualified as RandomShuffle
 import U.Codebase.Sqlite.DbId
 import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite
 import U.Codebase.Sqlite.Queries qualified as Queries
+import Unison.Cli.DownloadUtils (downloadProjectBranchFromShare)
 import Unison.Cli.Monad (Cli)
 import Unison.Cli.Monad qualified as Cli
 import Unison.Cli.MonadUtils qualified as Cli (stepAt)
@@ -20,7 +21,6 @@ import Unison.Cli.ProjectUtils (projectBranchPath)
 import Unison.Cli.Share.Projects qualified as Share
 import Unison.Codebase qualified as Codebase
 import Unison.Codebase.Branch qualified as Branch
-import Unison.Codebase.Editor.HandleInput.Pull qualified as Pull
 import Unison.Codebase.Editor.Output qualified as Output
 import Unison.Codebase.Path qualified as Path
 import Unison.NameSegment qualified as NameSegment
@@ -115,7 +115,8 @@ projectCreate tryDownloadingBase maybeProjectName = do
                 Share.GetProjectBranchResponseProjectNotFound -> done Nothing
                 Share.GetProjectBranchResponseSuccess branch -> pure branch
             let useSquashed = False
-            Pull.downloadShareProjectBranch useSquashed baseLatestReleaseBranch
+            downloadProjectBranchFromShare useSquashed baseLatestReleaseBranch
+              & onLeftM (Cli.returnEarly . Output.ShareError)
             Cli.Env {codebase} <- ask
             baseLatestReleaseBranchObject <-
               liftIO $

unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs

@@ -1,37 +1,30 @@
 -- | @pull@ input handler
 module Unison.Codebase.Editor.HandleInput.Pull
-  ( doPullRemoteBranch,
-    loadShareLooseCodeIntoMemory,
+  ( handlePull,
     loadPropagateDiffDefaultPatch,
     mergeBranchAndPropagateDefaultPatch,
     propagatePatch,
-    downloadShareProjectBranch,
-    withEntitiesDownloadedProgressCallback,
   )
 where
 
-import Control.Concurrent.STM (atomically, modifyTVar', newTVarIO, readTVar, readTVarIO)
 import Control.Lens ((^.))
 import Control.Monad.Reader (ask)
-import Data.List.NonEmpty qualified as Nel
 import Data.Text qualified as Text
 import Data.These
-import System.Console.Regions qualified as Console.Regions
 import U.Codebase.Sqlite.Project qualified as Sqlite (Project)
 import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite (ProjectBranch)
 import U.Codebase.Sqlite.Queries qualified as Queries
+import Unison.Cli.DownloadUtils
 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.Cli.Share.Projects qualified as Share
 import Unison.Cli.UnisonConfigUtils (resolveConfiguredUrl)
-import Unison.Codebase (Preprocessing (..))
 import Unison.Codebase qualified as Codebase
 import Unison.Codebase.Branch (Branch (..))
 import Unison.Codebase.Branch qualified as Branch
 import Unison.Codebase.Branch.Merge qualified as Branch
-import Unison.Codebase.Editor.HandleInput.AuthLogin (ensureAuthenticatedWithCodeserver)
 import Unison.Codebase.Editor.HandleInput.NamespaceDiffUtils (diffHelper)
 import Unison.Codebase.Editor.Input
 import Unison.Codebase.Editor.Input qualified as Input
@@ -39,7 +32,7 @@ import Unison.Codebase.Editor.Output
 import Unison.Codebase.Editor.Output qualified as Output
 import Unison.Codebase.Editor.Output.PushPull qualified as PushPull
 import Unison.Codebase.Editor.Propagate qualified as Propagate
-import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace (..), ReadShareLooseCode (..), ShareUserHandle (..), printReadRemoteNamespace)
+import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace (..), printReadRemoteNamespace)
 import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo
 import Unison.Codebase.Patch (Patch (..))
 import Unison.Codebase.Path (Path')
@@ -48,27 +41,34 @@ import Unison.Codebase.Verbosity qualified as Verbosity
 import Unison.CommandLine.InputPattern qualified as InputPattern
 import Unison.CommandLine.InputPatterns qualified as InputPatterns
 import Unison.Core.Project (ProjectBranchName (UnsafeProjectBranchName))
-import Unison.NameSegment (NameSegment (..))
 import Unison.NameSegment qualified as NameSegment
 import Unison.Prelude
 import Unison.Project (ProjectAndBranch (..), ProjectBranchNameOrLatestRelease (..), ProjectName)
-import Unison.Share.API.Hash (HashJWT)
-import Unison.Share.API.Hash qualified as Share
-import Unison.Share.Codeserver qualified as Codeserver
-import Unison.Share.Sync qualified as Share
-import Unison.Share.Sync.Types qualified as Share
-import Unison.Share.Types (codeserverBaseURL)
-import Unison.Sync.Common qualified as Common
-import Unison.Sync.Types qualified as Share
 import Witch (unsafeFrom)
 
-doPullRemoteBranch :: PullSourceTarget -> PullMode -> Verbosity.Verbosity -> Cli ()
-doPullRemoteBranch unresolvedSourceAndTarget pullMode verbosity = do
+handlePull :: PullSourceTarget -> PullMode -> Verbosity.Verbosity -> Cli ()
+handlePull unresolvedSourceAndTarget pullMode verbosity = do
   let includeSquashed = case pullMode of
         Input.PullWithHistory -> Share.NoSquashedHead
         Input.PullWithoutHistory -> Share.IncludeSquashedHead
   (source, target) <- resolveSourceAndTarget includeSquashed unresolvedSourceAndTarget
-  remoteBranchObject <- loadRemoteNamespaceIntoMemory pullMode source
+  remoteBranchObject <- do
+    Cli.Env {codebase} <- ask
+    causalHash <-
+      case source of
+        ReadRemoteNamespaceGit repo -> do
+          downloadLooseCodeFromGitRepo
+            codebase
+            ( case pullMode of
+                Input.PullWithHistory -> GitNamespaceHistoryTreatment'LetAlone
+                Input.PullWithoutHistory -> GitNamespaceHistoryTreatment'DiscardAllHistory
+            )
+            repo
+            & onLeftM (Cli.returnEarly . Output.GitError)
+        ReadShare'LooseCode repo -> downloadLooseCodeFromShare repo & onLeftM (Cli.returnEarly . Output.ShareError)
+        ReadShare'ProjectBranch remoteBranch ->
+          downloadProjectBranchFromShare (pullMode == Input.PullWithoutHistory) remoteBranch & onLeftM (Cli.returnEarly . Output.ShareError)
+    liftIO (Codebase.expectBranchForHash codebase causalHash)
   when (Branch.isEmpty0 (Branch.head remoteBranchObject)) do
     Cli.respond (PulledEmptyBranch source)
   targetAbsolutePath <-
@@ -212,84 +212,6 @@ resolveImplicitTarget =
     Nothing -> Left Path.currentPath
     Just (projectAndBranch, _restPath) -> Right projectAndBranch
 
-loadRemoteNamespaceIntoMemory ::
-  PullMode ->
-  ReadRemoteNamespace Share.RemoteProjectBranch ->
-  Cli (Branch IO)
-loadRemoteNamespaceIntoMemory pullMode remoteNamespace = do
-  Cli.Env {codebase} <- ask
-  case remoteNamespace of
-    ReadRemoteNamespaceGit repo -> do
-      let preprocess = case pullMode of
-            Input.PullWithHistory -> Unmodified
-            Input.PullWithoutHistory -> Preprocessed $ pure . Branch.discardHistory
-      Cli.ioE (Codebase.importRemoteBranch codebase repo preprocess) \err ->
-        Cli.returnEarly (Output.GitError err)
-    ReadShare'LooseCode repo -> loadShareLooseCodeIntoMemory repo
-    ReadShare'ProjectBranch remoteBranch -> do
-      projectBranchCausalHashJWT <- downloadShareProjectBranch (pullMode == Input.PullWithoutHistory) remoteBranch
-      let causalHash = Common.hash32ToCausalHash (Share.hashJWTHash projectBranchCausalHashJWT)
-      liftIO (Codebase.expectBranchForHash codebase causalHash)
-
--- | @downloadShareProjectBranch branch@ downloads the given branch.
-downloadShareProjectBranch :: HasCallStack => Bool -> Share.RemoteProjectBranch -> Cli HashJWT
-downloadShareProjectBranch useSquashedIfAvailable branch = do
-  let remoteProjectBranchName = branch ^. #branchName
-  let repoInfo = Share.RepoInfo (into @Text (ProjectAndBranch (branch ^. #projectName) remoteProjectBranchName))
-  causalHashJwt <-
-    if useSquashedIfAvailable
-      then case (branch ^. #squashedBranchHead) of
-        Nothing -> Cli.returnEarly (Output.ShareError ShareExpectedSquashedHead)
-        Just squashedHead -> pure squashedHead
-      else pure (branch ^. #branchHead)
-  exists <- Cli.runTransaction (Queries.causalExistsByHash32 (Share.hashJWTHash causalHashJwt))
-  when (not exists) do
-    (result, numDownloaded) <-
-      Cli.with withEntitiesDownloadedProgressCallback \(downloadedCallback, getNumDownloaded) -> do
-        result <- Share.downloadEntities Share.hardCodedBaseUrl repoInfo causalHashJwt downloadedCallback
-        numDownloaded <- liftIO getNumDownloaded
-        pure (result, numDownloaded)
-    result & onLeft \err0 -> do
-      (Cli.returnEarly . Output.ShareError) case err0 of
-        Share.SyncError err -> Output.ShareErrorDownloadEntities err
-        Share.TransportError err -> Output.ShareErrorTransport err
-    Cli.respond (Output.DownloadedEntities numDownloaded)
-  pure causalHashJwt
-
-loadShareLooseCodeIntoMemory :: ReadShareLooseCode -> Cli (Branch IO)
-loadShareLooseCodeIntoMemory rrn@(ReadShareLooseCode {server, repo, path}) = do
-  let codeserver = Codeserver.resolveCodeserver server
-  let baseURL = codeserverBaseURL codeserver
-  -- Auto-login to share if pulling from a non-public path
-  when (not $ RemoteRepo.isPublic rrn) . void $ ensureAuthenticatedWithCodeserver codeserver
-  let shareFlavoredPath = Share.Path (shareUserHandleToText repo Nel.:| coerce @[NameSegment] @[Text] (Path.toList path))
-  Cli.Env {codebase} <- ask
-  (causalHash, numDownloaded) <-
-    Cli.with withEntitiesDownloadedProgressCallback \(downloadedCallback, getNumDownloaded) -> do
-      causalHash <-
-        Share.pull baseURL shareFlavoredPath downloadedCallback & onLeftM \err0 ->
-          (Cli.returnEarly . Output.ShareError) case err0 of
-            Share.SyncError err -> Output.ShareErrorPull err
-            Share.TransportError err -> Output.ShareErrorTransport err
-      numDownloaded <- liftIO getNumDownloaded
-      pure (causalHash, numDownloaded)
-  Cli.respond (Output.DownloadedEntities numDownloaded)
-  liftIO (Codebase.expectBranchForHash codebase causalHash)
-
--- Provide the given action a callback that display to the terminal.
-withEntitiesDownloadedProgressCallback :: ((Int -> IO (), IO Int) -> IO a) -> IO a
-withEntitiesDownloadedProgressCallback action = do
-  entitiesDownloadedVar <- newTVarIO 0
-  Console.Regions.displayConsoleRegions do
-    Console.Regions.withConsoleRegion Console.Regions.Linear \region -> do
-      Console.Regions.setConsoleRegion region do
-        entitiesDownloaded <- readTVar entitiesDownloadedVar
-        pure $
-          "\n  Downloaded "
-            <> tShow entitiesDownloaded
-            <> " entities...\n\n"
-      action ((\n -> atomically (modifyTVar' entitiesDownloadedVar (+ n))), readTVarIO entitiesDownloadedVar)
-
 -- | supply `dest0` if you want to print diff messages
 --   supply unchangedMessage if you want to display it if merge had no effect
 mergeBranchAndPropagateDefaultPatch ::

unison-cli/src/Unison/CommandLine/OutputMessages.hs

@@ -1339,25 +1339,6 @@ notifyUser dir = \case
           push = P.group . P.backticked . IP.patternName $ IP.push
           pull = P.group . P.backticked . IP.patternName $ IP.pull
     GitCodebaseError e -> case e of
-      CouldntParseRemoteBranch repo s ->
-        P.wrap $
-          "I couldn't decode the root branch "
-            <> P.string s
-            <> "from the repository at"
-            <> prettyReadGitRepo repo
-      CouldntLoadRootBranch repo hash ->
-        P.wrap $
-          "I couldn't load the designated root hash"
-            <> P.group ("(" <> P.text (Hash.toBase32HexText $ unCausalHash hash) <> ")")
-            <> "from the repository at"
-            <> prettyReadGitRepo repo
-      CouldntLoadSyncedBranch ns h ->
-        P.wrap $
-          "I just finished importing the branch"
-            <> P.red (P.shown h)
-            <> "from"
-            <> P.red (prettyReadRemoteNamespaceWith absurd (RemoteRepo.ReadRemoteNamespaceGit ns))
-            <> "but now I can't find it."
       CouldntFindRemoteBranch repo path ->
         P.wrap $
           "I couldn't find the remote branch at"

unison-cli/unison-cli.cabal

@@ -34,6 +34,7 @@ library
       Unison.Auth.Tokens
       Unison.Auth.Types
       Unison.Auth.UserInfo
+      Unison.Cli.DownloadUtils
       Unison.Cli.Monad
       Unison.Cli.MonadUtils
       Unison.Cli.NamesUtils
@@ -165,6 +166,7 @@ library
       NamedFieldPuns
       NumericUnderscores
       OverloadedLabels
+      OverloadedRecordDot
       OverloadedStrings
       PatternSynonyms
       RankNTypes
@@ -303,6 +305,7 @@ executable transcripts
       NamedFieldPuns
       NumericUnderscores
       OverloadedLabels
+      OverloadedRecordDot
       OverloadedStrings
       PatternSynonyms
       RankNTypes
@@ -449,6 +452,7 @@ test-suite cli-tests
       NamedFieldPuns
       NumericUnderscores
       OverloadedLabels
+      OverloadedRecordDot
       OverloadedStrings
       PatternSynonyms
       RankNTypes