fixed refs deleting

hbs2-git/git-hbs2/Main.hs

@@ -171,7 +171,7 @@ pShowRef = do
 
       (_,rh) <- TX.readRepoHeadFromTx sto tx >>= toMPlus
 
-      liftIO $ print $ vcat (fmap formatRef (_repoHeadRefs rh))
+      liftIO $ print $ vcat (fmap formatRef (view repoHeadRefs rh))
 
 
 pManifest :: GitPerks m => Parser (GitCLI m ())

hbs2-git/git-remote-hbs2/Main.hs

@@ -9,6 +9,7 @@ import HBS2.Git.Client.Export
 import HBS2.Git.Client.State
 import HBS2.Git.Client.Progress
 import HBS2.Git.Client.Config
+import HBS2.Git.Data.RepoHead
 import HBS2.Git.Data.RefLog
 import HBS2.Git.Data.Tx.Git qualified as TX
 import HBS2.Git.Data.Tx.Git (RepoHead(..))
@@ -178,7 +179,7 @@ main = do
                             tx <- selectMaxAppliedTx >>= lift  . toMPlus <&> fst
 
                             (_,rh) <- TX.readRepoHeadFromTx sto tx >>= lift . toMPlus
-                            pure (_repoHeadRefs rh)
+                            pure (view repoHeadRefs rh)
 
                     let r = fromMaybe mempty r'
 

hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/Export.hs

@@ -110,7 +110,7 @@ refsForExport forPushL = do
          [val,name] -> (GitRef (LBS8.toStrict name),) <$> fromStringMay @GitHash (LBS8.unpack val)
          _          -> Nothing
     <&> HashMap.fromList
-    <&> HashMap.filterWithKey (\k _ -> not (HashSet.member k deleted))
+    <&> HashMap.mapWithKey (\k v -> if k `HashSet.member` deleted then gitHashTomb else v)
     <&> mappend forPush
     <&> mappend (HashMap.singleton currentBranch currentVal)
     <&> HashMap.toList
@@ -217,7 +217,7 @@ export key refs  = do
 
       repohead <- makeRepoHeadSimple name brief mf gk0 myrefs
 
-      let oldRefs = maybe mempty _repoHeadRefs rh0
+      let oldRefs = maybe mempty repoHeadRefs' rh0
 
       trace $ "TX0" <+> pretty  tx0
 

hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/Import.hs

@@ -9,6 +9,7 @@ import HBS2.Git.Client.Progress
 import HBS2.Git.Data.RefLog
 import HBS2.Git.Data.Tx.Git
 import HBS2.Git.Data.LWWBlock
+import HBS2.Git.Data.RepoHead
 
 import Data.ByteString.Lazy qualified as LBS
 
@@ -291,7 +292,7 @@ applyTx h = do
 
     applyHeads rh = do
 
-      let refs = _repoHeadRefs rh
+      let refs = view repoHeadRefs rh
 
       withGitFastImport $ \ps -> do
         let psin = getStdin ps

hbs2-git/hbs2-git-client-lib/HBS2/Git/Data/RepoHead.hs

@@ -30,7 +30,7 @@ data RepoHead =
   , _repoHeadName   :: Text
   , _repoHeadBrief  :: Text
   , _repoManifest   :: Maybe Text
-  , _repoHeadRefs   :: [(GitRef, GitHash)]
+  ,  repoHeadRefs'  :: [(GitRef, GitHash)]
   , _repoHeadExt    :: [RepoHeadExt]
   }
   deriving stock (Generic)
@@ -39,19 +39,30 @@ makeLenses ''RepoHead
 
 repoHeadTags :: SimpleGetter RepoHead [Text]
 repoHeadTags =
-  to \RepoHeadSimple{..} -> do
+  to \h@RepoHeadSimple{} -> do
     catMaybes [ lastMay (B8.split '/' s) <&> (Text.pack . B8.unpack)
-                      | (GitRef s, _)  <- _repoHeadRefs, B8.isPrefixOf "refs/tags" s
+                      | (GitRef s, _)  <- view repoHeadRefs h, B8.isPrefixOf "refs/tags" s
                       ] & Set.fromList & Set.toList
 
 
 repoHeadHeads :: SimpleGetter RepoHead [Text]
 repoHeadHeads =
-  to \RepoHeadSimple{..} -> do
+  to \h@RepoHeadSimple{} -> do
     catMaybes [ lastMay (B8.split '/' s) <&> (Text.pack . B8.unpack)
-                      | (GitRef s, _)  <- _repoHeadRefs, B8.isPrefixOf "refs/heads" s
+              | (GitRef s, v)  <- view repoHeadRefs h, B8.isPrefixOf "refs/heads" s
               ] & Set.fromList & Set.toList
 
+
+repoHeadRefs :: Lens RepoHead
+                     RepoHead
+                     [(GitRef, GitHash)]
+                     [(GitRef, GitHash)]
+
+repoHeadRefs = lens g s
+  where
+   s rh r = rh { repoHeadRefs' = r }
+   g rh = [ (r,v) | (r,v) <- repoHeadRefs' rh, v /= gitHashTomb ]
+
 instance Serialise RepoHeadType
 instance Serialise RepoHeadExt
 instance Serialise RepoHead

hbs2-git/hbs2-git-client-lib/HBS2/Git/Local.hs

@@ -16,6 +16,9 @@ newtype GitHash = GitHash ByteString
                   deriving stock (Eq,Ord,Data,Generic,Show)
                   deriving newtype Hashable
 
+gitHashTomb :: GitHash
+gitHashTomb = fromString "0000000000000000000000000000000000"
+
 instance Serialise GitHash
 
 instance IsString GitHash where