delete update.old and merge.old

codebase2/core/Unison/NameSegment.hs

@@ -3,7 +3,6 @@ module Unison.NameSegment
     toUnescapedText,
 
     -- * Sentinel name segments
-    defaultPatchSegment,
     docSegment,
     libSegment,
     pattern LibSegment,
@@ -29,9 +28,6 @@ import Unison.NameSegment.Internal (NameSegment (NameSegment, toUnescapedText))
 ------------------------------------------------------------------------------------------------------------------------
 -- special segment names
 
-defaultPatchSegment :: NameSegment
-defaultPatchSegment = NameSegment "patch"
-
 docSegment :: NameSegment
 docSegment = NameSegment "doc"
 

parser-typechecker/package.yaml

@@ -38,7 +38,6 @@ library:
     - pretty-simple
     - regex-tdfa
     - semialign
-    - semigroups
     - servant-client
     - stm
     - text

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

@@ -37,7 +37,6 @@ module Unison.Codebase.Branch
     headHash,
     children,
     nonEmptyChildren,
-    deepEdits',
     namespaceStats,
 
     -- * step
@@ -55,11 +54,6 @@ module Unison.Codebase.Branch
     annihilateTypeName,
     deleteTypeName,
     setChildBranch,
-    replacePatch,
-    deletePatch,
-    getMaybePatch,
-    getPatch,
-    modifyPatches,
 
     -- ** Children queries
     getAt,
@@ -86,7 +80,6 @@ module Unison.Codebase.Branch
     deepTerms,
     deepTypes,
     deepDefns,
-    deepEdits,
     deepPaths,
     deepReferents,
     deepTermReferences,
@@ -102,7 +95,7 @@ import Data.Map qualified as Map
 import Data.Semialign qualified as Align
 import Data.These (These (..))
 import U.Codebase.Branch.Type (NamespaceStats (..))
-import U.Codebase.HashTags (CausalHash, PatchHash (..))
+import U.Codebase.HashTags (CausalHash)
 import Unison.Codebase.Branch.Raw (Raw)
 import Unison.Codebase.Branch.Type
   ( Branch (..),
@@ -113,7 +106,6 @@ import Unison.Codebase.Branch.Type
     branch0,
     children,
     deepDefns,
-    deepEdits,
     deepPaths,
     deepTerms,
     deepTypes,
@@ -128,13 +120,9 @@ import Unison.Codebase.Branch.Type
   )
 import Unison.Codebase.Causal (Causal)
 import Unison.Codebase.Causal qualified as Causal
-import Unison.Codebase.Patch (Patch)
-import Unison.Codebase.Patch qualified as Patch
 import Unison.Codebase.Path (Path)
 import Unison.Hashing.V2 qualified as Hashing (ContentAddressable (contentHash))
 import Unison.Hashing.V2.Convert qualified as H
-import Unison.Name (Name)
-import Unison.Name qualified as Name
 import Unison.NameSegment (NameSegment)
 import Unison.NameSegment qualified as NameSegment
 import Unison.Prelude hiding (empty)
@@ -221,27 +209,14 @@ namespaceStats b =
   NamespaceStats
     { numContainedTerms = Relation.size $ deepTerms b,
       numContainedTypes = Relation.size $ deepTypes b,
-      numContainedPatches = Map.size $ deepEdits b
+      numContainedPatches = 0
     }
 
 -- | Update the head of the current causal.
 -- This re-hashes the current causal head after modifications.
 head_ :: Lens' (Branch m) (Branch0 m)
 head_ = history . Causal.head_
 
--- | a version of `deepEdits` that returns the `m Patch` as well.
-deepEdits' :: Branch0 m -> Map Name (PatchHash, m Patch)
-deepEdits' = go id
-  where
-    -- can change this to an actual prefix once Name is a [NameSegment]
-    go :: (Name -> Name) -> Branch0 m -> Map Name (PatchHash, m Patch)
-    go addPrefix b0 =
-      Map.mapKeys (addPrefix . Name.fromSegment) (b0 ^. edits)
-        <> foldMap f (Map.toList (b0 ^. children))
-      where
-        f :: (NameSegment, Branch m) -> Map Name (PatchHash, m Patch)
-        f (c, b) = go (addPrefix . Name.cons c) (head b)
-
 -- | Discards the history of a Branch0's children, recursively
 discardHistory0 :: (Applicative m) => Branch0 m -> Branch0 m
 discardHistory0 = over children (fmap tweak)
@@ -382,33 +357,6 @@ getChildBranch seg b = fromMaybe empty $ Map.lookup seg (b ^. children)
 setChildBranch :: NameSegment -> Branch m -> Branch0 m -> Branch0 m
 setChildBranch seg b = over children (updateChildren seg b)
 
-getPatch :: (Applicative m) => NameSegment -> Branch0 m -> m Patch
-getPatch seg b = case Map.lookup seg (b ^. edits) of
-  Nothing -> pure Patch.empty
-  Just (_, p) -> p
-
-getMaybePatch :: (Applicative m) => NameSegment -> Branch0 m -> m (Maybe Patch)
-getMaybePatch seg b = case Map.lookup seg (b ^. edits) of
-  Nothing -> pure Nothing
-  Just (_, p) -> Just <$> p
-
-modifyPatches ::
-  (Monad m) => NameSegment -> (Patch -> Patch) -> Branch0 m -> m (Branch0 m)
-modifyPatches seg f = mapMOf edits update
-  where
-    update m = do
-      p' <- case Map.lookup seg m of
-        Nothing -> pure $ f Patch.empty
-        Just (_, p) -> f <$> p
-      let h = H.hashPatch p'
-      pure $ Map.insert seg (PatchHash h, pure p') m
-
-replacePatch :: (Applicative m) => NameSegment -> Patch -> Branch0 m -> Branch0 m
-replacePatch n p = over edits (Map.insert n (PatchHash (H.hashPatch p), pure p))
-
-deletePatch :: NameSegment -> Branch0 m -> Branch0 m
-deletePatch n = over edits (Map.delete n)
-
 updateChildren ::
   NameSegment ->
   Branch m ->

parser-typechecker/src/Unison/Codebase/Branch/BranchDiff.hs

@@ -1,13 +1,13 @@
-module Unison.Codebase.Branch.BranchDiff where
+module Unison.Codebase.Branch.BranchDiff
+  ( BranchDiff (..),
+    diff0,
+  )
+where
 
 import Control.Lens
-import Data.Map (Map)
-import Data.Map qualified as Map
-import Data.Map.Merge.Lazy qualified as MapMerge
 import Unison.Codebase.Branch (Branch0)
 import Unison.Codebase.Branch qualified as Branch
 import Unison.Codebase.Metadata qualified as Metadata
-import Unison.Codebase.Patch qualified as Patch
 import Unison.NameSegment (NameSegment)
 import Unison.Reference (Reference)
 import Unison.Referent (Referent)
@@ -22,41 +22,27 @@ data BranchDiff = BranchDiff
   { addedTerms :: Star Referent NameSegment,
     removedTerms :: Star Referent NameSegment,
     addedTypes :: Star Reference NameSegment,
-    removedTypes :: Star Reference NameSegment,
-    changedPatches :: Map NameSegment Patch.PatchDiff
+    removedTypes :: Star Reference NameSegment
   }
   deriving (Eq, Ord, Show)
 
-diff0 :: (Monad m) => Branch0 m -> Branch0 m -> m BranchDiff
+diff0 :: Branch0 m -> Branch0 m -> BranchDiff
 diff0 old new = do
-  newEdits <- sequenceA $ snd <$> new ^. Branch.edits
-  oldEdits <- sequenceA $ snd <$> old ^. Branch.edits
-  let diffEdits =
-        MapMerge.merge
-          (MapMerge.mapMissing $ \_ p -> Patch.diff p mempty)
-          (MapMerge.mapMissing $ \_ p -> Patch.diff mempty p)
-          (MapMerge.zipWithMatched (const Patch.diff))
-          newEdits
-          oldEdits
-  pure $
-    BranchDiff
-      { addedTerms = Star2.difference (new ^. Branch.terms) (old ^. Branch.terms),
-        removedTerms = Star2.difference (old ^. Branch.terms) (new ^. Branch.terms),
-        addedTypes = Star2.difference (new ^. Branch.types) (old ^. Branch.types),
-        removedTypes = Star2.difference (old ^. Branch.types) (new ^. Branch.types),
-        changedPatches = diffEdits
-      }
+  BranchDiff
+    { addedTerms = Star2.difference (new ^. Branch.terms) (old ^. Branch.terms),
+      removedTerms = Star2.difference (old ^. Branch.terms) (new ^. Branch.terms),
+      addedTypes = Star2.difference (new ^. Branch.types) (old ^. Branch.types),
+      removedTypes = Star2.difference (old ^. Branch.types) (new ^. Branch.types)
+    }
 
 instance Semigroup BranchDiff where
   left <> right =
     BranchDiff
       { addedTerms = addedTerms left <> addedTerms right,
         removedTerms = removedTerms left <> removedTerms right,
         addedTypes = addedTypes left <> addedTypes right,
-        removedTypes = removedTypes left <> removedTypes right,
-        changedPatches =
-          Map.unionWith (<>) (changedPatches left) (changedPatches right)
+        removedTypes = removedTypes left <> removedTypes right
       }
 
 instance Monoid BranchDiff where
-  mempty = BranchDiff mempty mempty mempty mempty mempty
+  mempty = BranchDiff mempty mempty mempty mempty

parser-typechecker/src/Unison/Codebase/Branch/Merge.hs

@@ -1,9 +1,3 @@
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE ViewPatterns #-}
-
 module Unison.Codebase.Branch.Merge
   ( MergeMode (..),
     merge'',
@@ -12,7 +6,6 @@ where
 
 import Data.Map qualified as Map
 import Data.Map.Merge.Lazy qualified as Map
-import U.Codebase.HashTags (PatchHash (..))
 import Unison.Codebase.Branch
   ( Branch (..),
     Branch0,
@@ -28,12 +21,8 @@ import Unison.Codebase.Branch qualified as Branch
 import Unison.Codebase.Branch.BranchDiff (BranchDiff (BranchDiff))
 import Unison.Codebase.Branch.BranchDiff qualified as BDiff
 import Unison.Codebase.Causal qualified as Causal
-import Unison.Codebase.Patch (Patch)
-import Unison.Codebase.Patch qualified as Patch
-import Unison.Hashing.V2.Convert qualified as H
 import Unison.Prelude hiding (empty)
 import Unison.Util.Map (unionWithM)
-import Unison.Util.Relation qualified as R
 import Unison.Util.Star2 qualified as Star2
 import Prelude hiding (head, read, subtract)
 
@@ -60,9 +49,9 @@ merge'' lca mode (Branch x) (Branch y) =
     combine :: Maybe (Branch0 m) -> Branch0 m -> Branch0 m -> m (Branch0 m)
     combine Nothing l r = merge0 lca mode l r
     combine (Just ca) l r = do
-      dl <- BDiff.diff0 ca l
-      dr <- BDiff.diff0 ca r
-      head0 <- apply ca (dl <> dr)
+      let dl = BDiff.diff0 ca l
+      let dr = BDiff.diff0 ca r
+      let head0 = apply ca (dl <> dr)
       children <-
         Map.mergeA
           (Map.traverseMaybeMissing $ combineMissing ca)
@@ -81,34 +70,13 @@ merge'' lca mode (Branch x) (Branch y) =
             then pure Nothing
             else pure $ Just nw
 
-    apply :: Branch0 m -> BranchDiff -> m (Branch0 m)
-    apply b0 (BranchDiff addedTerms removedTerms addedTypes removedTypes changedPatches) = do
-      patches <-
-        sequenceA $
-          Map.differenceWith patchMerge (pure @m <$> b0 ^. Branch.edits) changedPatches
-      let newPatches = makePatch <$> Map.difference changedPatches (b0 ^. Branch.edits)
-          makePatch Patch.PatchDiff {..} =
-            let p = Patch.Patch _addedTermEdits _addedTypeEdits
-             in (PatchHash (H.hashPatch p), pure p)
-      pure $
-        branch0
-          (Star2.difference (b0 ^. Branch.terms) removedTerms <> addedTerms)
-          (Star2.difference (b0 ^. Branch.types) removedTypes <> addedTypes)
-          (b0 ^. Branch.children)
-          (patches <> newPatches)
-    patchMerge mhp Patch.PatchDiff {..} = Just $ do
-      (_, mp) <- mhp
-      p <- mp
-      let np =
-            Patch.Patch
-              { _termEdits =
-                  R.difference (Patch._termEdits p) _removedTermEdits
-                    <> _addedTermEdits,
-                _typeEdits =
-                  R.difference (Patch._typeEdits p) _removedTypeEdits
-                    <> _addedTypeEdits
-              }
-      pure (PatchHash (H.hashPatch np), pure np)
+    apply :: Branch0 m -> BranchDiff -> Branch0 m
+    apply b0 (BranchDiff addedTerms removedTerms addedTypes removedTypes) = do
+      branch0
+        (Star2.difference (b0 ^. Branch.terms) removedTerms <> addedTerms)
+        (Star2.difference (b0 ^. Branch.types) removedTypes <> addedTypes)
+        (b0 ^. Branch.children)
+        Map.empty
 
 merge0 ::
   forall m.
@@ -120,18 +88,9 @@ merge0 ::
   m (Branch0 m)
 merge0 lca mode b1 b2 = do
   c3 <- unionWithM (merge'' lca mode) (b1 ^. Branch.children) (b2 ^. Branch.children)
-  e3 <- unionWithM g (b1 ^. Branch.edits) (b2 ^. Branch.edits)
   pure $
     branch0
       (b1 ^. Branch.terms <> b2 ^. Branch.terms)
       (b1 ^. Branch.types <> b2 ^. Branch.types)
       c3
-      e3
-  where
-    g :: (PatchHash, m Patch) -> (PatchHash, m Patch) -> m (PatchHash, m Patch)
-    g (h1, m1) (h2, _) | h1 == h2 = pure (h1, m1)
-    g (_, m1) (_, m2) = do
-      e1 <- m1
-      e2 <- m2
-      let e3 = e1 <> e2
-      pure (PatchHash (H.hashPatch e3), pure e3)
+      Map.empty

parser-typechecker/src/Unison/Codebase/Branch/Type.hs

@@ -21,7 +21,6 @@ module Unison.Codebase.Branch.Type
     deepTypes,
     deepDefns,
     deepPaths,
-    deepEdits,
     Star,
     UnwrappedBranch,
   )
@@ -102,8 +101,7 @@ data Branch0 m = Branch0
     -- names for this branch and its children
     _deepTerms :: Relation Referent Name,
     _deepTypes :: Relation Reference Name,
-    _deepPaths :: Set Path,
-    _deepEdits :: Map Name PatchHash
+    _deepPaths :: Set Path
   }
 
 instance Eq (Branch0 m) where
@@ -162,9 +160,6 @@ deepDefns branch =
 deepPaths :: Branch0 m -> Set Path
 deepPaths = _deepPaths
 
-deepEdits :: Branch0 m -> Map Name PatchHash
-deepEdits = _deepEdits
-
 children :: Lens' (Branch0 m) (Map NameSegment (Branch m))
 children = lens _children (\Branch0 {_terms, _types, _edits} x -> branch0 _terms _types x _edits)
 
@@ -192,13 +187,11 @@ branch0 terms types children edits =
       -- These are all overwritten immediately
       _deepTerms = R.empty,
       _deepTypes = R.empty,
-      _deepPaths = Set.empty,
-      _deepEdits = Map.empty
+      _deepPaths = Set.empty
     }
     & deriveDeepTerms
     & deriveDeepTypes
     & deriveDeepPaths
-    & deriveDeepEdits
     & deriveIsEmpty
 
 deriveIsEmpty :: Branch0 m -> Branch0 m
@@ -274,25 +267,6 @@ deriveDeepPaths branch =
           children <- deepChildrenHelper e
           go (work <> children) (paths <> acc)
 
--- | Derive the 'deepEdits' field of a branch.
-deriveDeepEdits :: forall m. Branch0 m -> Branch0 m
-deriveDeepEdits branch =
-  branch {_deepEdits = makeDeepEdits branch}
-  where
-    makeDeepEdits :: Branch0 m -> Map Name PatchHash
-    makeDeepEdits branch = State.evalState (go (Seq.singleton ([], 0, branch)) mempty) Set.empty
-      where
-        go :: (Seq (DeepChildAcc m)) -> Map Name PatchHash -> DeepState m (Map Name PatchHash)
-        go Seq.Empty acc = pure acc
-        go (e@(reversePrefix, _, b0) Seq.:<| work) acc = do
-          let edits :: Map Name PatchHash
-              edits =
-                Map.mapKeysMonotonic
-                  (Name.fromReverseSegments . (NonEmpty.:| reversePrefix))
-                  (fst <$> _edits b0)
-          children <- deepChildrenHelper e
-          go (work <> children) (edits <> acc)
-
 -- | State used by deepChildrenHelper to determine whether to descend into a child branch.
 -- Contains the set of visited namespace hashes.
 type DeepState m = State (Set (NamespaceHash m))