diff --git a/parser-typechecker/src/Unison/Codebase/ShortBranchHash.hs b/parser-typechecker/src/Unison/Codebase/ShortBranchHash.hs index b35f3a2ff..a3ab19908 100644 --- a/parser-typechecker/src/Unison/Codebase/ShortBranchHash.hs +++ b/parser-typechecker/src/Unison/Codebase/ShortBranchHash.hs @@ -1,13 +1,19 @@ -{- ORMOLU_DISABLE -} -- Remove this when the file is ready to be auto-formatted -module Unison.Codebase.ShortBranchHash where +module Unison.Codebase.ShortBranchHash + ( toString, + toHash, + fromHash, + fullFromHash, + fromText, + ShortBranchHash (..), + ) +where -import Unison.Prelude -import qualified Unison.Hash as Hash -import qualified Data.Text as Text import qualified Data.Set as Set +import qualified Data.Text as Text +import qualified Unison.Hash as Hash +import Unison.Prelude -newtype ShortBranchHash = - ShortBranchHash { toText :: Text } -- base32hex characters +newtype ShortBranchHash = ShortBranchHash {toText :: Text} -- base32hex characters deriving stock (Eq, Ord, Generic) toString :: ShortBranchHash -> String @@ -26,9 +32,10 @@ fullFromHash = ShortBranchHash . Hash.base32Hex . coerce -- abc -> SBH abc -- #abc -> SBH abc fromText :: Text -> Maybe ShortBranchHash -fromText (Text.dropWhile (=='#') -> t) - | Text.all (`Set.member` Hash.validBase32HexChars) t = Just - $ ShortBranchHash t +fromText (Text.dropWhile (== '#') -> t) + | Text.all (`Set.member` Hash.validBase32HexChars) t = + Just $ + ShortBranchHash t fromText _ = Nothing instance Show ShortBranchHash where diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 124bacf24..52660dfdd 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -550,8 +550,8 @@ loop = do else respondNumbered $ ShowDiffNamespace - Path.absoluteEmpty - Path.absoluteEmpty + (Right Path.absoluteEmpty) + (Right Path.absoluteEmpty) ppe outputDiff where @@ -694,18 +694,22 @@ loop = do else diffHelper (Branch.head destb) (Branch.head merged) >>= respondNumbered . uncurry (ShowDiffAfterMergePreview dest0 dest) - DiffNamespaceI before0 after0 -> do - let [beforep, afterp] = - resolveToAbsolute <$> [before0, after0] - before <- Branch.head <$> getAt beforep - after <- Branch.head <$> getAt afterp - case (Branch.isEmpty0 before, Branch.isEmpty0 after) of - (True, True) -> respond . NamespaceEmpty $ Right (beforep, afterp) - (True, False) -> respond . NamespaceEmpty $ Left beforep - (False, True) -> respond . NamespaceEmpty $ Left afterp + DiffNamespaceI before after -> unlessError do + let (absBefore, absAfter) = (resolveToAbsolute <$> before, resolveToAbsolute <$> after) + beforeBranch0 <- Branch.head <$> branchForBranchId absBefore + afterBranch0 <- Branch.head <$> branchForBranchId absAfter + lift $ case (Branch.isEmpty0 beforeBranch0, Branch.isEmpty0 afterBranch0) of + (True, True) -> respond . NamespaceEmpty $ (absBefore Nel.:| [absAfter]) + (True, False) -> respond . NamespaceEmpty $ (absBefore Nel.:| []) + (False, True) -> respond . NamespaceEmpty $ (absAfter Nel.:| []) _ -> do - (ppe, outputDiff) <- diffHelper before after - respondNumbered $ ShowDiffNamespace beforep afterp ppe outputDiff + (ppe, outputDiff) <- diffHelper beforeBranch0 afterBranch0 + respondNumbered $ + ShowDiffNamespace + (resolveToAbsolute <$> before) + (resolveToAbsolute <$> after) + ppe + outputDiff CreatePullRequestI baseRepo headRepo -> do result <- join @(Either GitError) <$> viewRemoteBranch baseRepo \baseBranch -> do viewRemoteBranch headRepo \headBranch -> do @@ -3403,3 +3407,12 @@ fuzzySelectNamespace pos searchBranch0 = do tShow inputs ) + +-- | Get a branch from a BranchId, returning an empty one if missing, or failing with an +-- appropriate error message if a hash cannot be found. +branchForBranchId :: Functor m => AbsBranchId -> ExceptT (Output v) (Action' m v) (Branch m) +branchForBranchId = \case + Left hash -> do + resolveShortBranchHash hash + Right path -> do + lift $ getAt path diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 090b4ff00..3c2405db3 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -5,7 +5,7 @@ module Unison.Codebase.Editor.Input , Event(..) , OutputLocation(..) , PatchPath - , BranchId, parseBranchId + , BranchId, AbsBranchId, parseBranchId , HashOrHQSplit' , Insistence(..) ) where @@ -40,6 +40,7 @@ type Source = Text -- "id x = x\nconst a b = a" type SourceName = Text -- "foo.u" or "buffer 7" type PatchPath = Path.Split' type BranchId = Either ShortBranchHash Path' +type AbsBranchId = Either ShortBranchHash Path.Absolute type HashOrHQSplit' = Either ShortHash Path.HQSplit' -- | Should we force the operation or not? @@ -61,7 +62,7 @@ data Input -- merge first causal into destination | MergeLocalBranchI Path' Path' Branch.MergeMode | PreviewMergeLocalBranchI Path' Path' - | DiffNamespaceI Path' Path' -- old new + | DiffNamespaceI BranchId BranchId -- old new | PullRemoteBranchI (Maybe ReadRemoteNamespace) Path' SyncMode Verbosity | PushRemoteBranchI (Maybe WriteRemotePath) Path' PushBehavior SyncMode | CreatePullRequestI ReadRemoteNamespace ReadRemoteNamespace diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 22f17e32f..5138d707d 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -62,6 +62,7 @@ import qualified Unison.Util.Pretty as P import Unison.Util.Relation (Relation) import qualified Unison.WatchKind as WK import Data.Set.NonEmpty (NESet) +import Data.List.NonEmpty (NonEmpty) type ListDetailed = Bool @@ -77,7 +78,7 @@ pushPull push pull p = case p of Pull -> pull data NumberedOutput v - = ShowDiffNamespace Path.Absolute Path.Absolute PPE.PrettyPrintEnv (BranchDiffOutput v Ann) + = ShowDiffNamespace AbsBranchId AbsBranchId PPE.PrettyPrintEnv (BranchDiffOutput v Ann) | ShowDiffAfterUndo PPE.PrettyPrintEnv (BranchDiffOutput v Ann) | ShowDiffAfterDeleteDefinitions PPE.PrettyPrintEnv (BranchDiffOutput v Ann) | ShowDiffAfterDeleteBranch Path.Absolute PPE.PrettyPrintEnv (BranchDiffOutput v Ann) @@ -230,7 +231,7 @@ data Output v | DefaultMetadataNotification | BadRootBranch GetRootBranchError | CouldntLoadBranch Branch.Hash - | NamespaceEmpty (Either Path.Absolute (Path.Absolute, Path.Absolute)) + | NamespaceEmpty (NonEmpty AbsBranchId) | NoOp | -- Refused to push, either because a `push` targeted an empty namespace, or a `push.create` targeted a non-empty namespace. RefusedToPush PushBehavior diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 300023004..7f78dc75f 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -1215,12 +1215,12 @@ diffNamespace = ) ( \case [before, after] -> first fromString $ do - before <- Path.parsePath' before - after <- Path.parsePath' after + before <- Input.parseBranchId before + after <- Input.parseBranchId after pure $ Input.DiffNamespaceI before after [before] -> first fromString $ do - before <- Path.parsePath' before - pure $ Input.DiffNamespaceI before Path.currentPath + before <- Input.parseBranchId before + pure $ Input.DiffNamespaceI before (Right Path.currentPath) _ -> Left $ I.help diffNamespace ) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index c8bc32a29..2d45a7ff9 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -124,6 +124,7 @@ import Unison.Var (Var) import qualified Unison.Var as Var import qualified Unison.WatchKind as WK import Prelude hiding (readFile, writeFile) +import qualified Data.List.NonEmpty as NEList type Pretty = P.Pretty P.ColorText @@ -150,7 +151,7 @@ notifyNumbered o = case o of undoTip ] ) - (showDiffNamespace ShowNumbers ppe e e diff) + (showDiffNamespace ShowNumbers ppe (absPathToBranchId Path.absoluteEmpty) (absPathToBranchId Path.absoluteEmpty) diff) ShowDiffAfterDeleteBranch bAbs ppe diff -> first ( \p -> @@ -160,7 +161,7 @@ notifyNumbered o = case o of undoTip ] ) - (showDiffNamespace ShowNumbers ppe bAbs bAbs diff) + (showDiffNamespace ShowNumbers ppe (absPathToBranchId bAbs) (absPathToBranchId bAbs) diff) ShowDiffAfterModifyBranch b' _ _ (OBD.isEmpty -> True) -> (P.wrap $ "Nothing changed in" <> prettyPath' b' <> ".", mempty) ShowDiffAfterModifyBranch b' bAbs ppe diff -> @@ -174,7 +175,7 @@ notifyNumbered o = case o of undoTip ] ) - (showDiffNamespace ShowNumbers ppe bAbs bAbs diff) + (showDiffNamespace ShowNumbers ppe (absPathToBranchId bAbs) (absPathToBranchId bAbs) diff) ShowDiffAfterMerge _ _ _ (OBD.isEmpty -> True) -> (P.wrap $ "Nothing changed as a result of the merge.", mempty) ShowDiffAfterMerge dest' destAbs ppe diffOutput -> @@ -198,7 +199,7 @@ notifyNumbered o = case o of <> " to undo the results of this merge." ] ) - (showDiffNamespace ShowNumbers ppe destAbs destAbs diffOutput) + (showDiffNamespace ShowNumbers ppe (absPathToBranchId destAbs) (absPathToBranchId destAbs) diffOutput) ShowDiffAfterMergePropagate dest' destAbs patchPath' ppe diffOutput -> first ( \p -> @@ -224,7 +225,7 @@ notifyNumbered o = case o of <> " to undo the results of this merge." ] ) - (showDiffNamespace ShowNumbers ppe destAbs destAbs diffOutput) + (showDiffNamespace ShowNumbers ppe (absPathToBranchId destAbs) (absPathToBranchId destAbs) diffOutput) ShowDiffAfterMergePreview dest' destAbs ppe diffOutput -> first ( \p -> @@ -234,11 +235,11 @@ notifyNumbered o = case o of p ] ) - (showDiffNamespace ShowNumbers ppe destAbs destAbs diffOutput) + (showDiffNamespace ShowNumbers ppe (absPathToBranchId destAbs) (absPathToBranchId destAbs) diffOutput) ShowDiffAfterUndo ppe diffOutput -> first (\p -> P.lines ["Here are the changes I undid", "", p]) - (showDiffNamespace ShowNumbers ppe e e diffOutput) + (showDiffNamespace ShowNumbers ppe (absPathToBranchId Path.absoluteEmpty) (absPathToBranchId Path.absoluteEmpty) diffOutput) ShowDiffAfterPull dest' destAbs ppe diff -> if OBD.isEmpty diff then ("✅ Looks like " <> prettyPath' dest' <> " is up to date.", mempty) @@ -253,7 +254,7 @@ notifyNumbered o = case o of undoTip ] ) - (showDiffNamespace ShowNumbers ppe destAbs destAbs diff) + (showDiffNamespace ShowNumbers ppe (absPathToBranchId destAbs) (absPathToBranchId destAbs) diff) ShowDiffAfterCreatePR baseRepo headRepo ppe diff -> if OBD.isEmpty diff then @@ -284,7 +285,7 @@ notifyNumbered o = case o of ] ) ) - (showDiffNamespace HideNumbers ppe e e diff) + (showDiffNamespace HideNumbers ppe (absPathToBranchId Path.absoluteEmpty) (absPathToBranchId Path.absoluteEmpty) diff) -- todo: these numbers aren't going to work, -- since the content isn't necessarily here. -- Should we have a mode with no numbers? :P @@ -302,7 +303,7 @@ notifyNumbered o = case o of <> P.group (prettyPath' authorPath' <> ".") ] ) - (showDiffNamespace ShowNumbers ppe bAbs bAbs diff) + (showDiffNamespace ShowNumbers ppe (absPathToBranchId bAbs) (absPathToBranchId bAbs) diff) CantDeleteDefinitions ppeDecl endangerments -> (P.warnCallout $ P.lines @@ -331,7 +332,7 @@ notifyNumbered o = case o of ] , numberedArgsForEndangerments ppeDecl endangerments) where - e = Path.absoluteEmpty + absPathToBranchId = Right undoTip = tip $ "You can use" <> IP.makeExample' IP.undo @@ -371,20 +372,18 @@ notifyUser dir o = case o of <> "when I tried to load it." NamespaceEmpty p -> case p of - Right (p0, p1) -> - pure - . P.warnCallout - $ "The namespaces " - <> P.string (show p0) - <> " and " - <> P.string (show p1) - <> " are empty. Was there a typo?" - Left p0 -> + (p0 NEList.:| []) -> pure . P.warnCallout $ "The namespace " - <> P.string (show p0) + <> prettyBranchId p0 <> " is empty. Was there a typo?" + ps -> + pure + . P.warnCallout + $ "The namespaces " + <> P.commas (prettyBranchId <$> ps) + <> " are empty. Was there a typo?" WarnIncomingRootBranch current hashes -> pure $ if null hashes @@ -1457,6 +1456,11 @@ prettyPath' p' = then "the current namespace" else P.blue (P.shown p') +prettyBranchId :: Input.AbsBranchId -> Pretty +prettyBranchId = \case + Left sbh -> prettySBH sbh + Right absPath -> prettyAbsolute $ absPath + prettyRelative :: Path.Relative -> Pretty prettyRelative = P.blue . P.shown @@ -1922,8 +1926,8 @@ showDiffNamespace :: Var v => ShowNumbers -> PPE.PrettyPrintEnv -> - Path.Absolute -> - Path.Absolute -> + Input.AbsBranchId -> + Input.AbsBranchId -> OBD.BranchDiffOutput v Ann -> (Pretty, NumberedArgs) showDiffNamespace _ _ _ _ diffOutput @@ -2173,7 +2177,7 @@ showDiffNamespace sn ppe oldPath newPath OBD.BranchDiffOutput {..} = 0 -> mempty c -> " (+" <> P.shown c <> " metadata)" - prettySummarizePatch, prettyNamePatch :: Path.Absolute -> OBD.PatchDisplay -> Numbered Pretty + prettySummarizePatch, prettyNamePatch :: Input.AbsBranchId -> OBD.PatchDisplay -> Numbered Pretty -- 12. patch p (added 3 updates, deleted 1) prettySummarizePatch prefix (name, patchDiff) = do n <- numPatch prefix name @@ -2237,7 +2241,7 @@ showDiffNamespace sn ppe oldPath newPath OBD.BranchDiffOutput {..} = pure (n, phq' hq, mempty) downArrow = P.bold "↓" - mdTypeLine :: Path.Absolute -> OBD.TypeDisplay v a -> Numbered (Pretty, Pretty) + mdTypeLine :: Input.AbsBranchId -> OBD.TypeDisplay v a -> Numbered (Pretty, Pretty) mdTypeLine p (hq, r, odecl, mddiff) = do n <- numHQ' p hq (Referent.Ref r) fmap ((n,) . P.linesNonEmpty) . sequence $ @@ -2248,7 +2252,7 @@ showDiffNamespace sn ppe oldPath newPath OBD.BranchDiffOutput {..} = -- + 2. MIT : License -- - 3. AllRightsReserved : License mdTermLine :: - Path.Absolute -> + Input.AbsBranchId -> P.Width -> OBD.TermDisplay v a -> Numbered (Pretty, Pretty) @@ -2302,21 +2306,27 @@ showDiffNamespace sn ppe oldPath newPath OBD.BranchDiffOutput {..} = (P.syntaxToColor . DeclPrinter.prettyDeclOrBuiltinHeader (HQ'.toHQ hq)) phq' :: _ -> Pretty = P.syntaxToColor . prettyHashQualified' phq :: _ -> Pretty = P.syntaxToColor . prettyHashQualified - -- + -- DeclPrinter.prettyDeclHeader : HQ -> Either - numPatch :: Path.Absolute -> Name -> Numbered Pretty + numPatch :: Input.AbsBranchId -> Name -> Numbered Pretty numPatch prefix name = - addNumberedArg . Name.toString . Name.makeAbsolute $ Path.prefixName prefix name + addNumberedArg $ prefixBranchId prefix name - numHQ :: Path.Absolute -> HQ.HashQualified Name -> Referent -> Numbered Pretty - numHQ prefix hq r = addNumberedArg (HQ.toString hq') - where - hq' = HQ.requalify (fmap (Name.makeAbsolute . Path.prefixName prefix) hq) r + numHQ :: Input.AbsBranchId -> HQ.HashQualified Name -> Referent -> Numbered Pretty + numHQ prefix hq r = + addNumberedArg . HQ.toStringWith (prefixBranchId prefix) . HQ.requalify hq $ r - numHQ' :: Path.Absolute -> HQ'.HashQualified Name -> Referent -> Numbered Pretty - numHQ' prefix hq r = addNumberedArg (HQ'.toString hq') - where - hq' = HQ'.requalify (fmap (Name.makeAbsolute . Path.prefixName prefix) hq) r + numHQ' :: Input.AbsBranchId -> HQ'.HashQualified Name -> Referent -> Numbered Pretty + numHQ' prefix hq r = + addNumberedArg . HQ'.toStringWith (prefixBranchId prefix) . HQ'.requalify hq $ r + + -- E.g. + -- prefixBranchId "#abcdef" "base.List.map" -> "#abcdef.base.List.map" + -- prefixBranchId ".base" "List.map" -> ".base.List.map" + prefixBranchId :: Input.AbsBranchId -> Name -> String + prefixBranchId branchId name = case branchId of + Left sbh -> "#" <> SBH.toString sbh <> ":" <> Name.toString (Name.makeAbsolute name) + Right pathPrefix -> Name.toString (Name.makeAbsolute . Path.prefixName pathPrefix $ name) addNumberedArg :: String -> Numbered Pretty addNumberedArg s = case sn of diff --git a/unison-core/src/Unison/HashQualified'.hs b/unison-core/src/Unison/HashQualified'.hs index c0776f641..f94913fad 100644 --- a/unison-core/src/Unison/HashQualified'.hs +++ b/unison-core/src/Unison/HashQualified'.hs @@ -68,6 +68,9 @@ toHash = \case toString :: Show n => HashQualified n -> String toString = Text.unpack . toText +toStringWith :: (n -> String) -> HashQualified n -> String +toStringWith f = Text.unpack . toTextWith (Text.pack . f) + -- Parses possibly-hash-qualified into structured type. fromText :: Text -> Maybe (HashQualified Name) fromText t = case Text.breakOn "#" t of diff --git a/unison-core/src/Unison/HashQualified.hs b/unison-core/src/Unison/HashQualified.hs index e9a195aa6..a4735caee 100644 --- a/unison-core/src/Unison/HashQualified.hs +++ b/unison-core/src/Unison/HashQualified.hs @@ -85,6 +85,9 @@ take i = \case toString :: Show n => HashQualified n -> String toString = Text.unpack . toText +toStringWith :: (n -> String) -> HashQualified n -> String +toStringWith f = Text.unpack . toTextWith (Text.pack . f) + fromString :: String -> Maybe (HashQualified Name) fromString = fromText . Text.pack diff --git a/unison-src/transcripts/diff.md b/unison-src/transcripts/diff-namespace.md similarity index 95% rename from unison-src/transcripts/diff.md rename to unison-src/transcripts/diff-namespace.md index 9534730d4..3f2f4a7fc 100644 --- a/unison-src/transcripts/diff.md +++ b/unison-src/transcripts/diff-namespace.md @@ -152,6 +152,26 @@ a = 777 .nsw> view a b ``` +## Should be able to diff a namespace hash from history. + +```unison +x = 1 +``` + +```ucm +.hashdiff> add +``` + +```unison +y = 2 +``` + +```ucm +.hashdiff> add +.hashdiff> history +.hashdiff> diff.namespace #hkrqt3tm05 #is7tu6katt +``` + ## Updates: -- 1 to 1 diff --git a/unison-src/transcripts/diff.output.md b/unison-src/transcripts/diff-namespace.output.md similarity index 93% rename from unison-src/transcripts/diff.output.md rename to unison-src/transcripts/diff-namespace.output.md index 4889ad740..e19085c3c 100644 --- a/unison-src/transcripts/diff.output.md +++ b/unison-src/transcripts/diff-namespace.output.md @@ -686,6 +686,75 @@ a = 777 use Nat + a#5f8uodgrtf + 1 +``` +## Should be able to diff a namespace hash from history. + +```unison +x = 1 +``` + +```ucm + + 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`: + + x : Nat + +``` +```ucm + ☝️ The namespace .hashdiff is empty. + +.hashdiff> add + + ⍟ I've added these definitions: + + x : Nat + +``` +```unison +y = 2 +``` + +```ucm + + 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`: + + y : Nat + +``` +```ucm +.hashdiff> add + + ⍟ I've added these definitions: + + y : Nat + +.hashdiff> history + + Note: The most recent namespace hash is immediately below this + message. + + ⊙ #is7tu6katt + + + Adds / updates: + + y + + □ #hkrqt3tm05 (start of history) + +.hashdiff> diff.namespace #hkrqt3tm05 #is7tu6katt + + Added definitions: + + 1. y : Nat + ``` ##