mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 02:25:39 +03:00
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.
This commit is contained in:
parent
3c197c51c8
commit
ce33057385
@ -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]
|
||||
|
@ -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
|
||||
|
@ -284,8 +284,8 @@ data OutputLocation
|
||||
deriving (Eq, Show)
|
||||
|
||||
data FindScope
|
||||
= FindLocal Path
|
||||
| FindLocalAndDeps Path
|
||||
= FindLocal Path'
|
||||
| FindLocalAndDeps Path'
|
||||
| FindGlobal
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
|
@ -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)
|
||||
|
@ -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 =
|
||||
|
@ -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)
|
||||
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user