This commit is contained in:
Dmitry Zuikov 2024-05-14 05:08:32 +03:00
parent 264b2f526e
commit 387b6bece7
3 changed files with 30 additions and 20 deletions

View File

@ -9,7 +9,7 @@ fixme-prefix TODO:
fixme-prefix PR: fixme-prefix PR:
fixme-prefix REVIEW: fixme-prefix REVIEW:
fixme-git-scan-filter-days 30 fixme-git-scan-filter-days 600
fixme-attribs assigned workflow fixme-attribs assigned workflow
@ -55,12 +55,12 @@ fixme-comments ";" "--"
(align 8 ("[" $workflow "]")) " " (align 8 ("[" $workflow "]")) " "
(align 12 $assigned) " " (align 12 $assigned) " "
(trim 50 ($fixme-title)) (align 20 (trim 20 $committer-name)) " "
(trim 50 ($fixme-title)) " "
(nl) (nl)
) )
) )
; update
update

View File

@ -259,8 +259,6 @@ scanGitLocal args p = do
env <- ask env <- ask
dbpath <- localDBPath
flip runContT pure do flip runContT pure do
(dbFn, _) <- ContT $ withSystemTempFile "fixme-db" . curry (dbFn, _) <- ContT $ withSystemTempFile "fixme-db" . curry
@ -343,7 +341,14 @@ scanGitLocal args p = do
liftIO $ IO.hSetBuffering ssin LineBuffering liftIO $ IO.hSetBuffering ssin LineBuffering
for_ blobs $ \(h,fp) -> do for_ blobs $ \(h,fp) -> callCC \next -> do
seen <- lift (withState $ selectObjectHash h) <&> isJust
when seen do
trace $ red "ALREADY SEEN BLOB" <+> pretty h
next ()
liftIO $ IO.hPrint ssin (pretty h) >> IO.hFlush ssin liftIO $ IO.hPrint ssin (pretty h) >> IO.hFlush ssin
prefix <- liftIO (BS.hGetLine ssout) <&> BS.words prefix <- liftIO (BS.hGetLine ssout) <&> BS.words
@ -384,7 +389,6 @@ scanGitLocal args p = do
WHERE RelevantCommits.hash = ? WHERE RelevantCommits.hash = ?
|] |]
what <- select @(FixmeAttrName,FixmeAttrVal) q (Only h) what <- select @(FixmeAttrName,FixmeAttrVal) q (Only h)
<&> HM.fromList <&> HM.fromList
<&> (<> HM.fromList [ ("blob",fromString $ show (pretty h)) <&> (<> HM.fromList [ ("blob",fromString $ show (pretty h))
@ -424,9 +428,6 @@ scanGitLocal args p = do
] & mconcat ] & mconcat
& Map.fromList & Map.fromList
debug $ red "fxpos1" <+> pretty h <> line <> pretty (Map.toList fxpos1)
debug $ red "fxpos2" <+> pretty h <> line <> pretty (Map.toList fxpos2)
fixmies <- for (zip [0..] rich) $ \(i,fx) -> do fixmies <- for (zip [0..] rich) $ \(i,fx) -> do
let title = fixmeTitle fx let title = fixmeTitle fx
let kb = Map.lookup (title,i) fxpos2 let kb = Map.lookup (title,i) fxpos2
@ -451,9 +452,9 @@ scanGitLocal args p = do
debug $ "actually-import-fixmies" <+> pretty h debug $ "actually-import-fixmies" <+> pretty h
liftIO $ withFixmeEnv env $ withState $ transactional do liftIO $ withFixmeEnv env $ withState $ transactional do
insertBlob h
for_ fixmies insertFixme for_ fixmies insertFixme
_ -> fucked () _ -> fucked ()
unless ( ScanRunDry `elem` args ) do unless ( ScanRunDry `elem` args ) do

View File

@ -9,7 +9,8 @@ module Fixme.State
, selectFixme , selectFixme
, deleteFixme , deleteFixme
, insertCommit , insertCommit
, selectCommit , insertBlob
, selectObjectHash
, newCommit , newCommit
, cleanupDatabase , cleanupDatabase
, updateIndexes , updateIndexes
@ -94,8 +95,9 @@ createTables = do
-- в другую бд, если вдруг понадобится -- в другую бд, если вдруг понадобится
ddl [qc| ddl [qc|
create table if not exists fixmecommit create table if not exists fixmegitobject
( hash text not null ( hash text not null
, type text null
, primary key (hash) , primary key (hash)
) )
|] |]
@ -203,17 +205,24 @@ createTables = do
insertCommit :: FixmePerks m => GitHash -> DBPipeM m () insertCommit :: FixmePerks m => GitHash -> DBPipeM m ()
insertCommit gh = do insertCommit gh = do
insert [qc| insert [qc|
insert into fixmecommit (hash) values(?) insert into fixmegitobject (hash,type) values(?,'commit')
on conflict (hash) do nothing on conflict (hash) do nothing
|] (Only gh) |] (Only gh)
selectCommit :: FixmePerks m => GitHash -> DBPipeM m (Maybe GitHash) insertBlob :: FixmePerks m => GitHash -> DBPipeM m ()
selectCommit gh = do insertBlob gh = do
select [qc|select hash from fixmecommit where hash = ?|] (Only gh) insert [qc|
insert into fixmegitobject (hash,type) values(?,'blob')
on conflict (hash) do nothing
|] (Only gh)
selectObjectHash :: FixmePerks m => GitHash -> DBPipeM m (Maybe GitHash)
selectObjectHash gh = do
select [qc|select hash from fixmegitobject where hash = ?|] (Only gh)
<&> fmap fromOnly . listToMaybe <&> fmap fromOnly . listToMaybe
newCommit :: (FixmePerks m, MonadReader FixmeEnv m) => GitHash -> m Bool newCommit :: (FixmePerks m, MonadReader FixmeEnv m) => GitHash -> m Bool
newCommit gh = isNothing <$> withState (selectCommit gh) newCommit gh = isNothing <$> withState (selectObjectHash gh)
insertFixme :: FixmePerks m => Fixme -> DBPipeM m () insertFixme :: FixmePerks m => Fixme -> DBPipeM m ()
insertFixme fx@Fixme{..} = do insertFixme fx@Fixme{..} = do
@ -418,7 +427,7 @@ cleanupDatabase = do
withState $ transactional do withState $ transactional do
update_ [qc|delete from fixme|] update_ [qc|delete from fixme|]
update_ [qc|delete from fixmeattr|] update_ [qc|delete from fixmeattr|]
update_ [qc|delete from fixmecommit|] update_ [qc|delete from fixmegitobject|]
update_ [qc|delete from fixmedeleted|] update_ [qc|delete from fixmedeleted|]
update_ [qc|delete from fixmerel|] update_ [qc|delete from fixmerel|]
update_ [qc|delete from fixmeactual|] update_ [qc|delete from fixmeactual|]