From f28bd07a36f974f3c881f5937531dec87b3675d1 Mon Sep 17 00:00:00 2001 From: Travis Staton Date: Thu, 7 Dec 2023 11:36:30 -0500 Subject: [PATCH 1/3] P -> Megaparsec --- .../src/Unison/CommandLine/InputPatterns.hs | 28 +++++++++---------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 42ea511edf..2e2d49c08a 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -19,7 +19,7 @@ import Network.URI qualified as URI import System.Console.Haskeline.Completion (Completion (Completion)) import System.Console.Haskeline.Completion qualified as Haskeline import System.Console.Haskeline.Completion qualified as Line -import Text.Megaparsec qualified as P +import Text.Megaparsec qualified as Megaparsec import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId) import U.Codebase.Sqlite.Project qualified as Sqlite import U.Codebase.Sqlite.Queries qualified as Queries @@ -3535,7 +3535,7 @@ projectNameArg = parsePullSource :: Text -> Maybe (ReadRemoteNamespace (These ProjectName ProjectBranchNameOrLatestRelease)) parsePullSource = - P.parseMaybe (readRemoteNamespaceParser ProjectBranchSpecifier'NameOrLatestRelease) + Megaparsec.parseMaybe (readRemoteNamespaceParser ProjectBranchSpecifier'NameOrLatestRelease) -- | Parse a 'Input.PushSource'. parsePushSource :: String -> Either (P.Pretty CT.ColorText) Input.PushSource @@ -3550,7 +3550,7 @@ parsePushSource sourceStr = -- | Parse a push target. parsePushTarget :: String -> Either (P.Pretty CT.ColorText) (WriteRemoteNamespace (These ProjectName ProjectBranchName)) parsePushTarget target = - case P.parseMaybe UriParser.writeRemoteNamespace (Text.pack target) of + case Megaparsec.parseMaybe UriParser.writeRemoteNamespace (Text.pack target) of Nothing -> Left (I.help push) Just path -> Right path @@ -3572,7 +3572,7 @@ parseWriteGitRepo :: String -> String -> Either (P.Pretty P.ColorText) WriteGitR parseWriteGitRepo label input = do first (fromString . show) -- turn any parsing errors into a Pretty. - (P.parse (UriParser.writeGitRepo <* P.eof) label (Text.pack input)) + (Megaparsec.parse (UriParser.writeGitRepo <* Megaparsec.eof) label (Text.pack input)) collectNothings :: (a -> Maybe b) -> [a] -> [a] collectNothings f as = [a | (Nothing, a) <- map f as `zip` as] @@ -3593,23 +3593,23 @@ explainRemote pushPull = where gitRepo = PushPull.fold @(P.Pretty P.ColorText) "git@github.com:" "https://github.com/" pushPull -showErrorFancy :: (P.ShowErrorComponent e) => P.ErrorFancy e -> String -showErrorFancy (P.ErrorFail msg) = msg -showErrorFancy (P.ErrorIndentation ord ref actual) = +showErrorFancy :: (Megaparsec.ShowErrorComponent e) => Megaparsec.ErrorFancy e -> String +showErrorFancy (Megaparsec.ErrorFail msg) = msg +showErrorFancy (Megaparsec.ErrorIndentation ord ref actual) = "incorrect indentation (got " - <> show (P.unPos actual) + <> show (Megaparsec.unPos actual) <> ", should be " <> p - <> show (P.unPos ref) + <> show (Megaparsec.unPos ref) <> ")" where p = case ord of LT -> "less than " EQ -> "equal to " GT -> "greater than " -showErrorFancy (P.ErrorCustom a) = P.showErrorComponent a +showErrorFancy (Megaparsec.ErrorCustom a) = Megaparsec.showErrorComponent a -showErrorItem :: P.ErrorItem (P.Token Text) -> String -showErrorItem (P.Tokens ts) = P.showTokens (Proxy @Text) ts -showErrorItem (P.Label label) = NE.toList label -showErrorItem P.EndOfInput = "end of input" +showErrorItem :: Megaparsec.ErrorItem (Megaparsec.Token Text) -> String +showErrorItem (Megaparsec.Tokens ts) = Megaparsec.showTokens (Proxy @Text) ts +showErrorItem (Megaparsec.Label label) = NE.toList label +showErrorItem Megaparsec.EndOfInput = "end of input" From cf6240fee2f422004e85195ce76ab8a58f43fdb6 Mon Sep 17 00:00:00 2001 From: Travis Staton Date: Thu, 7 Dec 2023 11:59:45 -0500 Subject: [PATCH 2/3] branch relative path parser --- .../src/Unison/CommandLine/InputPatterns.hs | 33 +++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 2e2d49c08a..d45e6a99c4 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -6,6 +6,7 @@ module Unison.CommandLine.InputPatterns where import Control.Lens (preview, (^.)) import Control.Lens.Cons qualified as Cons +import Data.Char (isSpace) import Data.List (intercalate) import Data.List.Extra qualified as List import Data.List.NonEmpty qualified as NE @@ -20,6 +21,7 @@ import System.Console.Haskeline.Completion (Completion (Completion)) import System.Console.Haskeline.Completion qualified as Haskeline import System.Console.Haskeline.Completion qualified as Line import Text.Megaparsec qualified as Megaparsec +import Text.Megaparsec.Char qualified as Megaparsec import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId) import U.Codebase.Sqlite.Project qualified as Sqlite import U.Codebase.Sqlite.Queries qualified as Queries @@ -59,6 +61,7 @@ import Unison.NameSegment qualified as NameSegment import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectAndBranchNames (..), ProjectBranchName, ProjectBranchNameOrLatestRelease (..), ProjectBranchSpecifier (..), ProjectName, Semver) import Unison.Project.Util (ProjectContext (..), projectContextFromPath) +import Unison.Project qualified as Project import Unison.Syntax.HashQualified qualified as HQ (fromString) import Unison.Syntax.Name qualified as Name (fromText, unsafeFromString) import Unison.Util.ColorText qualified as CT @@ -3613,3 +3616,33 @@ showErrorItem :: Megaparsec.ErrorItem (Megaparsec.Token Text) -> String showErrorItem (Megaparsec.Tokens ts) = Megaparsec.showTokens (Proxy @Text) ts showErrorItem (Megaparsec.Label label) = NE.toList label showErrorItem Megaparsec.EndOfInput = "end of input" + +parseBranchRelativePath :: String -> Either (P.Pretty CT.ColorText) (These (These ProjectName ProjectBranchName) Path.Relative) +parseBranchRelativePath str = + case Megaparsec.parse branchRelativePathParser "" (Text.pack str) of + Left e -> Left (P.string (Megaparsec.errorBundlePretty e)) + Right x -> Right x + +branchRelativePathParser :: Megaparsec.Parsec Void Text (These (These ProjectName ProjectBranchName) Path.Relative) +branchRelativePathParser = + asum + [fullPath, currentBranchRootPath] + where + relPath = do + pathStr <- Megaparsec.takeWhile1P (Just "path char") (not . isSpace) + case Path.parsePath' (Text.unpack pathStr) of + Left err -> fail err + Right (Path.Path' inner) -> case inner of + Left _ -> fail "Expected a relative path but found an absolute path" + Right x -> pure x + + fullPath = do + projectAndBranchNames <- Project.projectAndBranchNamesParser ProjectBranchSpecifier'Name + optional (Megaparsec.char ':') >>= \case + Nothing -> pure (This projectAndBranchNames) + Just _ -> do + These projectAndBranchNames <$> relPath + + currentBranchRootPath = do + _ <- Megaparsec.char ':' + That <$> relPath From 3d3dd58f592fabdd47bc0e60e029b1f6aa8ddafa Mon Sep 17 00:00:00 2001 From: Travis Staton Date: Thu, 7 Dec 2023 13:41:30 -0500 Subject: [PATCH 3/3] fork accepts branch relative paths --- unison-cli/src/Unison/Cli/ProjectUtils.hs | 28 ++++++ .../src/Unison/Codebase/Editor/HandleInput.hs | 27 +++--- .../src/Unison/Codebase/Editor/Input.hs | 10 +- .../Unison/CommandLine/BranchRelativePath.hs | 74 ++++++++++++++ .../src/Unison/CommandLine/InputPatterns.hs | 40 +------- unison-cli/unison-cli.cabal | 1 + .../transcripts/branch-relative-path.md | 31 ++++++ .../branch-relative-path.output.md | 97 +++++++++++++++++++ 8 files changed, 258 insertions(+), 50 deletions(-) create mode 100644 unison-cli/src/Unison/CommandLine/BranchRelativePath.hs create mode 100644 unison-src/transcripts/branch-relative-path.md create mode 100644 unison-src/transcripts/branch-relative-path.output.md diff --git a/unison-cli/src/Unison/Cli/ProjectUtils.hs b/unison-cli/src/Unison/Cli/ProjectUtils.hs index aa2c839efe..8a534e60f2 100644 --- a/unison-cli/src/Unison/Cli/ProjectUtils.hs +++ b/unison-cli/src/Unison/Cli/ProjectUtils.hs @@ -12,6 +12,7 @@ module Unison.Cli.ProjectUtils projectBranchPath, projectBranchSegment, projectBranchPathPrism, + branchRelativePathToAbsolute, -- * Name hydration hydrateNames, @@ -49,12 +50,34 @@ import Unison.Codebase.Editor.Output (Output (LocalProjectBranchDoesntExist)) import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Path (Path') import Unison.Codebase.Path qualified as Path +import Unison.CommandLine.BranchRelativePath (BranchRelativePath) +import Unison.CommandLine.BranchRelativePath qualified as BranchRelativePath import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) import Unison.Project.Util import Unison.Sqlite qualified as Sqlite import Witch (unsafeFrom) +branchRelativePathToAbsolute :: BranchRelativePath -> Cli Path.Absolute +branchRelativePathToAbsolute = \case + BranchRelativePath.BranchRelative brp -> case brp of + These projectBranch path -> do + projectBranch <- getIds <$> expectProjectAndBranchByTheseNames (toThese projectBranch) + pure (Path.resolve (projectBranchPath projectBranch) path) + This projectBranch -> do + projectBranch <- getIds <$> expectProjectAndBranchByTheseNames (toThese projectBranch) + pure (projectBranchPath projectBranch) + That path -> do + projectBranch <- expectCurrentProjectIds + pure (Path.resolve (projectBranchPath projectBranch) path) + BranchRelativePath.LoosePath path -> Cli.resolvePath' path + where + toThese = \case + Left branchName -> That branchName + Right (projectName, branchName) -> These projectName branchName + getIds = \case + ProjectAndBranch project branch -> ProjectAndBranch (view #projectId project) (view #branchId branch) + -- | Get the current project that a user is on. getCurrentProject :: Cli (Maybe Sqlite.Project) getCurrentProject = do @@ -76,6 +99,11 @@ getCurrentProjectIds :: Cli (Maybe (ProjectAndBranch ProjectId ProjectBranchId)) getCurrentProjectIds = fmap fst . preview projectBranchPathPrism <$> Cli.getCurrentPath +-- | Like 'getCurrentProjectIds', but fails with a message if the user is not on a project branch. +expectCurrentProjectIds :: Cli (ProjectAndBranch ProjectId ProjectBranchId) +expectCurrentProjectIds = + getCurrentProjectIds & onNothingM (Cli.returnEarly Output.NotOnProjectBranch) + -- | Get the current project+branch+branch path that a user is on. getCurrentProjectBranch :: Cli (Maybe (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch, Path.Path)) getCurrentProjectBranch = do diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index ef10a365d9..48f102ba86 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -418,20 +418,21 @@ loop e = do Cli.updateRoot newRoot description Cli.respond Success ForkLocalBranchI src0 dest0 -> do - srcb <- + (srcb, branchEmpty) <- case src0 of - Left hash -> Cli.resolveShortCausalHash hash - Right path' -> Cli.expectBranchAtPath' path' - Cli.assertNoBranchAtPath' dest0 + Left hash -> (, WhichBranchEmptyHash hash) <$> Cli.resolveShortCausalHash hash + Right path' -> do + absPath <- ProjectUtils.branchRelativePathToAbsolute path' + let srcp = Path.convert absPath + srcb <- Cli.expectBranchAtPath' srcp + pure (srcb, WhichBranchEmptyPath srcp) description <- inputDescription input - dest <- Cli.resolvePath' dest0 + dest <- ProjectUtils.branchRelativePathToAbsolute dest0 ok <- Cli.updateAtM description dest (const $ pure srcb) Cli.respond if ok then Success - else BranchEmpty case src0 of - Left hash -> WhichBranchEmptyHash hash - Right path -> WhichBranchEmptyPath path + else BranchEmpty branchEmpty MergeLocalBranchI src0 dest0 mergeMode -> do description <- inputDescription input src0 <- ProjectUtils.expectLooseCodeOrProjectBranch src0 @@ -1176,10 +1177,11 @@ loop e = do inputDescription :: Input -> Cli Text inputDescription input = case input of - ForkLocalBranchI src0 dest0 -> do - src <- hp' src0 - dest <- p' dest0 - pure ("fork " <> src <> " " <> dest) + SaveExecuteResultI _str -> pure "save-execute-result" + ForkLocalBranchI _src0 _dest0 -> do + -- src <- hp' src0 + -- dest <- p' dest0 + pure ("fork ") -- todo MergeLocalBranchI src0 dest0 mode -> do src <- looseCodeOrProjectToText src0 dest <- looseCodeOrProjectToText dest0 @@ -1370,7 +1372,6 @@ inputDescription input = PushRemoteBranchI {} -> wat QuitI {} -> wat ReleaseDraftI {} -> wat - SaveExecuteResultI {} -> wat ShowDefinitionByPrefixI {} -> wat ShowDefinitionI {} -> wat ShowReflogI {} -> wat diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 26003ea23b..c851d20e30 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -15,6 +15,7 @@ module Unison.Codebase.Editor.Input AbsBranchId, LooseCodeOrProject, parseBranchId, + parseBranchId2, parseShortCausalHash, HashOrHQSplit', Insistence (..), @@ -42,6 +43,7 @@ import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH import Unison.Codebase.SyncMode (SyncMode) import Unison.Codebase.Verbosity +import Unison.CommandLine.BranchRelativePath import Unison.HashQualified qualified as HQ import Unison.Name (Name) import Unison.NameSegment (NameSegment) @@ -86,6 +88,12 @@ parseBranchId ('#' : s) = case SCH.fromText (Text.pack s) of Just h -> pure $ Left h parseBranchId s = Right <$> Path.parsePath' s +parseBranchId2 :: String -> Either (P.Pretty P.ColorText) (Either ShortCausalHash BranchRelativePath) +parseBranchId2 ('#' : s) = case SCH.fromText (Text.pack s) of + Nothing -> Left "Invalid hash, expected a base32hex string." + Just h -> Right (Left h) +parseBranchId2 s = Right <$> parseBranchRelativePath s + parseShortCausalHash :: String -> Either String ShortCausalHash parseShortCausalHash ('#' : s) | Just sch <- SCH.fromText (Text.pack s) = Right sch parseShortCausalHash _ = Left "Invalid hash, expected a base32hex string." @@ -102,7 +110,7 @@ data Input -- directory ops -- `Link` must describe a repo and a source path within that repo. -- clone w/o merge, error if would clobber - ForkLocalBranchI (Either ShortCausalHash Path') Path' + ForkLocalBranchI (Either ShortCausalHash BranchRelativePath) BranchRelativePath | -- merge first causal into destination MergeLocalBranchI LooseCodeOrProject LooseCodeOrProject Branch.MergeMode | PreviewMergeLocalBranchI LooseCodeOrProject LooseCodeOrProject diff --git a/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs b/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs new file mode 100644 index 0000000000..f9ff1bb4a8 --- /dev/null +++ b/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs @@ -0,0 +1,74 @@ +module Unison.CommandLine.BranchRelativePath + ( BranchRelativePath (..), + parseBranchRelativePath, + branchRelativePathParser, + ) +where + +import Data.Char (isSpace) +import Data.Set qualified as Set +import Data.Text qualified as Text +import Data.These (These (..)) +import Text.Megaparsec qualified as Megaparsec +import Text.Megaparsec.Char qualified as Megaparsec +import Unison.Codebase.Path qualified as Path +import Unison.Codebase.Path.Parse qualified as Path +import Unison.Prelude +import Unison.Project (ProjectBranchName, ProjectBranchSpecifier (..), ProjectName) +import Unison.Project qualified as Project +import Unison.Util.ColorText qualified as CT +import Unison.Util.Pretty qualified as P + +data BranchRelativePath + = BranchRelative (These (Either ProjectBranchName (ProjectName, ProjectBranchName)) Path.Relative) + | LoosePath Path.Path' + deriving stock (Eq, Show) + +parseBranchRelativePath :: String -> Either (P.Pretty CT.ColorText) BranchRelativePath +parseBranchRelativePath str = + case Megaparsec.parse branchRelativePathParser "" (Text.pack str) of + Left e -> Left (P.string (Megaparsec.errorBundlePretty e)) + Right x -> Right x + +branchRelativePathParser :: Megaparsec.Parsec Void Text BranchRelativePath +branchRelativePathParser = + asum + [ LoosePath <$> path', + BranchRelative <$> branchRelative + ] + where + branchRelative :: Megaparsec.Parsec Void Text (These (Either ProjectBranchName (ProjectName, ProjectBranchName)) Path.Relative) + branchRelative = asum [fullPath, currentBranchRootPath] + + path' = Megaparsec.try do + offset <- Megaparsec.getOffset + pathStr <- Megaparsec.takeWhile1P (Just "path char") (not . isSpace) + case Path.parsePath' (Text.unpack pathStr) of + Left err -> failureAt offset err + Right x -> pure x + + relPath = do + offset <- Megaparsec.getOffset + path' >>= \(Path.Path' inner) -> case inner of + Left _ -> failureAt offset "Expected a relative path but found an absolute path" + Right x -> pure x + + fullPath = do + projectAndBranchNames <- do + projectBranch <- Project.projectAndBranchNamesParser ProjectBranchSpecifier'Name + offset <- Megaparsec.getOffset + _ <- Megaparsec.char ':' + case projectBranch of + This _ -> failureAt offset "Expected a project and branch before the colon (e.g. project/branch:a.path)" + That pbn -> pure (Left pbn) + These pn pbn -> pure (Right (pn, pbn)) + optional relPath <&> \case + Nothing -> This projectAndBranchNames + Just rp -> These projectAndBranchNames rp + + currentBranchRootPath = do + _ <- Megaparsec.char ':' + That <$> relPath + + failureAt :: forall a. Int -> String -> Megaparsec.Parsec Void Text a + failureAt offset str = Megaparsec.parseError (Megaparsec.FancyError offset (Set.singleton (Megaparsec.ErrorFail str))) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index d45e6a99c4..e71de98d58 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -6,7 +6,6 @@ module Unison.CommandLine.InputPatterns where import Control.Lens (preview, (^.)) import Control.Lens.Cons qualified as Cons -import Data.Char (isSpace) import Data.List (intercalate) import Data.List.Extra qualified as List import Data.List.NonEmpty qualified as NE @@ -21,7 +20,6 @@ import System.Console.Haskeline.Completion (Completion (Completion)) import System.Console.Haskeline.Completion qualified as Haskeline import System.Console.Haskeline.Completion qualified as Line import Text.Megaparsec qualified as Megaparsec -import Text.Megaparsec.Char qualified as Megaparsec import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId) import U.Codebase.Sqlite.Project qualified as Sqlite import U.Codebase.Sqlite.Queries qualified as Queries @@ -47,6 +45,7 @@ import Unison.Codebase.SyncMode qualified as SyncMode import Unison.Codebase.Verbosity (Verbosity) import Unison.Codebase.Verbosity qualified as Verbosity import Unison.CommandLine +import Unison.CommandLine.BranchRelativePath (parseBranchRelativePath) import Unison.CommandLine.Completion import Unison.CommandLine.FZFResolvers qualified as Resolvers import Unison.CommandLine.Globbing qualified as Globbing @@ -61,7 +60,6 @@ import Unison.NameSegment qualified as NameSegment import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectAndBranchNames (..), ProjectBranchName, ProjectBranchNameOrLatestRelease (..), ProjectBranchSpecifier (..), ProjectName, Semver) import Unison.Project.Util (ProjectContext (..), projectContextFromPath) -import Unison.Project qualified as Project import Unison.Syntax.HashQualified qualified as HQ (fromString) import Unison.Syntax.Name qualified as Name (fromText, unsafeFromString) import Unison.Util.ColorText qualified as CT @@ -1179,9 +1177,9 @@ forkLocal = ] (makeExample forkLocal ["src", "dest"] <> "creates the namespace `dest` as a copy of `src`.") ( \case - [src, dest] -> first fromString $ do - src <- Input.parseBranchId src - dest <- Path.parsePath' dest + [src, dest] -> do + src <- Input.parseBranchId2 src + dest <- parseBranchRelativePath dest pure $ Input.ForkLocalBranchI src dest _ -> Left (I.help forkLocal) ) @@ -3616,33 +3614,3 @@ showErrorItem :: Megaparsec.ErrorItem (Megaparsec.Token Text) -> String showErrorItem (Megaparsec.Tokens ts) = Megaparsec.showTokens (Proxy @Text) ts showErrorItem (Megaparsec.Label label) = NE.toList label showErrorItem Megaparsec.EndOfInput = "end of input" - -parseBranchRelativePath :: String -> Either (P.Pretty CT.ColorText) (These (These ProjectName ProjectBranchName) Path.Relative) -parseBranchRelativePath str = - case Megaparsec.parse branchRelativePathParser "" (Text.pack str) of - Left e -> Left (P.string (Megaparsec.errorBundlePretty e)) - Right x -> Right x - -branchRelativePathParser :: Megaparsec.Parsec Void Text (These (These ProjectName ProjectBranchName) Path.Relative) -branchRelativePathParser = - asum - [fullPath, currentBranchRootPath] - where - relPath = do - pathStr <- Megaparsec.takeWhile1P (Just "path char") (not . isSpace) - case Path.parsePath' (Text.unpack pathStr) of - Left err -> fail err - Right (Path.Path' inner) -> case inner of - Left _ -> fail "Expected a relative path but found an absolute path" - Right x -> pure x - - fullPath = do - projectAndBranchNames <- Project.projectAndBranchNamesParser ProjectBranchSpecifier'Name - optional (Megaparsec.char ':') >>= \case - Nothing -> pure (This projectAndBranchNames) - Just _ -> do - These projectAndBranchNames <$> relPath - - currentBranchRootPath = do - _ <- Megaparsec.char ':' - That <$> relPath diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index 20ae631330..203cd2e0fa 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -91,6 +91,7 @@ library Unison.Codebase.TranscriptParser Unison.Codebase.Watch Unison.CommandLine + Unison.CommandLine.BranchRelativePath Unison.CommandLine.Completion Unison.CommandLine.DisplayValues Unison.CommandLine.FuzzySelect diff --git a/unison-src/transcripts/branch-relative-path.md b/unison-src/transcripts/branch-relative-path.md new file mode 100644 index 0000000000..8414db2f16 --- /dev/null +++ b/unison-src/transcripts/branch-relative-path.md @@ -0,0 +1,31 @@ +```ucm:hide +.> builtins.merge +.> project.create-empty p0 +.> project.create-empty p1 +``` + +```unison +foo = 5 +foo.bar = 1 +``` + +```ucm +p0/main> add +``` + +```unison +bonk = 5 +donk.bonk = 1 +``` + +```ucm +p1/main> add +p1/main> fork p0/main: zzz +p1/main> find zzz +p1/main> fork p0/main:foo yyy +p1/main> find yyy +p0/main> fork p1/main: p0/main:p1 +p0/main> ls p1 +p0/main> ls p1.zzz +p0/main> ls p1.yyy +``` diff --git a/unison-src/transcripts/branch-relative-path.output.md b/unison-src/transcripts/branch-relative-path.output.md new file mode 100644 index 0000000000..93815b97c2 --- /dev/null +++ b/unison-src/transcripts/branch-relative-path.output.md @@ -0,0 +1,97 @@ +```unison +foo = 5 +foo.bar = 1 +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + foo : Nat + foo.bar : Nat + +``` +```ucm +p0/main> add + + ⍟ I've added these definitions: + + foo : Nat + foo.bar : Nat + +``` +```unison +bonk = 5 +donk.bonk = 1 +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + bonk : Nat + (also named foo) + donk.bonk : Nat + (also named foo.bar) + +``` +```ucm +p1/main> add + + ⍟ I've added these definitions: + + bonk : Nat + donk.bonk : Nat + +p1/main> fork p0/main: zzz + + Done. + +p1/main> find zzz + + 1. zzz.foo : Nat + 2. zzz.foo.bar : Nat + + +p1/main> fork p0/main:foo yyy + + Done. + +p1/main> find yyy + + 1. yyy.bar : Nat + + +p0/main> fork p1/main: p0/main:p1 + + Done. + +p0/main> ls p1 + + 1. bonk (##Nat) + 2. donk/ (1 term) + 3. yyy/ (1 term) + 4. zzz/ (2 terms) + +p0/main> ls p1.zzz + + 1. foo (##Nat) + 2. foo/ (1 term) + +p0/main> ls p1.yyy + + 1. bar (##Nat) + +```