wip, extracting blob hash

This commit is contained in:
Dmitry Zuikov 2024-09-10 07:16:29 +03:00
parent 9bed650a0f
commit a26d6a6780
2 changed files with 23 additions and 7 deletions

View File

@ -375,12 +375,23 @@ runTop forms = do
seen <- maybe1 fn (pure False) selectIsAlreadyScanned
pure (not seen)
let files = mapMaybe (fixmeGet "file") fxs
& HS.fromList
& HS.toList
& fmap (Text.unpack . coerce)
blobs <- listBlobs mzero <&> HM.fromList
withState $ transactional do
for_ fxs $ \fme -> do
let fn = fixmeGet "file" fme <&> Text.unpack . coerce
fmeRich <- lift $ maybe1 fn (pure mempty) (`getMetaDataFromGitBlame` fme)
let blob = fn >>= flip HM.lookup blobs
>>= \b -> pure (fixmeSet "blob" (fromString (show $ pretty $ b)) mempty)
notice $ "fixme" <+> pretty (fixmeKey fme)
insertFixme (fmeRich <> fme)
insertFixme (fromMaybe mempty blob <> fmeRich <> fme)
-- TODO: remove-code-duplication
for_ fn insertScanned
@ -389,6 +400,8 @@ runTop forms = do
for_ fxs $ \fme -> do
liftIO $ print $ pretty fme
-- TODO: some-uncommited-shit
-- TODO: some-shit
-- one

View File

@ -115,10 +115,13 @@ listCommits = do
spec = sq <> delims " \t"
listBlobs :: (FixmePerks m, MonadReader FixmeEnv m) => GitHash -> m [(FilePath,GitHash)]
listBlobs co = do
listBlobs :: (FixmePerks m, MonadReader FixmeEnv m) => Maybe GitHash -> m [(FilePath,GitHash)]
listBlobs mco = do
gd <- fixmeGetGitDirCLIOpt
gitRunCommand [qc|git {gd} ls-tree -r -l -t {pretty co}|]
let what = maybe "HEAD" (show . pretty) mco
gitRunCommand [qc|git {gd} ls-tree -r -l -t {what}|]
<&> fromRight mempty
<&> fmap LBS8.words . LBS8.lines
<&> mapMaybe
@ -151,7 +154,7 @@ listRelevantBlobs = do
commits <- listCommits
S.toList_ $ do
for_ commits $ \(co, _) -> do
found <- lift $ listBlobs co >>= filterBlobs
found <- lift $ listBlobs (Just co) >>= filterBlobs
S.each found
listFixmies :: FixmePerks m
@ -296,7 +299,7 @@ gitExtractFileMetaData fns = do
rich0 <- S.toList_ $ do
for_ co $ \(c, (t,n,m)) -> do
let pat = [ (True, f) | f <- fns ]
blobz <- lift $ listBlobs c >>= filterBlobs0 pat
blobz <- lift $ listBlobs (Just c) >>= filterBlobs0 pat
for_ blobz $ \(f,h) -> do
let attr = HM.fromList [ ("commit", FixmeAttrVal (fromString $ show $ pretty c))
@ -344,7 +347,7 @@ listCommitForIndex fn = do
)
for_ s0 $ \(h, GitCommit w _) -> do
blobz <- listBlobs h <&> HS.fromList . fmap ( uncurry GitBlobInfo )
blobz <- listBlobs (Just h) <&> HS.fromList . fmap ( uncurry GitBlobInfo )
fn (h, GitCommit w blobz)
where