diff --git a/fixme-new/lib/Fixme/Run.hs b/fixme-new/lib/Fixme/Run.hs index cb0ead0c..98adef2a 100644 --- a/fixme-new/lib/Fixme/Run.hs +++ b/fixme-new/lib/Fixme/Run.hs @@ -368,41 +368,7 @@ runTop forms = do cleanupDatabase entry $ bindMatch "fixme:scan:import" $ nil_ $ const $ lift do - fxs0 <- scanFiles - - fxs <- flip filterM fxs0 $ \fme -> do - let fn = fixmeGet "file" fme <&> Text.unpack . coerce - seen <- maybe1 fn (pure False) selectIsAlreadyScanned - pure (not seen) - - hashes <- catMaybes <$> flip runContT pure do - p <- ContT $ bracket startGitHash stopProcess - let files = mapMaybe (fixmeGet "file") fxs - & HS.fromList - & HS.toList - & fmap (Text.unpack . coerce) - for files $ \f -> do - mbHash <- lift $ gitHashPathStdin p f - case mbHash of - Just ha -> - pure $ Just (f, ha) - Nothing -> - pure Nothing - - let blobs = HM.fromList hashes - - 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 (fromMaybe mempty blob <> fmeRich <> fme) - -- TODO: remove-code-duplication - for_ fn insertScanned + import_ entry $ bindMatch "fixme:scan:list" $ nil_ $ const do fxs <- lift scanFiles diff --git a/fixme-new/lib/Fixme/Run/Internal.hs b/fixme-new/lib/Fixme/Run/Internal.hs index aa0214be..c88a4cf4 100644 --- a/fixme-new/lib/Fixme/Run/Internal.hs +++ b/fixme-new/lib/Fixme/Run/Internal.hs @@ -215,3 +215,60 @@ report t q = do liftIO $ hPutDoc stdout what + +import_ :: FixmePerks m => FixmeM m () +import_ = do + fxs0 <- scanFiles + + fxs <- flip filterM fxs0 $ \fme -> do + let fn = fixmeGet "file" fme <&> Text.unpack . coerce + seen <- maybe1 fn (pure False) selectIsAlreadyScanned + pure (not seen) + + hashes <- catMaybes <$> flip runContT pure do + p <- ContT $ bracket startGitHash stopProcess + let files = mapMaybe (fixmeGet "file") fxs + & HS.fromList + & HS.toList + & fmap (Text.unpack . coerce) + for files $ \f -> do + mbHash <- lift $ gitHashPathStdin p f + case mbHash of + Just ha -> + pure $ Just (f, ha) + Nothing -> + pure Nothing + + versioned <- listBlobs Nothing <&> HM.fromList + let commited = HM.elems versioned & HS.fromList + + let blobs = HM.fromList hashes + + 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 (fromMaybe mempty blob <> fmeRich <> fme) + + -- TODO: add-scanned-only-on-commited + -- поведение: если файл в гите И закоммичен -- то + -- добавляем в сканированные. + -- + -- если не в гите -- то добавляем в сканированные + -- + -- иначе не добавляем, wtf? + -- + -- проверяем + for_ fn $ \f -> do + let add = -- not (HM.member f versioned) + maybe False (`HS.member` commited) (HM.lookup f blobs) + + when add do + notice $ red "SCANNED" <+> pretty f + insertScanned f +