mirror of https://github.com/voidlizard/hbs2
wip
This commit is contained in:
parent
264b2f526e
commit
387b6bece7
|
@ -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
|
||||
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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|]
|
||||
|
|
Loading…
Reference in New Issue