diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 9407de98f..d0bf1218b 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -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) diff --git a/unison-cli/package.yaml b/unison-cli/package.yaml index 4426f36f4..015c45849 100644 --- a/unison-cli/package.yaml +++ b/unison-cli/package.yaml @@ -189,6 +189,7 @@ default-extensions: - InstanceSigs - LambdaCase - MultiParamTypeClasses + - MultiWayIf - NamedFieldPuns - NumericUnderscores - OverloadedLabels diff --git a/unison-cli/src/Unison/Cli/ServantClientUtils.hs b/unison-cli/src/Unison/Cli/ServantClientUtils.hs new file mode 100644 index 000000000..af6723fec --- /dev/null +++ b/unison-cli/src/Unison/Cli/ServantClientUtils.hs @@ -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 diff --git a/unison-cli/src/Unison/Cli/Share/Projects.hs b/unison-cli/src/Unison/Cli/Share/Projects.hs index 53b4464f3..fd000bf36 100644 --- a/unison-cli/src/Unison/Cli/Share/Projects.hs +++ b/unison-cli/src/Unison/Cli/Share/Projects.hs @@ -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 diff --git a/unison-cli/src/Unison/Cli/Share/Projects/Types.hs b/unison-cli/src/Unison/Cli/Share/Projects/Types.hs index 3a4a11b12..699200413 100644 --- a/unison-cli/src/Unison/Cli/Share/Projects/Types.hs +++ b/unison-cli/src/Unison/Cli/Share/Projects/Types.hs @@ -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) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs index b45531485..2af88271a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs @@ -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 diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs index 766f0854b..b51d06967 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs @@ -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 diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index cca90f4c3..ed44ff4a7 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -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 diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 0a584444b..6451474ed 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -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" diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index ae3e40521..9c4df31a8 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -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