From 86a73fbe676e2378a3d4d119d86848719e9e385c Mon Sep 17 00:00:00 2001 From: voidlizard Date: Thu, 5 Dec 2024 10:23:12 +0300 Subject: [PATCH] wip19 --- hbs2-git3/app/Main.hs | 39 +++++++++++---------------------------- 1 file changed, 11 insertions(+), 28 deletions(-) diff --git a/hbs2-git3/app/Main.hs b/hbs2-git3/app/Main.hs index 7ffee071..4820d48e 100644 --- a/hbs2-git3/app/Main.hs +++ b/hbs2-git3/app/Main.hs @@ -389,13 +389,6 @@ gitObjectExists what = do data UState = UHead ByteString -unpackPEntry :: [ByteString] -> Maybe (GitObjectType, Word32, GitHash) -unpackPEntry = \case - ("C" : s : h : _) -> (Commit,,) <$> readMay (LBS8.unpack s) <*> fromStringMay (LBS8.unpack h) - ("B" : s : h : _) -> (Blob,,) <$> readMay (LBS8.unpack s) <*> fromStringMay (LBS8.unpack h) - ("T" : s : h : _) -> (Tree,,) <$> readMay (LBS8.unpack s) <*> fromStringMay (LBS8.unpack h) - _ -> Nothing - data ES = ES [BS.ByteString] Result @@ -453,16 +446,7 @@ data WState = WStart | WNextSBlock | WReadSBlock Int HashRef - | WCheckSBlock HashRef ByteString - | WWalkSBlock HashRef (MTree [HashRef]) - | WProcessCBlock HashRef - | WGetInput - | WEnd - -data WInput = - WInputSBlock - | WInputCBlock HashRef - + | WProcessCBlock Int HashRef data EOp = EGitObject GitObjectType GitHash (Maybe GitTreeEntry) ByteString @@ -1012,23 +996,26 @@ theDict = do CBlockParents p -> do debug $ "parents" <+> pretty p next =<< atomically do + d <- readTVar done for_ (zip [1..] p) $ \(i,x) -> do - isDone <- readTVar done <&> HS.member x - unless isDone do + unless (HS.member x d) do modifyTVar q (HPSQ.insert x (prio-i) ()) - isDone <- readTVar done <&> HS.member h - unless isDone do + let hDone = HS.member h d + + unless hDone do modifyTVar q (HPSQ.insert h prio ()) qq <- readTVar q - if not (any (`HPSQ.member` qq) p) && not isDone then do - pure $ WProcessCBlock h + if not (any (`HPSQ.member` qq) p) && not hDone then do + pure $ WProcessCBlock prio h else do pure WNextSBlock - WProcessCBlock h -> do + WProcessCBlock _ h -> do what <- cached cache h $ S.toList_ (readCBlock sto h S.yield) + atomically $ modifyTVar done ( HS.insert h ) + uncache cache h debug $ "process cblock" <+> pretty h @@ -1039,12 +1026,8 @@ theDict = do CBlockData{} -> do debug $ green "process cblock data" <+> pretty h - atomically $ modifyTVar done ( HS.insert h ) - uncache cache h next $ WNextSBlock - _ -> debug "WTF?" -- none - _ -> throwIO (BadFormException @C nil) entry $ bindMatch "test:git:tree:export" $ nil_ $ \syn -> lift do