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 REVIEW:
fixme-git-scan-filter-days 30
fixme-git-scan-filter-days 600
fixme-attribs assigned workflow
@ -55,12 +55,12 @@ fixme-comments ";" "--"
(align 8 ("[" $workflow "]")) " "
(align 12 $assigned) " "
(trim 50 ($fixme-title))
(align 20 (trim 20 $committer-name)) " "
(trim 50 ($fixme-title)) " "
(nl)
)
)
update
; update

View File

@ -259,8 +259,6 @@ scanGitLocal args p = do
env <- ask
dbpath <- localDBPath
flip runContT pure do
(dbFn, _) <- ContT $ withSystemTempFile "fixme-db" . curry
@ -343,7 +341,14 @@ scanGitLocal args p = do
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
prefix <- liftIO (BS.hGetLine ssout) <&> BS.words
@ -384,7 +389,6 @@ scanGitLocal args p = do
WHERE RelevantCommits.hash = ?
|]
what <- select @(FixmeAttrName,FixmeAttrVal) q (Only h)
<&> HM.fromList
<&> (<> HM.fromList [ ("blob",fromString $ show (pretty h))
@ -424,9 +428,6 @@ scanGitLocal args p = do
] & mconcat
& 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
let title = fixmeTitle fx
let kb = Map.lookup (title,i) fxpos2
@ -451,9 +452,9 @@ scanGitLocal args p = do
debug $ "actually-import-fixmies" <+> pretty h
liftIO $ withFixmeEnv env $ withState $ transactional do
insertBlob h
for_ fixmies insertFixme
_ -> fucked ()
unless ( ScanRunDry `elem` args ) do

View File

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