diff --git a/hbs2-git/git-hbs2/Main.hs b/hbs2-git/git-hbs2/Main.hs index ed325275..8040cc0f 100644 --- a/hbs2-git/git-hbs2/Main.hs +++ b/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 ()) diff --git a/hbs2-git/git-remote-hbs2/Main.hs b/hbs2-git/git-remote-hbs2/Main.hs index d809c760..d600be82 100644 --- a/hbs2-git/git-remote-hbs2/Main.hs +++ b/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' diff --git a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/Export.hs b/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/Export.hs index edb94904..8bea1a4d 100644 --- a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/Export.hs +++ b/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 diff --git a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/Import.hs b/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/Import.hs index 00cd7657..3d61e28e 100644 --- a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/Import.hs +++ b/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 diff --git a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Data/RepoHead.hs b/hbs2-git/hbs2-git-client-lib/HBS2/Git/Data/RepoHead.hs index ee9c1bc6..6476aa9f 100644 --- a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Data/RepoHead.hs +++ b/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,18 +39,29 @@ 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 - ] & Set.fromList & Set.toList + | (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 diff --git a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Local.hs b/hbs2-git/hbs2-git-client-lib/HBS2/Git/Local.hs index f1641cb3..b2658571 100644 --- a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Local.hs +++ b/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