Checkpoint

parser-typechecker/src/Unison/Codebase.hs

@@ -50,7 +50,7 @@ module Unison.Codebase
     getShallowCausalAtPath,
     getBranchAtPath,
     Operations.expectCausalBranchByCausalHash,
-    getShallowCausalFromRoot,
+    getShallowCausalAtPathFromRootHash,
     getShallowRootBranch,
     getShallowRootCausal,
     getShallowProjectRootBranch,
@@ -184,15 +184,13 @@ runTransactionWithRollback ::
 runTransactionWithRollback Codebase {withConnection} action =
   withConnection \conn -> Sqlite.runTransactionWithRollback conn action
 
-getShallowCausalFromRoot ::
+getShallowCausalAtPathFromRootHash ::
-  -- Optional root branch, if Nothing use the codebase's root branch.
+  -- Causal to start at, if Nothing use the codebase's root branch.
-  Maybe CausalHash ->
+  CausalHash ->
   Path.Path ->
   Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction)
-getShallowCausalFromRoot mayRootHash p = do
+getShallowCausalAtPathFromRootHash rootCausalHash p = do
-  rootCausal <- case mayRootHash of
+  rootCausal <- Operations.expectCausalBranchByCausalHash rootCausalHash
-    Nothing -> getShallowRootCausal
-    Just ch -> Operations.expectCausalBranchByCausalHash ch
   getShallowCausalAtPath p (Just rootCausal)
 
 -- | Get the shallow representation of the root branches without loading the children or
@@ -240,19 +238,18 @@ getShallowBranchAtPath path branch = do
           childBranch <- V2Causal.value childCausal
           getShallowBranchAtPath p childBranch
 
-getShallowProjectRootBranch :: Db.ProjectId -> Db.ProjectBranchId -> Sqlite.Transaction (V2Branch.Branch Sqlite.Transaction)
+getShallowProjectRootBranch :: ProjectBranch -> Sqlite.Transaction (V2Branch.Branch Sqlite.Transaction)
-getShallowProjectRootBranch projectId projectBranchId = do
+getShallowProjectRootBranch ProjectBranch {causalHashId} = do
-  ProjectBranch {causalHashId} <- Q.expectProjectBranch projectId projectBranchId
   causalHash <- Q.expectCausalHash causalHashId
   Operations.expectCausalBranchByCausalHash causalHash >>= V2Causal.value
 
 -- | Recursively descend into causals following the given path,
 -- Use the root causal if none is provided.
 getShallowBranchAtProjectPath ::
-  PP.ProjectPathIds ->
+  PP.ProjectPath ->
   Sqlite.Transaction (V2Branch.Branch Sqlite.Transaction)
-getShallowBranchAtProjectPath (PP.ProjectPath projectId projectBranchId path) = do
+getShallowBranchAtProjectPath (PP.ProjectPath _project projectBranch path) = do
-  projectRootBranch <- getShallowProjectRootBranch projectId projectBranchId
+  projectRootBranch <- getShallowProjectRootBranch projectBranch
   getShallowBranchAtPath (Path.unabsolute path) projectRootBranch
 
 getShallowProjectRootByNames :: ProjectAndBranch ProjectName ProjectBranchName -> Sqlite.Transaction (Maybe (V2Branch.CausalBranch Sqlite.Transaction))

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

@@ -11,8 +11,6 @@ module Unison.Codebase.ProjectPath
     asIds_,
     asNames_,
     asProjectAndBranch_,
-    project_,
-    branch_,
   )
 where
 
@@ -27,11 +25,11 @@ import Unison.Prelude
 import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName)
 
 data ProjectPathG proj branch = ProjectPath
-  { projPathProject :: proj,
+  { project :: proj,
-    projPathBranch :: branch,
+    branch :: branch,
-    projPathPath :: Path.Absolute
+    absPath :: Path.Absolute
   }
-  deriving stock (Eq, Ord, Show)
+  deriving stock (Eq, Ord, Show, Generic)
 
 type ProjectPathIds = ProjectPathG ProjectId ProjectBranchId
 
@@ -42,18 +40,6 @@ type ProjectPath = ProjectPathG Project ProjectBranch
 fromProjectAndBranch :: ProjectAndBranch Project ProjectBranch -> Path.Absolute -> ProjectPath
 fromProjectAndBranch (ProjectAndBranch proj branch) path = ProjectPath proj branch path
 
-project_ :: Lens' (ProjectPathG p b) p
-project_ = lens get set
-  where
-    get (ProjectPath p _ _) = p
-    set (ProjectPath _ b path) p = ProjectPath p b path
-
-branch_ :: Lens' (ProjectPathG p b) b
-branch_ = lens get set
-  where
-    get (ProjectPath _ b _) = b
-    set (ProjectPath p _ path) b = ProjectPath p b path
-
 -- | Project a project context into a project path of just IDs
 asIds_ :: Lens' ProjectPath ProjectPathIds
 asIds_ = lens get set
@@ -61,8 +47,8 @@ asIds_ = lens get set
     get (ProjectPath proj branch path) = ProjectPath (proj ^. #projectId) (branch ^. #branchId) path
     set p (ProjectPath pId bId path) =
       p
-        & project_ . #projectId .~ pId
+        & #project . #projectId .~ pId
-        & branch_ . #branchId .~ bId
+        & #branch . #branchId .~ bId
         & absPath_ .~ path
 
 -- | Project a project context into a project path of just names
@@ -72,15 +58,15 @@ asNames_ = lens get set
     get (ProjectPath proj branch path) = ProjectPath (proj ^. #name) (branch ^. #name) path
     set p (ProjectPath pName bName path) =
       p
-        & project_ . #name .~ pName
+        & #project . #name .~ pName
-        & branch_ . #name .~ bName
+        & #branch . #name .~ bName
         & absPath_ .~ path
 
 asProjectAndBranch_ :: Lens' ProjectPath (ProjectAndBranch Project ProjectBranch)
 asProjectAndBranch_ = lens get set
   where
     get (ProjectPath proj branch _) = ProjectAndBranch proj branch
-    set p (ProjectAndBranch proj branch) = p & project_ .~ proj & branch_ .~ branch
+    set p (ProjectAndBranch proj branch) = p & #project .~ proj & #branch .~ branch
 
 instance Bifunctor ProjectPathG where
   bimap f g (ProjectPath p b path) = ProjectPath (f p) (g b) path

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

@@ -8,7 +8,7 @@ module Unison.Cli.MonadUtils
     getCurrentPath,
     getCurrentProjectName,
     getCurrentProjectBranchName,
-    getProjectPath,
+    getCurrentProjectPath,
     resolvePath,
     resolvePath',
     resolveSplit',
@@ -95,8 +95,6 @@ import U.Codebase.Branch qualified as V2 (Branch)
 import U.Codebase.Branch qualified as V2Branch
 import U.Codebase.Causal qualified as V2Causal
 import U.Codebase.HashTags (CausalHash (..))
-import U.Codebase.Sqlite.Project (Project (..))
-import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..))
 import U.Codebase.Sqlite.Queries qualified as Q
 import Unison.Cli.Monad (Cli)
 import Unison.Cli.Monad qualified as Cli
@@ -146,28 +144,28 @@ getConfig key = do
 ------------------------------------------------------------------------------------------------------------------------
 -- Getting paths, path resolution, etc.
 
-getProjectPath :: Cli PP.ProjectPath
+getCurrentProjectPath :: Cli PP.ProjectPath
-getProjectPath = do
+getCurrentProjectPath = do
   (PP.ProjectPath projId branchId path) <- Cli.getProjectPathIds
   -- TODO: Reset to a valid project on error.
-  (Project {name = projName}, ProjectBranch {name = branchName}) <- fmap (fromMaybe (error $ reportBug "E794202" ("Project branch not found in database for ids: " <> show (projId, branchId)))) . Cli.runTransaction . runMaybeT $ do
+  (proj, branch) <- fmap (fromMaybe (error $ reportBug "E794202" ("Project branch not found in database for ids: " <> show (projId, branchId)))) . Cli.runTransaction . runMaybeT $ do
     project <- MaybeT $ Q.loadProject projId
     branch <- MaybeT $ Q.loadProjectBranch projId branchId
     pure (project, branch)
-  pure (PP.ProjectPath (projId, projName) (branchId, branchName) path)
+  pure (PP.ProjectPath proj branch path)
 
 -- | Get the current path relative to the current project.
 getCurrentPath :: Cli Path.Absolute
 getCurrentPath = do
-  view PP.absPath_ <$> getProjectPath
+  view PP.absPath_ <$> getCurrentProjectPath
 
 getCurrentProjectName :: Cli ProjectName
 getCurrentProjectName = do
-  view (PP.ctxAsNames_ . PP.project_) <$> getProjectPath
+  view (PP.asNames_ . #project) <$> getCurrentProjectPath
 
 getCurrentProjectBranchName :: Cli ProjectBranchName
 getCurrentProjectBranchName = do
-  view (PP.ctxAsNames_ . PP.branch_) <$> getProjectPath
+  view (PP.asNames_ . #branch) <$> getCurrentProjectPath
 
 -- | Resolve a @Path@ (interpreted as relative) to a @Path.Absolute@, per the current path.
 resolvePath :: Path -> Cli Path.Absolute

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

@@ -13,8 +13,6 @@ module Unison.Cli.ProjectUtils
     expectProjectAndBranchByIds,
     getProjectAndBranchByTheseNames,
     expectProjectAndBranchByTheseNames,
-    getCurrentProject,
-    getCurrentProjectBranch,
 
     -- * Loading remote project info
     expectRemoteProjectById,
@@ -40,7 +38,6 @@ import Data.These (These (..))
 import U.Codebase.Sqlite.DbId
 import U.Codebase.Sqlite.Project (Project)
 import U.Codebase.Sqlite.Project qualified as Sqlite
-import U.Codebase.Sqlite.ProjectBranch (ProjectBranch)
 import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite
 import U.Codebase.Sqlite.Queries qualified as Queries
 import Unison.Cli.Monad (Cli)
@@ -66,13 +63,13 @@ resolveBranchRelativePath brp = do
   case brp of
     BranchPathInCurrentProject projBranchName path -> do
       projectAndBranch <- expectProjectAndBranchByTheseNames (That projBranchName)
-      pure $ PP.ctxFromProjectAndBranch projectAndBranch path
+      pure $ PP.fromProjectAndBranch projectAndBranch path
     QualifiedBranchPath projName projBranchName path -> do
       projectAndBranch <- expectProjectAndBranchByTheseNames (These projName projBranchName)
-      pure $ PP.ctxFromProjectAndBranch projectAndBranch path
+      pure $ PP.fromProjectAndBranch projectAndBranch path
     UnqualifiedPath newPath' -> do
-      ppCtx <- Cli.getProjectPath
+      pp <- Cli.getCurrentProjectPath
-      pure $ ppCtx & PP.absPath_ %~ \curPath -> Path.resolve curPath newPath'
+      pure $ pp & PP.absPath_ %~ \curPath -> Path.resolve curPath newPath'
 
 -- @findTemporaryBranchName projectId preferred@ finds some unused branch name in @projectId@ with a name
 -- like @preferred@.
@@ -95,20 +92,6 @@ findTemporaryBranchName projectId preferred = do
 
   pure (fromJust (List.find (\name -> not (Set.member name allBranchNames)) allCandidates))
 
--- | Get the current project+branch+branch path that a user is on.
-getCurrentProjectBranch :: Cli (PP.ProjectPath Sqlite.Project Sqlite.ProjectBranch)
-getCurrentProjectBranch = do
-  ppCtx <- Cli.getProjectPath
-  Cli.runTransaction $ do
-    proj <- Queries.expectProject (ppCtx ^. PP.ctxAsIds_ . PP.project_)
-    branch <- Queries.expectProjectBranch (proj ^. #projectId) (ppCtx ^. PP.ctxAsIds_ . PP.branch_)
-    pure $ PP.ProjectPath proj branch (ppCtx ^. PP.absPath_)
-
-getCurrentProject :: Cli Sqlite.Project
-getCurrentProject = do
-  ppCtx <- Cli.getProjectPath
-  Cli.runTransaction (Queries.expectProject (ppCtx ^. PP.ctxAsIds_ . PP.project_))
-
 expectProjectBranchByName :: Sqlite.Project -> ProjectBranchName -> Cli Sqlite.ProjectBranch
 expectProjectBranchByName project branchName =
   Cli.runTransaction (Queries.loadProjectBranchByName (project ^. #projectId) branchName) & onNothingM do
@@ -124,8 +107,8 @@ hydrateNames :: These ProjectName ProjectBranchName -> Cli (ProjectAndBranch Pro
 hydrateNames = \case
   This projectName -> pure (ProjectAndBranch projectName (unsafeFrom @Text "main"))
   That branchName -> do
-    ppCtx <- Cli.getProjectPath
+    pp <- Cli.getCurrentProjectPath
-    pure (ProjectAndBranch (ppCtx ^. PP.ctxAsNames_ . PP.project_) branchName)
+    pure (ProjectAndBranch (pp ^. PP.asNames_ . #project) branchName)
   These projectName branchName -> pure (ProjectAndBranch projectName branchName)
 
 -- Expect a local project+branch by ids.
@@ -147,9 +130,9 @@ getProjectAndBranchByTheseNames ::
 getProjectAndBranchByTheseNames = \case
   This projectName -> getProjectAndBranchByTheseNames (These projectName (unsafeFrom @Text "main"))
   That branchName -> runMaybeT do
-    currentProjectBranch <- lift getCurrentProjectBranch
+    (PP.ProjectPath proj _branch _path) <- lift Cli.getCurrentProjectPath
-    branch <- MaybeT (Cli.runTransaction (Queries.loadProjectBranchByName (currentProjectBranch ^. PP.project_ . #projectId) branchName))
+    branch <- MaybeT (Cli.runTransaction (Queries.loadProjectBranchByName (proj ^. #projectId) branchName))
-    pure (ProjectAndBranch (currentProjectBranch ^. PP.project_) branch)
+    pure (ProjectAndBranch proj branch)
   These projectName branchName -> do
     Cli.runTransaction do
       runMaybeT do
@@ -167,7 +150,7 @@ expectProjectAndBranchByTheseNames ::
 expectProjectAndBranchByTheseNames = \case
   This projectName -> expectProjectAndBranchByTheseNames (These projectName (unsafeFrom @Text "main"))
   That branchName -> do
-    PP.ProjectPath project _branch _restPath <- getCurrentProjectBranch
+    PP.ProjectPath project _branch _restPath <- Cli.getCurrentProjectPath
     branch <-
       Cli.runTransaction (Queries.loadProjectBranchByName (project ^. #projectId) branchName) & onNothingM do
         Cli.returnEarly (LocalProjectBranchDoesntExist (ProjectAndBranch (project ^. #name) branchName))
@@ -188,21 +171,21 @@ expectProjectAndBranchByTheseNames = \case
 --   2. If we have an unambiguous `/branch` or `project/branch`, resolve it using the current
 --      project, defaulting to 'main' if branch is unspecified.
 --   3. If we just have a path, resolve it using the current project.
-resolveProjectPath :: PP.ProjectPath -> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName) -> Maybe Path' -> Cli PP.ProjectPath
+resolveProjectPath :: Project -> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName) -> Maybe Path' -> Cli PP.ProjectPath
-resolveProjectPath ppCtx mayProjAndBranch mayPath' = do
+resolveProjectPath defaultProj mayProjAndBranch mayPath' = do
-  projAndBranch <- resolveProjectBranch ppCtx mayProjAndBranch
+  projAndBranch <- resolveProjectBranch defaultProj mayProjAndBranch
   absPath <- fromMaybe Path.absoluteEmpty <$> traverse Cli.resolvePath' mayPath'
-  pure $ PP.ctxFromProjectAndBranch projAndBranch absPath
+  pure $ PP.fromProjectAndBranch projAndBranch absPath
 
 -- | Expect/resolve branch reference with the following rules:
 --
 --   1. If the project is missing, use the provided project.
 --   2. If we have an unambiguous `/branch` or `project/branch`, resolve it using the provided
 --      project, defaulting to 'main' if branch is unspecified.
-resolveProjectBranch :: ProjectAndBranch Project ProjectBranch -> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName) -> Cli (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)
+resolveProjectBranch :: Project -> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName) -> Cli (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)
-resolveProjectBranch ppCtx (ProjectAndBranch mayProjectName mayBranchName) = do
+resolveProjectBranch defaultProj (ProjectAndBranch mayProjectName mayBranchName) = do
   let branchName = fromMaybe (unsafeFrom @Text "main") mayBranchName
-  let projectName = fromMaybe (ppCtx ^. PP.ctxAsNames_ . PP.project_) mayProjectName
+  let projectName = fromMaybe (defaultProj ^. #name) mayProjectName
   projectAndBranch <- expectProjectAndBranchByTheseNames (These projectName branchName)
   pure projectAndBranch
 
@@ -289,7 +272,7 @@ expectRemoteProjectBranchByTheseNames includeSquashed = \case
     let remoteBranchName = unsafeFrom @Text "main"
     expectRemoteProjectBranchByName includeSquashed (ProjectAndBranch (remoteProjectId, remoteProjectName) remoteBranchName)
   That branchName -> do
-    PP.ProjectPath localProject localBranch _restPath <- getCurrentProjectBranch
+    PP.ProjectPath localProject localBranch _restPath <- Cli.getCurrentProjectPath
     let localProjectId = localProject ^. #projectId
     let localBranchId = localBranch ^. #branchId
     Cli.runTransaction (Queries.loadRemoteProjectBranch localProjectId Share.hardCodedUri localBranchId) >>= \case

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

@@ -18,10 +18,8 @@ import Unison.Cli.Monad qualified as Cli
 import Unison.Cli.MonadUtils qualified as Cli
 import Unison.Cli.ProjectUtils qualified as ProjectUtils
 import Unison.Codebase qualified as Codebase
-import Unison.Codebase.Branch qualified as Branch (headHash)
 import Unison.Codebase.Editor.Input qualified as Input
 import Unison.Codebase.Editor.Output qualified as Output
-import Unison.Codebase.Path qualified as Path
 import Unison.Codebase.ProjectPath qualified as PP
 import Unison.Prelude
 import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectBranchNameKind (..), ProjectName, classifyProjectBranchName)
@@ -41,7 +39,7 @@ handleBranch sourceI projectAndBranchNames@(ProjectAndBranch mayProjectName newB
       Cli.returnEarly (Output.CannotCreateReleaseBranchWithBranchCommand newBranchName ver)
     ProjectBranchNameKind'NothingSpecial -> pure ()
 
-  currentProjectName <- Cli.getProjectPath <&> view (PP.ctxAsNames_ . PP.project_)
+  currentProjectName <- Cli.getCurrentProjectPath <&> view (PP.asNames_ . #project)
   destProject <- do
     Cli.runTransactionWithRollback
       \rollback -> do
@@ -51,22 +49,21 @@ handleBranch sourceI projectAndBranchNames@(ProjectAndBranch mayProjectName newB
           rollback (Output.LocalProjectBranchDoesntExist (ProjectAndBranch projectName newBranchName))
 
   -- Compute what we should create the branch from.
-  maySrcBranch <-
+  maySrcProjectAndBranch <-
     case sourceI of
-      Input.BranchSourceI'CurrentContext -> Just <$> ProjectUtils.getCurrentProjectBranch
+      Input.BranchSourceI'CurrentContext -> Just . view PP.projectAndBranch_ <$> Cli.getCurrentProjectPath
       Input.BranchSourceI'Empty -> pure Nothing
       Input.BranchSourceI'UnresolvedProjectBranch unresolvedProjectBranch -> do
-        ppCtx <- Cli.getProjectPath
+        pp <- Cli.getCurrentProjectPath
-        ProjectAndBranch _proj branch <- ProjectUtils.resolveProjectBranch ppCtx (unresolvedProjectBranch & #branch %~ Just)
+        Just <$> ProjectUtils.resolveProjectBranch (pp ^. #project) (unresolvedProjectBranch & #branch %~ Just)
-        pure $ Just branch
 
-  _ <- doCreateBranch maySrcBranch project newBranchName
+  _ <- doCreateBranch (view #branch <$> maySrcProjectAndBranch) destProject newBranchName
 
   Cli.respond $
     Output.CreatedProjectBranch
-      ( case maySrcBranch of
+      ( case maySrcProjectAndBranch of
           Just sourceBranch ->
-            if sourceBranch ^. #project . #projectId == project ^. #projectId
+            if sourceBranch ^. #project . #projectId == destProject ^. #projectId
               then Output.CreatedProjectBranchFrom'ParentBranch (sourceBranch ^. #branch . #name)
               else Output.CreatedProjectBranchFrom'OtherBranch sourceBranch
           Nothing -> Output.CreatedProjectBranchFrom'Nothingness
@@ -86,7 +83,7 @@ doCreateBranch ::
   -- If no parent branch is provided, make an empty branch.
   Maybe Sqlite.ProjectBranch ->
   Sqlite.Project ->
-  Sqlite.Transaction ProjectBranchName ->
+  ProjectBranchName ->
   Cli ProjectBranchId
 doCreateBranch mayParentBranch project getNewBranchName = do
   let projectId = project ^. #projectId

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

@@ -21,6 +21,7 @@ import Unison.Cli.ProjectUtils qualified as Project
 import Unison.Codebase (Codebase)
 import Unison.Codebase qualified as Codebase
 import Unison.Codebase.Path qualified as Path
+import Unison.Codebase.ProjectPath qualified as PP
 import Unison.Codebase.SqliteCodebase.Conversions qualified as Conversions
 import Unison.ConstructorType qualified as ConstructorType
 import Unison.HashQualified qualified as HQ
@@ -28,8 +29,7 @@ import Unison.Name (Name)
 import Unison.Name qualified as Name
 import Unison.Parser.Ann (Ann (..))
 import Unison.Prelude
-import Unison.Project (ProjectAndBranch)
+import Unison.Project (ProjectAndBranch (ProjectAndBranch))
-import Unison.Project.Util (projectBranchPath)
 import Unison.Referent qualified as Referent
 import Unison.Server.CodebaseServer qualified as Server
 import Unison.Sqlite qualified as Sqlite
@@ -39,37 +39,25 @@ import Web.Browser (openBrowser)
 openUI :: Path.Path' -> Cli ()
 openUI path' = do
   Cli.Env {serverBaseUrl} <- ask
-  currentPath <- Cli.getCurrentPath
+  defnPath <- Cli.resolvePath' path'
-  let absPath = Path.resolve currentPath path'
+  pp <- Cli.getCurrentProjectPath
   whenJust serverBaseUrl \url -> do
-    Project.getProjectBranchForPath absPath >>= \case
+    openUIForProject url pp defnPath
-      Nothing -> openUIForLooseCode url path'
-      Just (projectBranch, pathWithinBranch) -> openUIForProject url projectBranch pathWithinBranch
 
-openUIForProject :: Server.BaseUrl -> ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch -> Path.Path -> Cli ()
+openUIForProject :: Server.BaseUrl -> PP.ProjectPath -> Path.Absolute -> Cli ()
-openUIForProject url projectAndBranch pathFromProjectRoot = do
+openUIForProject url (PP.ProjectPath project projectBranch perspective) defnPath = do
-  currentPath <- Cli.getCurrentPath
-  perspective <-
-    Project.getProjectBranchForPath currentPath <&> \case
-      Nothing ->
-        -- The current path is outside the project the argument was in. Use the project root
-        -- as the perspective.
-        Path.empty
-      Just (_projectBranch, pathWithinBranch) -> pathWithinBranch
   mayDefinitionRef <- getDefinitionRef perspective
-  let projectBranchNames = bimap Project.name ProjectBranch.name projectAndBranch
+  let projectBranchNames = bimap Project.name ProjectBranch.name (ProjectAndBranch project projectBranch)
   _success <- liftIO . openBrowser . Text.unpack $ Server.urlFor (Server.ProjectBranchUI projectBranchNames perspective mayDefinitionRef) url
   pure ()
   where
-    pathToBranchFromCodebaseRoot :: Path.Absolute
-    pathToBranchFromCodebaseRoot = projectBranchPath (bimap Project.projectId ProjectBranch.branchId projectAndBranch)
     -- If the provided ui path matches a definition, find it.
-    getDefinitionRef :: Path.Path -> Cli (Maybe (Server.DefinitionReference))
+    getDefinitionRef :: Path.Absolute -> Cli (Maybe (Server.DefinitionReference))
     getDefinitionRef perspective = runMaybeT $ do
       Cli.Env {codebase} <- lift ask
-      let absPathToDefinition = Path.unabsolute $ Path.resolve pathToBranchFromCodebaseRoot (Path.Relative pathFromProjectRoot)
+      (pathToDefinitionNamespace, _nameSeg) <- hoistMaybe $ Lens.unsnoc defnPath
-      (pathToDefinitionNamespace, _nameSeg) <- hoistMaybe $ Lens.unsnoc absPathToDefinition
+      let defnNamespaceProjectPath = pp & PP.absPath_ .~ pathToDefinitionNamespace
-      namespaceBranch <- lift $ Cli.runTransaction (Codebase.getShallowBranchAtPath pathToDefinitionNamespace Nothing)
+      namespaceBranch <- lift . Cli.runTransaction $ Codebase.getShallowBranchAtProjectPath defnNamespaceProjectPath
       fqn <- hoistMaybe $ do
         pathFromPerspective <- List.stripPrefix (Path.toList perspective) (Path.toList pathFromProjectRoot)
         Path.toName . Path.fromList $ pathFromPerspective

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

@@ -101,7 +101,7 @@ noCompletions ::
   String ->
   Codebase m v a ->
   AuthenticatedHttpClient ->
-  Path.Absolute ->
+  PP.ProjectPath ->
   m [System.Console.Haskeline.Completion.Completion]
 noCompletions _ _ _ _ = pure []
 
@@ -145,7 +145,7 @@ completeWithinNamespace ::
   Sqlite.Transaction [System.Console.Haskeline.Completion.Completion]
 completeWithinNamespace compTypes query ppCtx = do
   shortHashLen <- Codebase.hashLength
-  b <- Codebase.getShallowBranchAtProjectPath (queryProjectPath ^. PP.ctxAsIds_)
+  b <- Codebase.getShallowBranchAtProjectPath (queryProjectPath ^. PP.asIds_)
   currentBranchSuggestions <- do
     nib <- namesInBranch shortHashLen b
     nib

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

@@ -177,7 +177,7 @@ projectBranchOptions codebase _projCtx _searchBranch0 = do
 -- E.g. '@unison/base/main'
 projectBranchOptionsWithinCurrentProject :: OptionFetcher
 projectBranchOptionsWithinCurrentProject codebase projCtx _searchBranch0 = do
-  Codebase.runTransaction codebase (Q.loadAllProjectBranchesBeginningWith (projCtx ^. PP.asIds_ . PP.project_) Nothing)
+  Codebase.runTransaction codebase (Q.loadAllProjectBranchesBeginningWith (projCtx ^. PP.asIds_ . #project) Nothing)
     <&> fmap (into @Text . snd)
 
 -- | Exported from here just so the debug command and actual implementation can use the same

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

@@ -147,7 +147,7 @@ module Unison.CommandLine.InputPatterns
   )
 where
 
-import Control.Lens ((^.))
+import Control.Lens ((.~), (^.))
 import Control.Lens.Cons qualified as Cons
 import Data.List (intercalate)
 import Data.List.Extra qualified as List
@@ -1840,7 +1840,7 @@ mergeOldSquashInputPattern =
           [src, dest] -> do
             src <- parseUnresolvedProjectBranch src
             dest <- parseUnresolvedProjectBranch dest
-            Just $ Input.MergeLocalBranchI src dest Branch.SquashMerge
+            Just $ Input.MergeLocalBranchI src (Just dest) Branch.SquashMerge
           _ -> Nothing
     }
   where
@@ -3349,7 +3349,7 @@ namespaceOrProjectBranchArg config =
   ArgumentType
     { typeName = "namespace or branch",
       suggestions =
-        let namespaceSuggestions = \q cb _http ppCtx -> Codebase.runTransaction cb (prefixCompleteNamespace q ppCtx)
+        let namespaceSuggestions = \q cb _http pp -> Codebase.runTransaction cb (prefixCompleteNamespace q pp)
          in unionSuggestions
               [ projectAndOrBranchSuggestions config,
                 namespaceSuggestions
@@ -3375,8 +3375,8 @@ dependencyArg :: ArgumentType
 dependencyArg =
   ArgumentType
     { typeName = "project dependency",
-      suggestions = \q cb _http p -> Codebase.runTransaction cb do
+      suggestions = \q cb _http pp -> Codebase.runTransaction cb do
-        prefixCompleteNamespace q (p Path.:> NameSegment.libSegment),
+        prefixCompleteNamespace q (pp & PP.path_ .~ Path.singleton NameSegment.libSegment),
       fzfResolver = Just Resolvers.projectDependencyResolver
     }
 
@@ -3464,12 +3464,12 @@ projectAndOrBranchSuggestions ::
   AuthenticatedHttpClient ->
   ProjectPath ->
   m [Line.Completion]
-projectAndOrBranchSuggestions config inputStr codebase _httpClient ppCtx = do
+projectAndOrBranchSuggestions config inputStr codebase _httpClient pp = do
   case Text.uncons input of
     -- Things like "/foo" would be parsed as unambiguous branches in the logic below, except we also want to
     -- handle "/<TAB>" and "/@<TAB>" inputs, which aren't valid branch names, but are valid branch prefixes. So,
     -- if the input begins with a forward slash, just rip it off and treat the rest as the branch prefix.
-    Just ('/', input1) -> handleBranchesComplete input1 codebase path
+    Just ('/', input1) -> handleBranchesComplete input1 codebase pp
     _ ->
       case tryInto @ProjectAndBranchNames input of
         -- This case handles inputs like "", "@", and possibly other things that don't look like a valid project
@@ -3490,12 +3490,12 @@ projectAndOrBranchSuggestions config inputStr codebase _httpClient ppCtx = do
                 Nothing -> pure []
                 Just project -> do
                   let projectId = project ^. #projectId
-                  fmap (filterBranches config path) do
+                  fmap (filterBranches config pp) do
                     Queries.loadAllProjectBranchesBeginningWith projectId Nothing
           pure (map (projectBranchToCompletion projectName) branches)
         -- This branch is probably dead due to intercepting inputs that begin with "/" above
         Right (ProjectAndBranchNames'Unambiguous (That branchName)) ->
-          handleBranchesComplete (into @Text branchName) codebase path
+          handleBranchesComplete (into @Text branchName) codebase pp
         Right (ProjectAndBranchNames'Unambiguous (These projectName branchName)) -> do
           branches <-
             Codebase.runTransaction codebase do
@@ -3503,12 +3503,11 @@ projectAndOrBranchSuggestions config inputStr codebase _httpClient ppCtx = do
                 Nothing -> pure []
                 Just project -> do
                   let projectId = project ^. #projectId
-                  fmap (filterBranches config path) do
+                  fmap (filterBranches config pp) do
                     Queries.loadAllProjectBranchesBeginningWith projectId (Just $ into @Text branchName)
           pure (map (projectBranchToCompletion projectName) branches)
   where
     input = Text.strip . Text.pack $ inputStr
-    currentProjectId = ppCtx ^. (PP.ctxAsIds_ . PP.project_)
 
     handleAmbiguousComplete ::
       MonadIO m =>
@@ -3519,14 +3518,10 @@ projectAndOrBranchSuggestions config inputStr codebase _httpClient ppCtx = do
       (branches, projects) <-
         Codebase.runTransaction codebase do
           branches <-
-            case mayCurrentProjectId of
+            fmap (filterBranches config pp) do
-              Nothing -> pure []
+              Queries.loadAllProjectBranchesBeginningWith currentProjectId (Just input)
-              Just currentProjectId ->
+          projects <- case projectInclusion config of
-                fmap (filterBranches config path) do
+            OnlyWithinCurrentProject -> Queries.loadProject currentProjectId <&> maybeToList
-                  Queries.loadAllProjectBranchesBeginningWith currentProjectId (Just input)
-          projects <- case (projectInclusion config, mayCurrentProjectId) of
-            (OnlyWithinCurrentProject, Just currentProjectId) -> Queries.loadProject currentProjectId <&> maybeToList
-            (OnlyWithinCurrentProject, Nothing) -> pure []
             _ -> Queries.loadAllProjectsBeginningWith (Just input) <&> filterProjects
           pure (branches, projects)
       let branchCompletions = map currentProjectBranchToCompletion branches
@@ -3602,25 +3597,26 @@ projectAndOrBranchSuggestions config inputStr codebase _httpClient ppCtx = do
 
     -- Complete the text into a branch name within the provided project
     handleBranchesComplete :: MonadIO m => Text -> Codebase m v a -> PP.ProjectPath -> m [Completion]
-    handleBranchesComplete branchName codebase ppCtx = do
+    handleBranchesComplete branchName codebase pp = do
-      let projId = ppCtx ^. PP.ctxAsIds_ . PP.project_
+      let projId = pp ^. PP.asIds_ . #project
       branches <-
         Codebase.runTransaction codebase do
-          fmap (filterBranches config path) do
+          fmap (filterBranches config pp) do
             Queries.loadAllProjectBranchesBeginningWith projId (Just branchName)
       pure (map currentProjectBranchToCompletion branches)
 
     filterProjects :: [Sqlite.Project] -> [Sqlite.Project]
     filterProjects projects =
-      case (mayCurrentProjectId, projectInclusion config) of
+      case (projectInclusion config) of
-        (_, AllProjects) -> projects
+        AllProjects -> projects
-        (Nothing, _) -> projects
+        OnlyOutsideCurrentProject -> projects & filter (\Sqlite.Project {projectId} -> projectId /= currentProjectId)
-        (Just currentProjId, OnlyOutsideCurrentProject) -> projects & filter (\Sqlite.Project {projectId} -> projectId /= currentProjId)
+        OnlyWithinCurrentProject ->
-        (Just currentBranchId, OnlyWithinCurrentProject) ->
           projects
-            & List.find (\Sqlite.Project {projectId} -> projectId == currentBranchId)
+            & List.find (\Sqlite.Project {projectId} -> projectId == currentProjectId)
             & maybeToList
 
+    PP.ProjectPath currentProjectId _currentBranchId _currentPath = pp ^. PP.asIds_
+
 projectToCompletion :: Sqlite.Project -> Completion
 projectToCompletion project =
   Completion
@@ -3646,20 +3642,20 @@ handleBranchesComplete ::
   Codebase m v a ->
   PP.ProjectPath ->
   m [Completion]
-handleBranchesComplete config branchName codebase ppCtx = do
+handleBranchesComplete config branchName codebase pp = do
   branches <-
     Codebase.runTransaction codebase do
-      fmap (filterBranches config ppCtx) do
+      fmap (filterBranches config pp) do
-        Queries.loadAllProjectBranchesBeginningWith (ppCtx ^. PP.ctxAsIds_ . PP.project_) (Just branchName)
+        Queries.loadAllProjectBranchesBeginningWith (pp ^. PP.asIds_ . #project) (Just branchName)
   pure (map currentProjectBranchToCompletion branches)
 
 filterBranches :: ProjectBranchSuggestionsConfig -> PP.ProjectPath -> [(ProjectBranchId, a)] -> [(ProjectBranchId, a)]
-filterBranches config ppCtx branches =
+filterBranches config pp branches =
   case (branchInclusion config) of
     AllBranches -> branches
     ExcludeCurrentBranch -> branches & filter (\(branchId, _) -> branchId /= currentBranchId)
   where
-    currentBranchId = ppCtx ^. PP.ctxAsIds_ . PP.branch_
+    currentBranchId = pp ^. PP.asIds_ . #branch
 
 currentProjectBranchToCompletion :: (ProjectBranchId, ProjectBranchName) -> Completion
 currentProjectBranchToCompletion (_, branchName) =
@@ -3677,20 +3673,20 @@ branchRelativePathSuggestions ::
   AuthenticatedHttpClient ->
   PP.ProjectPath ->
   m [Line.Completion]
-branchRelativePathSuggestions config inputStr codebase _httpClient ppCtx = do
+branchRelativePathSuggestions config inputStr codebase _httpClient pp = do
   case parseIncrementalBranchRelativePath inputStr of
     Left _ -> pure []
     Right ibrp -> case ibrp of
       BranchRelativePath.ProjectOrPath' _txt _path -> do
-        namespaceSuggestions <- Codebase.runTransaction codebase (prefixCompleteNamespace inputStr currentPath)
+        namespaceSuggestions <- Codebase.runTransaction codebase (prefixCompleteNamespace inputStr pp)
         projectSuggestions <- projectNameSuggestions WithSlash inputStr codebase
         pure (namespaceSuggestions ++ projectSuggestions)
       BranchRelativePath.OnlyPath' _path ->
-        Codebase.runTransaction codebase (prefixCompleteNamespace inputStr currentPath)
+        Codebase.runTransaction codebase (prefixCompleteNamespace inputStr pp)
       BranchRelativePath.IncompleteProject _proj ->
         projectNameSuggestions WithSlash inputStr codebase
       BranchRelativePath.IncompleteBranch mproj mbranch -> case mproj of
-        Nothing -> map suffixPathSep <$> handleBranchesComplete config (maybe "" into mbranch) codebase ppCtx
+        Nothing -> map suffixPathSep <$> handleBranchesComplete config (maybe "" into mbranch) codebase pp
         Just projectName -> do
           branches <-
             Codebase.runTransaction codebase do
@@ -3698,18 +3694,16 @@ branchRelativePathSuggestions config inputStr codebase _httpClient ppCtx = do
                 Nothing -> pure []
                 Just project -> do
                   let projectId = project ^. #projectId
-                  fmap (filterBranches config ppCtx) do
+                  fmap (filterBranches config pp) do
                     Queries.loadAllProjectBranchesBeginningWith projectId (into @Text <$> mbranch)
           pure (map (projectBranchToCompletionWithSep projectName) branches)
       BranchRelativePath.PathRelativeToCurrentBranch relPath -> Codebase.runTransaction codebase do
         -- TODO: Verify this works as intendid
-        map prefixPathSep <$> prefixCompleteNamespace (Path.convert relPath) mempty
+        map prefixPathSep <$> prefixCompleteNamespace (Path.convert relPath) pp
       BranchRelativePath.IncompletePath projStuff mpath -> do
         Codebase.runTransaction codebase do
-          map (addBranchPrefix projStuff) <$> prefixCompleteNamespace (maybe "" Path.convert mpath) ppCtx
+          map (addBranchPrefix projStuff) <$> prefixCompleteNamespace (maybe "" Path.convert mpath) pp
   where
-    currentPath = ppCtx ^. PP.absPath_
-
     projectBranchToCompletionWithSep :: ProjectName -> (ProjectBranchId, ProjectBranchName) -> Completion
     projectBranchToCompletionWithSep projectName (_, branchName) =
       Completion

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

@@ -83,7 +83,7 @@ getUserInput codebase authHTTPClient ppCtx currentProjectRoot numberedArgs =
         Just a -> pure a
     go :: Line.InputT IO Input
     go = do
-      let (PP.ProjectPath projectName projectBranchName path) = ppCtx ^. PP.ctxAsNames_
+      let (PP.ProjectPath projectName projectBranchName path) = ppCtx ^. PP.asNames_
       let promptString =
             P.sep
               ":"

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

@@ -45,7 +45,6 @@ import Unison.Auth.Types qualified as Auth
 import Unison.Builtin.Decls qualified as DD
 import Unison.Cli.MergeTypes (MergeSourceAndTarget (..))
 import Unison.Cli.Pretty
-import Unison.Cli.ProjectUtils qualified as ProjectUtils
 import Unison.Cli.ServantClientUtils qualified as ServantClientUtils
 import Unison.Codebase.Editor.DisplayObject (DisplayObject (..))
 import Unison.Codebase.Editor.Input qualified as Input
@@ -455,7 +454,7 @@ notifyNumbered = \case
     )
     where
       switch = IP.makeExample IP.projectSwitch
-  AmbiguousReset sourceOfAmbiguity (ProjectAndBranch pn0 bn0, path) (ProjectAndBranch currentProject branch) ->
+  AmbiguousReset sourceOfAmbiguity (ProjectAndBranch _pn0 _bn0, path) (ProjectAndBranch currentProject branch) ->
     ( P.wrap
         ( openingLine
             <> prettyProjectAndBranchName (ProjectAndBranch currentProject branch)
@@ -495,7 +494,7 @@ notifyNumbered = \case
         E.AmbiguousReset'Target -> \xs -> "<some hash>" : xs
       reset = IP.makeExample IP.reset
       relPath0 = prettyPath path
-      absPath0 = review ProjectUtils.projectBranchPathPrism (ProjectAndBranch (pn0 ^. #projectId) (bn0 ^. #branchId), path)
+      absPath0 = Path.Absolute path
   ListNamespaceDependencies _ppe _path Empty -> ("This namespace has no external dependencies.", mempty)
   ListNamespaceDependencies ppe path' externalDependencies ->
     ( P.column2Header (P.hiBlack "External dependency") ("Dependents in " <> prettyAbsolute path') $
@@ -910,7 +909,7 @@ notifyUser dir = \case
       prettyProjectAndBranchName projectAndBranch <> "is empty. There is nothing to push."
   CreatedNewBranch path ->
     pure $
-      "☝️  The namespace " <> prettyAbsoluteStripProject path <> " is empty."
+      "☝️  The namespace " <> prettyAbsolute path <> " is empty."
   -- RenameOutput rootPath oldName newName r -> do
   --   nameChange "rename" "renamed" oldName newName r
   -- AliasOutput rootPath existingName newName r -> do

unison-share-api/src/Unison/Server/CodebaseServer.hs

@@ -239,7 +239,7 @@ data DefinitionReference
 data Service
   = LooseCodeUI Path.Absolute (Maybe DefinitionReference)
   | -- (Project branch names, perspective within project, definition reference)
-    ProjectBranchUI (ProjectAndBranch ProjectName ProjectBranchName) Path.Path (Maybe DefinitionReference)
+    ProjectBranchUI (ProjectAndBranch ProjectName ProjectBranchName) Path.Absolute (Maybe DefinitionReference)
   | Api
   deriving stock (Show)
 
@@ -299,13 +299,13 @@ urlFor :: Service -> BaseUrl -> Text
 urlFor service baseUrl =
   case service of
     LooseCodeUI perspective def ->
-      tShow baseUrl <> "/" <> toUrlPath ([DontEscape "ui", DontEscape "non-project-code"] <> path (Path.unabsolute perspective) def)
+      tShow baseUrl <> "/" <> toUrlPath ([DontEscape "ui", DontEscape "non-project-code"] <> path perspective def)
     ProjectBranchUI (ProjectAndBranch projectName branchName) perspective def ->
       tShow baseUrl <> "/" <> toUrlPath ([DontEscape "ui", DontEscape "projects", DontEscape $ into @Text projectName, DontEscape $ into @Text branchName] <> path perspective def)
     Api -> tShow baseUrl <> "/" <> toUrlPath [DontEscape "api"]
   where
-    path :: Path.Path -> Maybe DefinitionReference -> [URISegment]
+    path :: Path.Absolute -> Maybe DefinitionReference -> [URISegment]
-    path ns def =
+    path (Path.Absolute ns) def =
       let nsPath = namespacePath ns
        in case definitionPath def of
             Just defPath -> case nsPath of