Refine Path-prefixing operations

This replaces `prefix :: Absolute -> Path' -> Path` with a couple
alternatives:
- `prefixAbs :: Absolute -> Relative -> Absolute`,
- `maybePrefix :: Path' -> Path' -> Maybe Path'`, and
- `prefix :: Path' -> Relative -> Path'`.

The previous `prefix` could fail to prefix (covered by either the new
`prefix` or `maybePrefix`, depending on whether you want to guarantee
success or capture failure), always threw away the knowledge that the
result was necessarily `Absolute` (covered by `prefixAbs`), and then
always returned an ambiguous result type (covered by all three
replacements).

Then it also provides `prefixRel` as the complement of `prefixAbs` (both
of which are used in the implementation of `prefix`).

Similar changes are made in the replacements for `prefixName :: Absolute
-> Name -> Name`. First, we don’t currently have absolute/relative
variants of `Name`, so we can generalize the first argument to `Path'`.
Then `maybePrefixName :: Path' -> Name -> Maybe Name` exposes the case
where prefixing can’t succeed, and `prefixNameIfRel :: Path' -> Name ->
Name` handles the common case of using the original `Name` if it can’t
be prefixed. Both of these new functions also preserve the `Position` of
the new `Name`, whereas the old implementation always returned a
`Relative` `Name`, despite knowing when it was `Absolute`. And
`prefixName2 :: Path -> Name -> Name` has been removed as there is no
ambiguous variant of `Name` (as `Split` is to `Split'`), so prefixing
with a `Path` isn’t particularly meaningful.

Finally, `nameFromSplit'` is added as a dual to `splitFromName'` to make
it possible to operate on the `Path'` portion of a `Name` without introducing partiality.

These new operations are then propagated through the code, and enable a
couple other type changes: `StructuredArgument.ShallowListEntry` and
`StructuredArgument.SearchResult` now take a `Path'` prefix rather than
the `Path.Absolute` and `Path` prefixes they took previously. This fixes
the absolute `Name` issue in `ls` results.

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

@@ -22,9 +22,12 @@ module Unison.Codebase.Path
     relativeEmpty',
     currentPath,
     prefix,
+    prefixAbs,
+    prefixRel,
+    maybePrefix,
     unprefix,
-    prefixName,
-    prefixName2,
+    maybePrefixName,
+    prefixNameIfRel,
     unprefixName,
     HQSplit,
     Split,
@@ -62,8 +65,7 @@ module Unison.Codebase.Path
     unsplitAbsolute,
     unsplitHQ,
     unsplitHQ',
-
-    -- * things that could be replaced with `Parse` instances
+    nameFromSplit',
     splitFromName,
     splitFromName',
     hqSplitFromName',
@@ -81,6 +83,7 @@ where
 
 import Control.Lens hiding (cons, snoc, unsnoc, pattern Empty)
 import Control.Lens qualified as Lens
+import Data.Bitraversable (bitraverse)
 import Data.Foldable qualified as Foldable
 import Data.List.Extra (dropPrefix)
 import Data.List.NonEmpty (NonEmpty ((:|)))
@@ -187,16 +190,25 @@ unprefix (Absolute prefix) = \case
   AbsolutePath' abs -> unabsolute abs
   RelativePath' rel -> fromList $ dropPrefix (toList prefix) (toList (unrelative rel))
 
--- too many types
-prefix :: Absolute -> Path' -> Path
-prefix (Absolute (Path prefix)) = \case
-  AbsolutePath' abs -> unabsolute abs
-  RelativePath' rel -> Path $ prefix <> toSeq (unrelative rel)
+prefixAbs :: Absolute -> Relative -> Absolute
+prefixAbs prefix = Absolute . Path . (toSeq (unabsolute prefix) <>) . toSeq . unrelative
 
-prefix2 :: Path -> Path' -> Path
-prefix2 (Path prefix) = \case
-  AbsolutePath' abs -> unabsolute abs
-  RelativePath' rel -> Path $ prefix <> toSeq (unrelative rel)
+prefixRel :: Relative -> Relative -> Relative
+prefixRel prefix = Relative . Path . (toSeq (unrelative prefix) <>) . toSeq . unrelative
+
+-- | This always prefixes, since the secend argument can never be Absolute.
+prefix :: Path' -> Relative -> Path'
+prefix prefix =
+  Path' . case prefix of
+    AbsolutePath' abs -> Left . prefixAbs abs
+    RelativePath' rel -> pure . prefixRel rel
+
+-- | Returns `Nothing` if the second argument is absolute. A common pattern is
+--   @fromMaybe path $ maybePrefix prefix path@ to use the unmodified path in that case.
+maybePrefix :: Path' -> Path' -> Maybe Path'
+maybePrefix pre = \case
+  AbsolutePath' _ -> Nothing
+  RelativePath' rel -> pure $ prefix pre rel
 
 -- | Finds the longest shared path prefix of two paths.
 -- Returns (shared prefix, path to first location from shared prefix, path to second location from shared prefix)
@@ -268,6 +280,11 @@ splitFromName' name =
             seg
           )
 
+nameFromSplit' :: Split' -> Name
+nameFromSplit' (path', seg) = case path' of
+  AbsolutePath' abs -> Name.makeAbsolute . Name.fromReverseSegments $ seg :| reverse (toList $ unabsolute abs)
+  RelativePath' rel -> Name.makeRelative . Name.fromReverseSegments $ seg :| reverse (toList $ unrelative rel)
+
 -- | Remove a path prefix from a name.
 -- Returns 'Nothing' if there are no remaining segments to construct the name from.
 --
@@ -276,11 +293,13 @@ splitFromName' name =
 unprefixName :: Absolute -> Name -> Maybe Name
 unprefixName prefix = toName . unprefix prefix . fromName'
 
-prefixName :: Absolute -> Name -> Name
-prefixName p n = fromMaybe n . toName . prefix p . fromName' $ n
+-- | Returns `Nothing` if the second argument is absolute. A common pattern is
+--   @fromMaybe name $ maybePrefixName prefix name@ to use the unmodified path in that case.
+maybePrefixName :: Path' -> Name -> Maybe Name
+maybePrefixName pre = fmap nameFromSplit' . bitraverse (maybePrefix pre) pure . splitFromName'
 
-prefixName2 :: Path -> Name -> Name
-prefixName2 p n = fromMaybe n . toName . prefix2 p . fromName' $ n
+prefixNameIfRel :: Path' -> Name -> Name
+prefixNameIfRel p name = fromMaybe name $ maybePrefixName p name
 
 singleton :: NameSegment -> Path
 singleton n = fromList [n]

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

@@ -695,7 +695,7 @@ loop e = do
 
               pathArgAbs <- Cli.resolvePath' pathArg
               entries <- liftIO (Backend.lsAtPath codebase Nothing pathArgAbs)
-              Cli.setNumberedArgs $ fmap (SA.ShallowListEntry pathArgAbs) entries
+              Cli.setNumberedArgs $ fmap (SA.ShallowListEntry pathArg) entries
               pped <- Cli.currentPrettyPrintEnvDecl
               let suffixifiedPPE = PPED.suffixifiedPPE pped
               -- This used to be a delayed action which only forced the loading of the root
@@ -1181,7 +1181,7 @@ handleFindI isVerbose fscope ws input = do
   Cli.Env {codebase} <- ask
   (pped, names, searchRoot, branch0) <- case fscope of
     FindLocal p -> do
-      searchRoot <- Cli.resolvePath p
+      searchRoot <- Cli.resolvePath' p
       branch0 <- Cli.getBranch0At searchRoot
       let names = Branch.toNames (Branch.withoutLib branch0)
       -- Don't exclude anything from the pretty printer, since the type signatures we print for
@@ -1189,7 +1189,7 @@ handleFindI isVerbose fscope ws input = do
       pped <- Cli.currentPrettyPrintEnvDecl
       pure (pped, names, Just p, branch0)
     FindLocalAndDeps p -> do
-      searchRoot <- Cli.resolvePath p
+      searchRoot <- Cli.resolvePath' p
       branch0 <- Cli.getBranch0At searchRoot
       let names = Branch.toNames (Branch.withoutTransitiveLibs branch0)
       -- Don't exclude anything from the pretty printer, since the type signatures we print for

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

@@ -284,8 +284,8 @@ data OutputLocation
   deriving (Eq, Show)
 
 data FindScope
-  = FindLocal Path
-  | FindLocalAndDeps Path
+  = FindLocal Path'
+  | FindLocalAndDeps Path'
   | FindGlobal
   deriving stock (Eq, Show)
 

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

@@ -3,7 +3,7 @@ module Unison.Codebase.Editor.StructuredArgument where
 import GHC.Generics (Generic)
 import U.Codebase.HashTags (CausalHash)
 import Unison.Codebase.Editor.Input
-import Unison.Codebase.Path (Path)
+import Unison.Codebase.Path (Path')
 import Unison.Codebase.Path qualified as Path
 import Unison.HashQualified qualified as HQ
 import Unison.HashQualified' qualified as HQ'
@@ -24,6 +24,6 @@ data StructuredArgument
   | Namespace CausalHash
   | NameWithBranchPrefix AbsBranchId Name
   | HashQualifiedWithBranchPrefix AbsBranchId (HQ'.HashQualified Name)
-  | ShallowListEntry Path.Absolute (ShallowListEntry Symbol Ann)
-  | SearchResult (Maybe Path) SearchResult
+  | ShallowListEntry Path' (ShallowListEntry Symbol Ann)
+  | SearchResult (Maybe Path') SearchResult
   deriving (Eq, Generic, Show)

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

@@ -181,7 +181,7 @@ import Unison.Codebase.Editor.StructuredArgument (StructuredArgument)
 import Unison.Codebase.Editor.StructuredArgument qualified as SA
 import Unison.Codebase.Editor.UriParser (readRemoteNamespaceParser)
 import Unison.Codebase.Editor.UriParser qualified as UriParser
-import Unison.Codebase.Path (Path)
+import Unison.Codebase.Path (Path, Path')
 import Unison.Codebase.Path qualified as Path
 import Unison.Codebase.Path.Parse qualified as Path
 import Unison.Codebase.PushBehavior qualified as PushBehavior
@@ -249,9 +249,9 @@ formatStructuredArgument schLength = \case
     prefixBranchId :: Input.AbsBranchId -> Name -> Text
     prefixBranchId branchId name = case branchId of
       Left sch -> "#" <> SCH.toText sch <> ":" <> Name.toText (Name.makeAbsolute name)
-      Right pathPrefix -> Name.toText (Name.makeAbsolute . Path.prefixName pathPrefix $ name)
+      Right pathPrefix -> Name.toText (Path.prefixNameIfRel (Path.AbsolutePath' pathPrefix) name)
 
-    entryToHQText :: Path.Absolute -> ShallowListEntry v Ann -> Text
+    entryToHQText :: Path' -> ShallowListEntry v Ann -> Text
     entryToHQText pathArg =
       fixup . \case
         ShallowTypeEntry te -> Backend.typeEntryDisplayName te
@@ -292,14 +292,14 @@ shallowListEntryToHQ' = \case
   ShallowPatchEntry ns -> HQ'.fromName $ Name.fromSegment ns
 
 -- | restores the full hash to these search results, for _numberedArgs purposes
-searchResultToHQ :: Maybe Path -> SearchResult -> HQ.HashQualified Name
+searchResultToHQ :: Maybe Path' -> SearchResult -> HQ.HashQualified Name
 searchResultToHQ oprefix = \case
   SR.Tm' n r _ -> HQ.requalify (addPrefix <$> n) r
   SR.Tp' n r _ -> HQ.requalify (addPrefix <$> n) (Referent.Ref r)
   _ -> error "impossible match failure"
   where
     addPrefix :: Name -> Name
-    addPrefix = maybe id Path.prefixName2 oprefix
+    addPrefix = maybe id Path.prefixNameIfRel oprefix
 
 unsupportedStructuredArgument :: Text -> I.Argument -> Either (P.Pretty CT.ColorText) String
 unsupportedStructuredArgument expected =
@@ -400,25 +400,25 @@ handleHashQualifiedNameArg =
     \case
       SA.Name name -> pure $ HQ.NameOnly name
       SA.NameWithBranchPrefix mprefix name ->
-        pure . HQ.NameOnly $ foldr (\prefix -> Name.makeAbsolute . Path.prefixName prefix) name mprefix
+        pure . HQ.NameOnly $ foldr (Path.prefixNameIfRel . Path.AbsolutePath') name mprefix
       SA.HashQualified hqname -> pure hqname
       SA.HashQualifiedWithBranchPrefix mprefix hqname ->
-        pure . HQ'.toHQ $ foldr (\prefix -> fmap $ Name.makeAbsolute . Path.prefixName prefix) hqname mprefix
+        pure . HQ'.toHQ $ foldr (\prefix -> fmap $ Path.prefixNameIfRel (Path.AbsolutePath' prefix)) hqname mprefix
       SA.ShallowListEntry prefix entry ->
-        pure . HQ'.toHQ . fmap (Name.makeAbsolute . Path.prefixName prefix) $ shallowListEntryToHQ' entry
+        pure . HQ'.toHQ . fmap (Path.prefixNameIfRel prefix) $ shallowListEntryToHQ' entry
       SA.SearchResult mpath result -> pure $ searchResultToHQ mpath result
       otherArgType -> Left $ wrongStructuredArgument "a hash-qualified name" otherArgType
 
-handlePathArg :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Path
+handlePathArg :: I.Argument -> Either (P.Pretty CT.ColorText) Path
 handlePathArg =
   either
     (first P.text . Path.parsePath)
     \case
       SA.Name name -> pure $ Path.fromName name
-      SA.NameWithBranchPrefix mprefix name -> pure . Path.fromName $ foldr Path.prefixName name mprefix
+      SA.NameWithBranchPrefix _ name -> pure $ Path.fromName name
       otherArgType -> Left $ wrongStructuredArgument "a relative path" otherArgType
 
-handlePath'Arg :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Path'
+handlePath'Arg :: I.Argument -> Either (P.Pretty CT.ColorText) Path'
 handlePath'Arg =
   either
     (first P.text . Path.parsePath')
@@ -426,7 +426,7 @@ handlePath'Arg =
       SA.AbsolutePath path -> pure $ Path.absoluteToPath' path
       SA.Name name -> pure $ Path.fromName' name
       SA.NameWithBranchPrefix mprefix name ->
-        pure . Path.fromName' $ foldr (\prefix -> Name.makeAbsolute . Path.prefixName prefix) name mprefix
+        pure . Path.fromName' $ foldr (Path.prefixNameIfRel . Path.AbsolutePath') name mprefix
       otherArgType -> Left $ wrongStructuredArgument "a namespace" otherArgType
 
 handleNewName :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Split'
@@ -435,7 +435,7 @@ handleNewName =
     (first P.text . Path.parseSplit')
     (const . Left $ "can’t use a numbered argument for a new name")
 
-handleNewPath :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Path'
+handleNewPath :: I.Argument -> Either (P.Pretty CT.ColorText) Path'
 handleNewPath =
   either
     (first P.text . Path.parsePath')
@@ -448,9 +448,7 @@ handleSplitArg =
     (first P.text . Path.parseSplit)
     \case
       SA.Name name | Name.isRelative name -> pure $ Path.splitFromName name
-      SA.NameWithBranchPrefix (Left _) name | Name.isRelative name -> pure $ Path.splitFromName name
-      SA.NameWithBranchPrefix (Right prefix) name
-        | Name.isRelative name -> pure . Path.splitFromName . Name.makeAbsolute $ Path.prefixName prefix name
+      SA.NameWithBranchPrefix _ name | Name.isRelative name -> pure $ Path.splitFromName name
       otherNumArg -> Left $ wrongStructuredArgument "a relative name" otherNumArg
 
 handleSplit'Arg :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Split'
@@ -461,7 +459,7 @@ handleSplit'Arg =
       SA.Name name -> pure $ Path.splitFromName' name
       SA.NameWithBranchPrefix (Left _) name -> pure $ Path.splitFromName' name
       SA.NameWithBranchPrefix (Right prefix) name ->
-        pure . Path.splitFromName' . Name.makeAbsolute $ Path.prefixName prefix name
+        pure . Path.splitFromName' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name
       otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg
 
 handleProjectBranchNameArg :: I.Argument -> Either (P.Pretty CT.ColorText) ProjectBranchName
@@ -480,7 +478,7 @@ handleBranchIdArg =
       SA.AbsolutePath path -> pure . pure $ Path.absoluteToPath' path
       SA.Name name -> pure . pure $ Path.fromName' name
       SA.NameWithBranchPrefix mprefix name ->
-        pure . pure . Path.fromName' $ either (const name) (Name.makeAbsolute . flip Path.prefixName name) mprefix
+        pure . pure . Path.fromName' $ foldr (Path.prefixNameIfRel . Path.AbsolutePath') name mprefix
       SA.Namespace hash -> pure . Left $ SCH.fromFullHash hash
       otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg
 
@@ -496,7 +494,7 @@ handleBranchIdOrProjectArg =
       SA.Name name -> pure . This . pure $ Path.fromName' name
       SA.NameWithBranchPrefix (Left _) name -> pure . This . pure $ Path.fromName' name
       SA.NameWithBranchPrefix (Right prefix) name ->
-        pure . This . pure . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name
+        pure . This . pure . Path.fromName' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name
       SA.ProjectBranch pb -> pure $ pure pb
       otherArgType -> Left $ wrongStructuredArgument "a branch" otherArgType
   where
@@ -528,7 +526,7 @@ handleBranchId2Arg =
       SA.Name name -> pure . pure . LoosePath $ Path.fromName' name
       SA.NameWithBranchPrefix (Left _) name -> pure . pure . LoosePath $ Path.fromName' name
       SA.NameWithBranchPrefix (Right prefix) name ->
-        pure . pure . LoosePath . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name
+        pure . pure . LoosePath . Path.fromName' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name
       SA.ProjectBranch (ProjectAndBranch mproject branch) ->
         pure . pure . BranchRelative . This $ maybe (Left branch) (pure . (,branch)) mproject
       otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg
@@ -542,7 +540,7 @@ handleBranchRelativePathArg =
       SA.Name name -> pure . LoosePath $ Path.fromName' name
       SA.NameWithBranchPrefix (Left _) name -> pure . LoosePath $ Path.fromName' name
       SA.NameWithBranchPrefix (Right prefix) name ->
-        pure . LoosePath . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name
+        pure . LoosePath . Path.fromName' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name
       SA.ProjectBranch (ProjectAndBranch mproject branch) ->
         pure . BranchRelative . This $ maybe (Left branch) (pure . (,branch)) mproject
       otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg
@@ -578,9 +576,9 @@ handleHashQualifiedSplit'Arg =
       hq@(SA.HashQualified name) -> first (const $ expectedButActually "a name" hq "a hash") $ hqNameToSplit' name
       SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ hq'NameToSplit' hqname
       SA.HashQualifiedWithBranchPrefix (Right prefix) hqname ->
-        pure . hq'NameToSplit' $ Name.makeAbsolute . Path.prefixName prefix <$> hqname
+        pure . hq'NameToSplit' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) <$> hqname
       SA.ShallowListEntry prefix entry ->
-        pure . hq'NameToSplit' . fmap (Name.makeAbsolute . Path.prefixName prefix) $ shallowListEntryToHQ' entry
+        pure . hq'NameToSplit' . fmap (Path.prefixNameIfRel prefix) $ shallowListEntryToHQ' entry
       sr@(SA.SearchResult mpath result) ->
         first (const $ expectedButActually "a name" sr "a hash") . hqNameToSplit' $ searchResultToHQ mpath result
       otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg
@@ -601,7 +599,7 @@ handleHashQualifiedSplitArg =
       hq@(SA.HashQualified name) -> first (const $ expectedButActually "a name" hq "a hash") $ hqNameToSplit name
       SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ hq'NameToSplit hqname
       SA.HashQualifiedWithBranchPrefix (Right prefix) hqname ->
-        pure . hq'NameToSplit $ Name.makeAbsolute . Path.prefixName prefix <$> hqname
+        pure . hq'NameToSplit $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) <$> hqname
       SA.ShallowListEntry _ entry -> pure . hq'NameToSplit $ shallowListEntryToHQ' entry
       sr@(SA.SearchResult mpath result) ->
         first (const $ expectedButActually "a name" sr "a hash") . hqNameToSplit $ searchResultToHQ mpath result
@@ -624,9 +622,9 @@ handleShortHashOrHQSplit'Arg =
       SA.HashQualified name -> pure $ hqNameToSplit' name
       SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure . pure $ hq'NameToSplit' hqname
       SA.HashQualifiedWithBranchPrefix (Right prefix) hqname ->
-        pure . pure $ hq'NameToSplit' (Name.makeAbsolute . Path.prefixName prefix <$> hqname)
+        pure . pure $ hq'NameToSplit' (Path.prefixNameIfRel (Path.AbsolutePath' prefix) <$> hqname)
       SA.ShallowListEntry prefix entry ->
-        pure . pure . hq'NameToSplit' . fmap (Name.makeAbsolute . Path.prefixName prefix) $ shallowListEntryToHQ' entry
+        pure . pure . hq'NameToSplit' . fmap (Path.prefixNameIfRel prefix) $ shallowListEntryToHQ' entry
       SA.SearchResult mpath result -> pure . hqNameToSplit' $ searchResultToHQ mpath result
       otherNumArg -> Left $ wrongStructuredArgument "a hash or name" otherNumArg
 
@@ -645,13 +643,13 @@ handleNameArg =
     \case
       SA.Name name -> pure name
       SA.NameWithBranchPrefix (Left _) name -> pure name
-      SA.NameWithBranchPrefix (Right prefix) name -> pure . Name.makeAbsolute $ Path.prefixName prefix name
+      SA.NameWithBranchPrefix (Right prefix) name -> pure $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name
       SA.HashQualified hqname -> maybe (Left "can’t find a name from the numbered arg") pure $ HQ.toName hqname
       SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ HQ'.toName hqname
       SA.HashQualifiedWithBranchPrefix (Right prefix) hqname ->
-        pure . Name.makeAbsolute . Path.prefixName prefix $ HQ'.toName hqname
+        pure . Path.prefixNameIfRel (Path.AbsolutePath' prefix) $ HQ'.toName hqname
       SA.ShallowListEntry prefix entry ->
-        pure . HQ'.toName . fmap (Name.makeAbsolute . Path.prefixName prefix) $ shallowListEntryToHQ' entry
+        pure . HQ'.toName . fmap (Path.prefixNameIfRel prefix) $ shallowListEntryToHQ' entry
       SA.SearchResult mpath result ->
         maybe (Left "can’t find a name from the numbered arg") pure . HQ.toName $ searchResultToHQ mpath result
       otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg
@@ -690,7 +688,7 @@ handlePushSourceArg =
       SA.Name name -> pure . Input.PathySource $ Path.fromName' name
       SA.NameWithBranchPrefix (Left _) name -> pure . Input.PathySource $ Path.fromName' name
       SA.NameWithBranchPrefix (Right prefix) name ->
-        pure . Input.PathySource . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name
+        pure . Input.PathySource . Path.fromName' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name
       SA.Project project -> pure . Input.ProjySource $ This project
       SA.ProjectBranch (ProjectAndBranch project branch) -> pure . Input.ProjySource $ maybe That These project branch
       otherNumArg -> Left $ wrongStructuredArgument "a source to push from" otherNumArg
@@ -1071,7 +1069,7 @@ sfind =
   InputPattern "rewrite.find" ["sfind"] I.Visible [("rewrite-rule definition", Required, definitionQueryArg)] msg parse
   where
     parse [q] =
-      Input.StructuredFindI (Input.FindLocal Path.empty)
+      Input.StructuredFindI (Input.FindLocal Path.relativeEmpty')
         <$> handleHashQualifiedNameArg q
     parse _ = Left "expected exactly one argument"
     msg =
@@ -1130,10 +1128,10 @@ sfindReplace =
         ]
 
 find :: InputPattern
-find = find' "find" (Input.FindLocal Path.empty)
+find = find' "find" (Input.FindLocal Path.relativeEmpty')
 
 findAll :: InputPattern
-findAll = find' "find.all" (Input.FindLocalAndDeps Path.empty)
+findAll = find' "find.all" (Input.FindLocalAndDeps Path.relativeEmpty')
 
 findGlobal :: InputPattern
 findGlobal = find' "find.global" Input.FindGlobal
@@ -1142,7 +1140,7 @@ findIn, findInAll :: InputPattern
 findIn = findIn' "find-in" Input.FindLocal
 findInAll = findIn' "find-in.all" Input.FindLocalAndDeps
 
-findIn' :: String -> (Path.Path -> Input.FindScope) -> InputPattern
+findIn' :: String -> (Path' -> Input.FindScope) -> InputPattern
 findIn' cmd mkfscope =
   InputPattern
     cmd
@@ -1151,7 +1149,7 @@ findIn' cmd mkfscope =
     [("namespace", Required, namespaceArg), ("query", ZeroPlus, exactDefinitionArg)]
     findHelp
     \case
-      p : args -> Input.FindI False . mkfscope <$> handlePathArg p <*> pure (unifyArgument <$> args)
+      p : args -> Input.FindI False . mkfscope <$> handlePath'Arg p <*> pure (unifyArgument <$> args)
       _ -> Left findHelp
 
 findHelp :: P.Pretty CT.ColorText
@@ -1229,7 +1227,7 @@ findVerbose =
     ( "`find.verbose` searches for definitions like `find`, but includes hashes "
         <> "and aliases in the results."
     )
-    (pure . Input.FindI True (Input.FindLocal Path.empty) . fmap unifyArgument)
+    (pure . Input.FindI True (Input.FindLocal Path.relativeEmpty') . fmap unifyArgument)
 
 findVerboseAll :: InputPattern
 findVerboseAll =
@@ -1241,7 +1239,7 @@ findVerboseAll =
     ( "`find.all.verbose` searches for definitions like `find.all`, but includes hashes "
         <> "and aliases in the results."
     )
-    (pure . Input.FindI True (Input.FindLocalAndDeps Path.empty) . fmap unifyArgument)
+    (pure . Input.FindI True (Input.FindLocalAndDeps Path.relativeEmpty') . fmap unifyArgument)
 
 renameTerm :: InputPattern
 renameTerm =

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

@@ -45,7 +45,7 @@ relocateToNameRoot perspective query rootBranch = do
         (_sharedPrefix, remainder, Path.Empty) -> do
           -- Since the project is higher up, we need to prefix the query
           -- with the remainder of the path
-          pure . Right $ (projectRoot, query <&> Path.prefixName (Path.Absolute remainder))
+          pure $ Right (projectRoot, query <&> Path.prefixNameIfRel (Path.AbsolutePath' $ Path.Absolute remainder))
         -- The namesRoot and project root are disjoint, this shouldn't ever happen.
         (_, _, _) -> pure $ Left (DisjointProjectAndPerspective perspective projectRoot)
 

unison-share-api/src/Unison/Server/NameSearch/Sqlite.hs

@@ -130,7 +130,8 @@ nameSearchForPerspective codebase namesPerspective@Ops.NamesPerspective {pathToM
 
     -- Fully qualify a name by prepending the current namespace perspective's path
     fullyQualifyName :: Name -> Name
-    fullyQualifyName name = Path.prefixName (Path.Absolute (Path.fromList . coerce $ pathToMountedNameLookup)) name
+    fullyQualifyName =
+      Path.prefixNameIfRel (Path.AbsolutePath' . Path.Absolute . Path.fromList $ coerce pathToMountedNameLookup)
 
 -- | Look up types in the codebase by short hash, and include builtins.
 typeReferencesByShortHash :: SH.ShortHash -> Sqlite.Transaction (Set Reference)

unison-src/transcripts/fix5055.output.md

@@ -55,10 +55,8 @@ test-5055/main> ls foo
 
 test-5055/main> view 1
 
-  .__projects._8e3f0836_9520_436c_bc83_398857c869a7.branches._6fb370f4_774e_495a_a8ff_caec833fdcc8.foo.add :
-    Int -> Int -> Int
-  .__projects._8e3f0836_9520_436c_bc83_398857c869a7.branches._6fb370f4_774e_495a_a8ff_caec833fdcc8.foo.add
-    x y =
+  foo.add : Int -> Int -> Int
+  foo.add x y =
     use Int +
     x + y