mirror of
https://github.com/unisonweb/unison.git
synced 2024-10-26 02:55:19 +03:00
download latest version of base on project.create
This commit is contained in:
parent
f28bb87d03
commit
bb818d5fec
@ -75,6 +75,7 @@ module U.Codebase.Sqlite.Queries
|
||||
-- ** causal table
|
||||
saveCausal,
|
||||
isCausalHash,
|
||||
causalExistsByHash32,
|
||||
expectCausal,
|
||||
loadCausalHashIdByCausalHash,
|
||||
expectCausalHashIdByCausalHash,
|
||||
@ -1215,6 +1216,19 @@ isCausalHash hash =
|
||||
)
|
||||
|]
|
||||
|
||||
-- | Return whether or not a causal exists with the given hash32.
|
||||
causalExistsByHash32 :: Hash32 -> Transaction Bool
|
||||
causalExistsByHash32 hash =
|
||||
queryOneCol
|
||||
[sql|
|
||||
SELECT EXISTS (
|
||||
SELECT 1
|
||||
FROM causal
|
||||
JOIN hash ON causal.self_hash_id = hash.id
|
||||
WHERE hash.base32 = :hash
|
||||
)
|
||||
|]
|
||||
|
||||
loadBranchObjectIdByCausalHashId :: CausalHashId -> Transaction (Maybe BranchObjectId)
|
||||
loadBranchObjectIdByCausalHashId id = queryMaybeCol (loadBranchObjectIdByCausalHashIdSql id)
|
||||
|
||||
|
@ -189,6 +189,7 @@ default-extensions:
|
||||
- InstanceSigs
|
||||
- LambdaCase
|
||||
- MultiParamTypeClasses
|
||||
- MultiWayIf
|
||||
- NamedFieldPuns
|
||||
- NumericUnderscores
|
||||
- OverloadedLabels
|
||||
|
35
unison-cli/src/Unison/Cli/ServantClientUtils.hs
Normal file
35
unison-cli/src/Unison/Cli/ServantClientUtils.hs
Normal file
@ -0,0 +1,35 @@
|
||||
-- | servant-client utilities
|
||||
module Unison.Cli.ServantClientUtils
|
||||
( ConnectionError (..),
|
||||
classifyConnectionError,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Exception (fromException)
|
||||
import Network.HTTP.Client qualified as HttpClient
|
||||
import System.IO.Error (isDoesNotExistError)
|
||||
import Unison.Prelude
|
||||
|
||||
data ConnectionError
|
||||
= ConnectionError'Offline
|
||||
| ConnectionError'SomethingElse HttpClient.HttpExceptionContent
|
||||
| ConnectionError'SomethingEntirelyUnexpected SomeException
|
||||
|
||||
-- | Given a 'SomeException' from a @servant-client@ 'ClientError', attempt to classify what happened.
|
||||
classifyConnectionError :: SomeException -> ConnectionError
|
||||
classifyConnectionError exception0 =
|
||||
case fromException exception0 of
|
||||
Just (HttpClient.HttpExceptionRequest _request content) ->
|
||||
fromMaybe (ConnectionError'SomethingElse content) do
|
||||
case content of
|
||||
HttpClient.ConnectionFailure exception1 -> do
|
||||
ioException <- fromException @IOException exception1
|
||||
if
|
||||
| -- This may not be 100% accurate... but if the initial `getAddrInfo` request fails it will indeed throw
|
||||
-- a "does not exist" error. It seems in order to *know* that `getAddrInfo` was the cause of this
|
||||
-- exception, we'd have to parse the `show` output, which is preposterous.
|
||||
isDoesNotExistError ioException ->
|
||||
Just ConnectionError'Offline
|
||||
| otherwise -> Nothing
|
||||
_ -> Nothing
|
||||
_ -> ConnectionError'SomethingEntirelyUnexpected exception0
|
@ -14,10 +14,12 @@ module Unison.Cli.Share.Projects
|
||||
-- * API functions
|
||||
getProjectById,
|
||||
getProjectByName,
|
||||
getProjectByName',
|
||||
createProject,
|
||||
GetProjectBranchResponse (..),
|
||||
getProjectBranchById,
|
||||
getProjectBranchByName,
|
||||
getProjectBranchByName',
|
||||
createProjectBranch,
|
||||
SetProjectBranchHeadResponse (..),
|
||||
setProjectBranchHead,
|
||||
@ -35,6 +37,7 @@ import Network.URI (URI)
|
||||
import Network.URI qualified as URI
|
||||
import Servant.API ((:<|>) (..), (:>))
|
||||
import Servant.Client
|
||||
import Servant.Client qualified as Servant
|
||||
import U.Codebase.Sqlite.DbId (RemoteProjectBranchId (..), RemoteProjectId (..))
|
||||
import U.Codebase.Sqlite.Queries qualified as Queries
|
||||
import Unison.Auth.HTTPClient qualified as Auth
|
||||
@ -54,16 +57,22 @@ import Unison.Share.Types (codeserverBaseURL)
|
||||
-- On success, update the `remote_project` table.
|
||||
getProjectById :: RemoteProjectId -> Cli (Maybe RemoteProject)
|
||||
getProjectById (RemoteProjectId projectId) = do
|
||||
response <- servantClientToCli (getProject0 (Just projectId) Nothing)
|
||||
response <- servantClientToCli (getProject0 (Just projectId) Nothing) & onLeftM servantClientError
|
||||
onGetProjectResponse response
|
||||
|
||||
-- | Get a project by name.
|
||||
--
|
||||
-- On success, update the `remote_project` table.
|
||||
getProjectByName :: ProjectName -> Cli (Maybe RemoteProject)
|
||||
getProjectByName projectName = do
|
||||
response <- servantClientToCli (getProject0 Nothing (Just (into @Text projectName)))
|
||||
onGetProjectResponse response
|
||||
getProjectByName projectName =
|
||||
getProjectByName' projectName & onLeftM servantClientError
|
||||
|
||||
-- | Variant of 'getProjectByName' that returns servant client errors.
|
||||
getProjectByName' :: ProjectName -> Cli (Either Servant.ClientError (Maybe RemoteProject))
|
||||
getProjectByName' projectName = do
|
||||
servantClientToCli (getProject0 Nothing (Just (into @Text projectName))) >>= \case
|
||||
Left err -> pure (Left err)
|
||||
Right response -> Right <$> onGetProjectResponse response
|
||||
|
||||
-- | Create a new project. Kinda weird: returns `Nothing` if the user handle part of the project doesn't exist.
|
||||
--
|
||||
@ -72,9 +81,10 @@ createProject :: ProjectName -> Cli (Maybe RemoteProject)
|
||||
createProject projectName = do
|
||||
let request = Share.API.CreateProjectRequest {projectName = into @Text projectName}
|
||||
servantClientToCli (createProject0 request) >>= \case
|
||||
Share.API.CreateProjectResponseNotFound {} -> pure Nothing
|
||||
Share.API.CreateProjectResponseUnauthorized x -> unauthorized x
|
||||
Share.API.CreateProjectResponseSuccess project -> Just <$> onGotProject project
|
||||
Left err -> servantClientError err
|
||||
Right (Share.API.CreateProjectResponseNotFound {}) -> pure Nothing
|
||||
Right (Share.API.CreateProjectResponseUnauthorized x) -> unauthorized x
|
||||
Right (Share.API.CreateProjectResponseSuccess project) -> Just <$> onGotProject project
|
||||
|
||||
data GetProjectBranchResponse
|
||||
= GetProjectBranchResponseBranchNotFound
|
||||
@ -86,7 +96,7 @@ data GetProjectBranchResponse
|
||||
-- On success, update the `remote_project_branch` table.
|
||||
getProjectBranchById :: ProjectAndBranch RemoteProjectId RemoteProjectBranchId -> Cli GetProjectBranchResponse
|
||||
getProjectBranchById (ProjectAndBranch (RemoteProjectId projectId) (RemoteProjectBranchId branchId)) = do
|
||||
response <- servantClientToCli (getProjectBranch0 projectId (Just branchId) Nothing)
|
||||
response <- servantClientToCli (getProjectBranch0 projectId (Just branchId) Nothing) & onLeftM servantClientError
|
||||
onGetProjectBranchResponse response
|
||||
|
||||
-- | Get a project branch by name.
|
||||
@ -94,19 +104,31 @@ getProjectBranchById (ProjectAndBranch (RemoteProjectId projectId) (RemoteProjec
|
||||
-- On success, update the `remote_project_branch` table.
|
||||
getProjectBranchByName :: ProjectAndBranch RemoteProjectId ProjectBranchName -> Cli GetProjectBranchResponse
|
||||
getProjectBranchByName (ProjectAndBranch (RemoteProjectId projectId) branchName) = do
|
||||
response <- servantClientToCli (getProjectBranch0 projectId Nothing (Just (into @Text branchName)))
|
||||
response <-
|
||||
servantClientToCli (getProjectBranch0 projectId Nothing (Just (into @Text branchName)))
|
||||
& onLeftM servantClientError
|
||||
onGetProjectBranchResponse response
|
||||
|
||||
-- | Variant of 'getProjectBranchByName' that returns servant client errors.
|
||||
getProjectBranchByName' ::
|
||||
ProjectAndBranch RemoteProjectId ProjectBranchName ->
|
||||
Cli (Either Servant.ClientError GetProjectBranchResponse)
|
||||
getProjectBranchByName' (ProjectAndBranch (RemoteProjectId projectId) branchName) = do
|
||||
servantClientToCli (getProjectBranch0 projectId Nothing (Just (into @Text branchName))) >>= \case
|
||||
Left err -> pure (Left err)
|
||||
Right response -> Right <$> onGetProjectBranchResponse response
|
||||
|
||||
-- | Create a new project branch.
|
||||
--
|
||||
-- On success, update the `remote_project_branch` table.
|
||||
createProjectBranch :: Share.API.CreateProjectBranchRequest -> Cli (Maybe RemoteProjectBranch)
|
||||
createProjectBranch request =
|
||||
servantClientToCli (createProjectBranch0 request) >>= \case
|
||||
Share.API.CreateProjectBranchResponseMissingCausalHash hash -> bugRemoteMissingCausalHash hash
|
||||
Share.API.CreateProjectBranchResponseNotFound {} -> pure Nothing
|
||||
Share.API.CreateProjectBranchResponseUnauthorized x -> unauthorized x
|
||||
Share.API.CreateProjectBranchResponseSuccess branch -> Just <$> onGotProjectBranch branch
|
||||
Left err -> servantClientError err
|
||||
Right (Share.API.CreateProjectBranchResponseMissingCausalHash hash) -> bugRemoteMissingCausalHash hash
|
||||
Right (Share.API.CreateProjectBranchResponseNotFound {}) -> pure Nothing
|
||||
Right (Share.API.CreateProjectBranchResponseUnauthorized x) -> unauthorized x
|
||||
Right (Share.API.CreateProjectBranchResponseSuccess branch) -> Just <$> onGotProjectBranch branch
|
||||
|
||||
data SetProjectBranchHeadResponse
|
||||
= SetProjectBranchHeadResponseNotFound
|
||||
@ -121,14 +143,15 @@ data SetProjectBranchHeadResponse
|
||||
setProjectBranchHead :: Share.API.SetProjectBranchHeadRequest -> Cli SetProjectBranchHeadResponse
|
||||
setProjectBranchHead request =
|
||||
servantClientToCli (setProjectBranchHead0 request) >>= \case
|
||||
Share.API.SetProjectBranchHeadResponseUnauthorized x -> unauthorized x
|
||||
Share.API.SetProjectBranchHeadResponseNotFound _ -> pure SetProjectBranchHeadResponseNotFound
|
||||
Share.API.SetProjectBranchHeadResponseMissingCausalHash hash -> bugRemoteMissingCausalHash hash
|
||||
Share.API.SetProjectBranchHeadResponseExpectedCausalHashMismatch expected actual ->
|
||||
Left err -> servantClientError err
|
||||
Right (Share.API.SetProjectBranchHeadResponseUnauthorized x) -> unauthorized x
|
||||
Right (Share.API.SetProjectBranchHeadResponseNotFound _) -> pure SetProjectBranchHeadResponseNotFound
|
||||
Right (Share.API.SetProjectBranchHeadResponseMissingCausalHash hash) -> bugRemoteMissingCausalHash hash
|
||||
Right (Share.API.SetProjectBranchHeadResponseExpectedCausalHashMismatch expected actual) ->
|
||||
pure (SetProjectBranchHeadResponseExpectedCausalHashMismatch expected actual)
|
||||
Share.API.SetProjectBranchHeadResponsePublishedReleaseIsImmutable -> pure SetProjectBranchHeadResponsePublishedReleaseIsImmutable
|
||||
Share.API.SetProjectBranchHeadResponseDeprecatedReleaseIsImmutable -> pure SetProjectBranchHeadResponseDeprecatedReleaseIsImmutable
|
||||
Share.API.SetProjectBranchHeadResponseSuccess -> pure SetProjectBranchHeadResponseSuccess
|
||||
Right (Share.API.SetProjectBranchHeadResponsePublishedReleaseIsImmutable) -> pure SetProjectBranchHeadResponsePublishedReleaseIsImmutable
|
||||
Right (Share.API.SetProjectBranchHeadResponseDeprecatedReleaseIsImmutable) -> pure SetProjectBranchHeadResponseDeprecatedReleaseIsImmutable
|
||||
Right (Share.API.SetProjectBranchHeadResponseSuccess) -> pure SetProjectBranchHeadResponseSuccess
|
||||
|
||||
------------------------------------------------------------------------------------------------------------------------
|
||||
-- Database manipulation callbacks
|
||||
@ -152,8 +175,9 @@ onGotProject :: Share.API.Project -> Cli RemoteProject
|
||||
onGotProject project = do
|
||||
let projectId = RemoteProjectId (project ^. #projectId)
|
||||
projectName <- validateProjectName (project ^. #projectName)
|
||||
let latestRelease = (project ^. #latestRelease) >>= eitherToMaybe . tryFrom @Text
|
||||
Cli.runTransaction (Queries.ensureRemoteProject projectId hardCodedUri projectName)
|
||||
pure RemoteProject {projectId, projectName}
|
||||
pure RemoteProject {projectId, projectName, latestRelease}
|
||||
|
||||
onGotProjectBranch :: Share.API.ProjectBranch -> Cli RemoteProjectBranch
|
||||
onGotProjectBranch branch = do
|
||||
@ -186,6 +210,10 @@ validateBranchName branchName =
|
||||
tryInto @ProjectBranchName branchName & onLeft \_ ->
|
||||
Cli.returnEarly (Output.InvalidProjectBranchName branchName)
|
||||
|
||||
servantClientError :: Servant.ClientError -> Cli void
|
||||
servantClientError =
|
||||
Cli.returnEarly . Output.ServantClientError
|
||||
|
||||
unauthorized :: Share.API.Unauthorized -> Cli void
|
||||
unauthorized (Share.API.Unauthorized message) =
|
||||
Cli.returnEarly (Output.Unauthorized message)
|
||||
@ -210,7 +238,7 @@ hardCodedUri =
|
||||
Nothing -> error ("BaseUrl is an invalid URI: " ++ showBaseUrl hardCodedBaseUrl)
|
||||
Just uri -> uri
|
||||
|
||||
servantClientToCli :: ClientM a -> Cli a
|
||||
servantClientToCli :: ClientM a -> Cli (Either Servant.ClientError a)
|
||||
servantClientToCli action = do
|
||||
Cli.Env {authHTTPClient = Auth.AuthenticatedHttpClient httpManager} <- ask
|
||||
|
||||
@ -218,8 +246,7 @@ servantClientToCli action = do
|
||||
clientEnv =
|
||||
mkClientEnv httpManager hardCodedBaseUrl
|
||||
|
||||
liftIO (runClientM action clientEnv) & onLeftM \err ->
|
||||
Cli.returnEarly (Output.ServantClientError err)
|
||||
liftIO (runClientM action clientEnv)
|
||||
|
||||
getProject0 :: Maybe Text -> Maybe Text -> ClientM Share.API.GetProjectResponse
|
||||
createProject0 :: Share.API.CreateProjectRequest -> ClientM Share.API.CreateProjectResponse
|
||||
|
@ -9,13 +9,14 @@ where
|
||||
|
||||
import U.Codebase.Sqlite.DbId (RemoteProjectBranchId (..), RemoteProjectId (..))
|
||||
import Unison.Prelude
|
||||
import Unison.Project (ProjectBranchName, ProjectName)
|
||||
import Unison.Project (ProjectBranchName, ProjectName, Semver)
|
||||
import Unison.Share.API.Hash qualified as Share.API
|
||||
|
||||
-- | A remote project.
|
||||
data RemoteProject = RemoteProject
|
||||
{ projectId :: RemoteProjectId,
|
||||
projectName :: ProjectName
|
||||
projectName :: ProjectName,
|
||||
latestRelease :: Maybe Semver
|
||||
}
|
||||
deriving stock (Eq, Generic, Show)
|
||||
|
||||
|
@ -4,6 +4,9 @@ module Unison.Codebase.Editor.HandleInput.ProjectCreate
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Lens (over, (^.))
|
||||
import Control.Monad.Reader (ask)
|
||||
import Data.Map.Strict qualified as Map
|
||||
import Data.Text qualified as Text
|
||||
import Data.UUID.V4 qualified as UUID
|
||||
import System.Random.Shuffle qualified as RandomShuffle
|
||||
@ -14,12 +17,19 @@ import Unison.Cli.Monad (Cli)
|
||||
import Unison.Cli.Monad qualified as Cli
|
||||
import Unison.Cli.MonadUtils qualified as Cli (stepAt)
|
||||
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.Name qualified as Name
|
||||
import Unison.NameSegment (NameSegment (NameSegment))
|
||||
import Unison.Prelude
|
||||
import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName)
|
||||
import Unison.Share.API.Hash qualified as Share.API
|
||||
import Unison.Sqlite qualified as Sqlite
|
||||
import Unison.Sync.Common qualified as Sync.Common
|
||||
import Witch (unsafeFrom)
|
||||
|
||||
-- | Create a new project.
|
||||
@ -78,10 +88,64 @@ projectCreate maybeProjectName = do
|
||||
True -> pure (Left (Output.ProjectNameAlreadyExists projectName))
|
||||
|
||||
let path = projectBranchPath ProjectAndBranch {project = projectId, branch = branchId}
|
||||
Cli.stepAt "project.create" (Path.unabsolute path, const Branch.empty0)
|
||||
Cli.respond (Output.CreatedProject (isNothing maybeProjectName) projectName)
|
||||
Cli.cd path
|
||||
|
||||
Cli.respond Output.FetchingLatestReleaseOfBase
|
||||
|
||||
-- Make an effort to pull the latest release of base, which can go wrong in a number of ways, the most likely of
|
||||
-- which is that the user is offline.
|
||||
maybeBaseLatestReleaseBranchObject <-
|
||||
Cli.label \done -> do
|
||||
baseProject <-
|
||||
Share.getProjectByName' (unsafeFrom @Text "@unison/base") >>= \case
|
||||
Right (Just baseProject) -> pure baseProject
|
||||
_ -> done Nothing
|
||||
ver <- baseProject ^. #latestRelease & onNothing (done Nothing)
|
||||
let baseProjectId = baseProject ^. #projectId
|
||||
let baseLatestReleaseBranchName = unsafeFrom @Text ("releases/" <> into @Text ver)
|
||||
response <-
|
||||
Share.getProjectBranchByName' (ProjectAndBranch baseProjectId baseLatestReleaseBranchName)
|
||||
& onLeftM \_err -> done Nothing
|
||||
baseLatestReleaseBranch <-
|
||||
case response of
|
||||
Share.GetProjectBranchResponseBranchNotFound -> done Nothing
|
||||
Share.GetProjectBranchResponseProjectNotFound -> done Nothing
|
||||
Share.GetProjectBranchResponseSuccess branch -> pure branch
|
||||
Pull.downloadShareProjectBranch baseLatestReleaseBranch
|
||||
Cli.Env {codebase} <- ask
|
||||
baseLatestReleaseBranchObject <-
|
||||
liftIO $
|
||||
Codebase.expectBranchForHash
|
||||
codebase
|
||||
(Sync.Common.hash32ToCausalHash (Share.API.hashJWTHash (baseLatestReleaseBranch ^. #branchHead)))
|
||||
pure (Just baseLatestReleaseBranchObject)
|
||||
|
||||
let reflogDescription =
|
||||
case maybeProjectName of
|
||||
Nothing -> "project.create"
|
||||
Just projectName -> "project.create " <> into @Text projectName
|
||||
|
||||
let projectBranchObject =
|
||||
case maybeBaseLatestReleaseBranchObject of
|
||||
Nothing -> Branch.empty0
|
||||
Just baseLatestReleaseBranchObject ->
|
||||
let -- lib.base
|
||||
projectBranchLibBaseObject =
|
||||
over
|
||||
Branch.children
|
||||
(Map.insert (NameSegment "base") baseLatestReleaseBranchObject)
|
||||
Branch.empty0
|
||||
projectBranchLibObject = Branch.cons projectBranchLibBaseObject Branch.empty
|
||||
in over
|
||||
Branch.children
|
||||
(Map.insert Name.libSegment projectBranchLibObject)
|
||||
Branch.empty0
|
||||
|
||||
Cli.stepAt reflogDescription (Path.unabsolute path, const projectBranchObject)
|
||||
|
||||
Cli.respond Output.HappyCoding
|
||||
|
||||
insertProjectAndBranch :: ProjectId -> ProjectName -> ProjectBranchId -> ProjectBranchName -> Sqlite.Transaction ()
|
||||
insertProjectAndBranch projectId projectName branchId branchName = do
|
||||
Queries.insertProject projectId projectName
|
||||
|
@ -5,6 +5,7 @@ module Unison.Codebase.Editor.HandleInput.Pull
|
||||
loadPropagateDiffDefaultPatch,
|
||||
mergeBranchAndPropagateDefaultPatch,
|
||||
propagatePatch,
|
||||
downloadShareProjectBranch,
|
||||
withEntitiesDownloadedProgressCallback,
|
||||
)
|
||||
where
|
||||
@ -180,23 +181,28 @@ loadRemoteNamespaceIntoMemory syncMode pullMode remoteNamespace = do
|
||||
Cli.returnEarly (Output.GitError err)
|
||||
ReadShare'LooseCode repo -> loadShareLooseCodeIntoMemory repo
|
||||
ReadShare'ProjectBranch remoteBranch -> do
|
||||
let repoInfo = Share.RepoInfo (into @Text (ProjectAndBranch (remoteBranch ^. #projectName) remoteProjectBranchName))
|
||||
causalHash = Common.hash32ToCausalHash . Share.hashJWTHash $ causalHashJwt
|
||||
causalHashJwt = remoteBranch ^. #branchHead
|
||||
remoteProjectBranchName = remoteBranch ^. #branchName
|
||||
(result, numDownloaded) <-
|
||||
Cli.with withEntitiesDownloadedProgressCallback \(downloadedCallback, getNumDownloaded) -> do
|
||||
result <- Share.downloadEntities Share.hardCodedBaseUrl repoInfo causalHashJwt 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 () -> do
|
||||
Cli.respond (Output.DownloadedEntities numDownloaded)
|
||||
liftIO (Codebase.expectBranchForHash codebase causalHash)
|
||||
downloadShareProjectBranch remoteBranch
|
||||
let causalHash = Common.hash32ToCausalHash (Share.hashJWTHash (remoteBranch ^. #branchHead))
|
||||
liftIO (Codebase.expectBranchForHash codebase causalHash)
|
||||
|
||||
-- | @downloadShareProjectBranch branch@ downloads the given branch.
|
||||
downloadShareProjectBranch :: Share.RemoteProjectBranch -> Cli ()
|
||||
downloadShareProjectBranch branch = do
|
||||
let repoInfo = Share.RepoInfo (into @Text (ProjectAndBranch (branch ^. #projectName) remoteProjectBranchName))
|
||||
causalHashJwt = branch ^. #branchHead
|
||||
remoteProjectBranchName = branch ^. #branchName
|
||||
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)
|
||||
|
||||
loadShareLooseCodeIntoMemory :: ReadShareLooseCode -> Cli (Branch IO)
|
||||
loadShareLooseCodeIntoMemory rrn@(ReadShareLooseCode {server, repo, path}) = do
|
||||
|
@ -373,6 +373,8 @@ data Output
|
||||
| RenamedProject ProjectName ProjectName
|
||||
| RenamedProjectBranch ProjectName ProjectBranchName ProjectBranchName
|
||||
| CantRenameBranchTo ProjectBranchName
|
||||
| FetchingLatestReleaseOfBase
|
||||
| HappyCoding
|
||||
|
||||
-- | What did we create a project branch from?
|
||||
--
|
||||
@ -588,6 +590,8 @@ isFailure o = case o of
|
||||
RenamedProject {} -> False
|
||||
RenamedProjectBranch {} -> False
|
||||
CantRenameBranchTo {} -> True
|
||||
FetchingLatestReleaseOfBase {} -> False
|
||||
HappyCoding {} -> False
|
||||
|
||||
isNumberedFailure :: NumberedOutput -> Bool
|
||||
isNumberedFailure = \case
|
||||
|
@ -43,6 +43,7 @@ import Unison.Auth.Types qualified as Auth
|
||||
import Unison.Builtin.Decls qualified as DD
|
||||
import Unison.Cli.Pretty
|
||||
import Unison.Cli.ProjectUtils qualified as ProjectUtils
|
||||
import Unison.Cli.ServantClientUtils qualified as ServantClientUtils
|
||||
import Unison.Codebase.Editor.DisplayObject (DisplayObject (BuiltinObject, MissingObject, UserObject))
|
||||
import Unison.Codebase.Editor.Input qualified as Input
|
||||
import Unison.Codebase.Editor.Output
|
||||
@ -1944,7 +1945,13 @@ notifyUser dir = \case
|
||||
P.text ("Unauthorized: " <> message)
|
||||
ServantClientError err ->
|
||||
pure case err of
|
||||
Servant.ConnectionError _exception -> P.wrap "Something went wrong with the connection. Try again?"
|
||||
Servant.ConnectionError exception ->
|
||||
P.wrap $
|
||||
fromMaybe "Something went wrong with the connection. Try again?" do
|
||||
case ServantClientUtils.classifyConnectionError exception of
|
||||
ServantClientUtils.ConnectionError'Offline -> Just "You appear to be offline."
|
||||
ServantClientUtils.ConnectionError'SomethingElse _ -> Nothing
|
||||
ServantClientUtils.ConnectionError'SomethingEntirelyUnexpected _ -> Nothing
|
||||
Servant.DecodeFailure message response ->
|
||||
P.wrap "Huh, I failed to decode a response from the server."
|
||||
<> P.newline
|
||||
@ -2092,6 +2099,32 @@ notifyUser dir = \case
|
||||
CantRenameBranchTo branch ->
|
||||
pure . P.wrap $
|
||||
"You can't rename a branch to" <> P.group (prettyProjectBranchName branch <> ".")
|
||||
FetchingLatestReleaseOfBase ->
|
||||
pure . P.wrap $
|
||||
"I'll now fetch the latest version of the base Unison library..."
|
||||
HappyCoding ->
|
||||
pure $
|
||||
P.wrap "🎨 Type `ui` to explore this project's code in your browser."
|
||||
<> P.newline
|
||||
<> P.wrap "🌏 Discover libraries at https://share.unison-lang.org"
|
||||
<> P.newline
|
||||
<> P.wrap "📖 Use `help-topic projects` to learn more about projects."
|
||||
<> P.newline
|
||||
<> P.newline
|
||||
<> P.wrap "Write your first Unison code with UCM:"
|
||||
<> P.newline
|
||||
<> P.newline
|
||||
<> P.indentN
|
||||
2
|
||||
( P.wrap "1. Open scratch.u."
|
||||
<> P.newline
|
||||
<> P.wrap "2. Write some Unison code and save the file."
|
||||
<> P.newline
|
||||
<> P.wrap "3. In UCM, type `add` to save it to your new project."
|
||||
)
|
||||
<> P.newline
|
||||
<> P.newline
|
||||
<> P.wrap "🎉 🥳 Happy coding!"
|
||||
where
|
||||
_nameChange _cmd _pastTenseCmd _oldName _newName _r = error "todo"
|
||||
|
||||
|
@ -37,6 +37,7 @@ library
|
||||
Unison.Cli.Pretty
|
||||
Unison.Cli.PrettyPrintUtils
|
||||
Unison.Cli.ProjectUtils
|
||||
Unison.Cli.ServantClientUtils
|
||||
Unison.Cli.Share.Projects
|
||||
Unison.Cli.Share.Projects.Types
|
||||
Unison.Cli.TypeCheck
|
||||
@ -132,6 +133,7 @@ library
|
||||
InstanceSigs
|
||||
LambdaCase
|
||||
MultiParamTypeClasses
|
||||
MultiWayIf
|
||||
NamedFieldPuns
|
||||
NumericUnderscores
|
||||
OverloadedLabels
|
||||
@ -261,6 +263,7 @@ executable cli-integration-tests
|
||||
InstanceSigs
|
||||
LambdaCase
|
||||
MultiParamTypeClasses
|
||||
MultiWayIf
|
||||
NamedFieldPuns
|
||||
NumericUnderscores
|
||||
OverloadedLabels
|
||||
@ -390,6 +393,7 @@ executable transcripts
|
||||
InstanceSigs
|
||||
LambdaCase
|
||||
MultiParamTypeClasses
|
||||
MultiWayIf
|
||||
NamedFieldPuns
|
||||
NumericUnderscores
|
||||
OverloadedLabels
|
||||
@ -523,6 +527,7 @@ executable unison
|
||||
InstanceSigs
|
||||
LambdaCase
|
||||
MultiParamTypeClasses
|
||||
MultiWayIf
|
||||
NamedFieldPuns
|
||||
NumericUnderscores
|
||||
OverloadedLabels
|
||||
@ -662,6 +667,7 @@ test-suite cli-tests
|
||||
InstanceSigs
|
||||
LambdaCase
|
||||
MultiParamTypeClasses
|
||||
MultiWayIf
|
||||
NamedFieldPuns
|
||||
NumericUnderscores
|
||||
OverloadedLabels
|
||||
|
Loading…
Reference in New Issue
Block a user