diff --git a/src/Xrefcheck/Core.hs b/src/Xrefcheck/Core.hs index 265d04ef..b3c8cc8c 100644 --- a/src/Xrefcheck/Core.hs +++ b/src/Xrefcheck/Core.hs @@ -122,12 +122,26 @@ makeLenses ''FileInfo instance Default FileInfo where def = diffToFileInfo mempty +data FileStatus + = Scanned FileInfo + | NotScannable + -- ^ Files that are not supported by our scanners + | NotAddedToGit + -- ^ We are not scanning files that are not added to git, but we're + -- gathering information about them to improve reports. + deriving stock (Show) + +data DirectoryStatus + = TrackedDirectory + | UntrackedDirectory + deriving stock (Show) + -- | All tracked files and directories. data RepoInfo = RepoInfo - { riFiles :: Map FilePath (Maybe FileInfo) - -- ^ Files from the repo with `FileInfo` attached to files that we can scan. - , riDirectories :: Set FilePath - -- ^ Tracked directories. + { riFiles :: Map FilePath FileStatus + -- ^ Files from the repo with `FileInfo` attached to files that we've scanned. + , riDirectories :: Map FilePath DirectoryStatus + -- ^ Directories containing those files. } deriving stock (Show) ----------------------------------------------------------- @@ -180,8 +194,9 @@ instance Given ColorMode => Buildable FileInfo where |] instance Given ColorMode => Buildable RepoInfo where - build (RepoInfo (nonEmpty . mapMaybe sequence . toPairs -> Just m) _) = - interpolateBlockListF' "⮚" buildFileReport m + build (RepoInfo m _) + | Just scanned <- nonEmpty [(name, info) | (name, Scanned info) <- toPairs m] + = interpolateBlockListF' "⮚" buildFileReport scanned where buildFileReport (name, info) = [int|| diff --git a/src/Xrefcheck/Scan.hs b/src/Xrefcheck/Scan.hs index a6afa75c..fca1e616 100644 --- a/src/Xrefcheck/Scan.hs +++ b/src/Xrefcheck/Scan.hs @@ -34,7 +34,7 @@ import Data.Aeson (FromJSON (..), genericParseJSON, withText) import Data.List qualified as L import Data.Map qualified as M import Data.Reflection (Given) -import Fmt (Buildable (..)) +import Fmt (Buildable (..), blockListF) import System.Directory (doesDirectoryExist) import System.FilePath (dropTrailingPathSeparator, equalFilePath, splitDirectories, takeDirectory, takeExtension, ()) @@ -153,6 +153,25 @@ readDirectoryWith config scanner root = then "" else dropTrailingPathSeparator root +-- | Get files that are not ignored by Git or config, but weren't added to Git yet. +getUntrackedFiles :: ExclusionConfig -> FilePath -> IO [FilePath] +getUntrackedFiles config root = + filter (not . isIgnored) + . map (location ) + . L.lines + <$> readCreateProcess + (shell "git ls-files --others --exclude-standard"){cwd = Just root} "" + where + isIgnored :: FilePath -> Bool + isIgnored = matchesGlobPatterns root $ ecIgnore config + + -- Strip leading "." and trailing "/" + location :: FilePath + location = + if root `equalFilePath` "." + then "" + else dropTrailingPathSeparator root + scanRepo :: MonadIO m => Rewrite -> FormatsSupport -> ExclusionConfig -> FilePath -> m ScanResult @@ -162,14 +181,35 @@ scanRepo rw formatsSupport config root = do when (not $ isDirectory root) $ die $ "Repository's root does not seem to be a directory: " <> root - (errs, fileInfos) <- liftIO - $ (gatherScanErrs &&& gatherFileInfos) + (errs, trackedFilesWithInfos) <- liftIO + $ (gatherScanErrs &&& gatherFileStatuses) <$> readDirectoryWith config processFile root - let dirs = fromList $ foldMap (getDirs . fst) fileInfos + untrackedFiles <- liftIO $ getUntrackedFiles config root + + let scannableUntrackedFiles = filter (isJust . mscanner) untrackedFiles + + unless (null scannableUntrackedFiles) $ hPutStrLn @Text stderr + [int|A| + Those files are not added by Git, so we're not scanning them: + #{blockListF scannableUntrackedFiles}\ + Please run "git add" before running xrefcheck. + |] - return . ScanResult errs $ RepoInfo (M.fromList fileInfos) dirs + let trackedDirs = foldMap (getDirs . fst) trackedFilesWithInfos + untrackedDirs = foldMap getDirs untrackedFiles + return . ScanResult errs $ RepoInfo + { riFiles = M.fromList + $ trackedFilesWithInfos + <> map (,NotAddedToGit) untrackedFiles + , riDirectories = M.fromList + $ map (,TrackedDirectory) trackedDirs + <> map (,UntrackedDirectory) untrackedDirs + } where + mscanner :: FilePath -> Maybe ScanAction + mscanner = formatsSupport . takeExtension + isDirectory :: FilePath -> Bool isDirectory = readingSystem . doesDirectoryExist @@ -178,20 +218,19 @@ scanRepo rw formatsSupport config root = do getDirs = scanl () "" . splitDirectories . takeDirectory gatherScanErrs - :: [(FilePath, Maybe (FileInfo, [ScanError]))] + :: [(FilePath, (FileStatus, [ScanError]))] -> [ScanError] - gatherScanErrs = fold . mapMaybe (fmap snd . snd) - - gatherFileInfos - :: [(FilePath, Maybe (FileInfo, [ScanError]))] - -> [(FilePath, Maybe FileInfo)] - gatherFileInfos = map (second (fmap fst)) - - processFile :: FilePath -> IO $ Maybe (FileInfo, [ScanError]) - processFile file = do - let ext = takeExtension file - let mscanner = formatsSupport ext - forM mscanner ($ file) + gatherScanErrs = foldMap (snd . snd) + + gatherFileStatuses + :: [(FilePath, (FileStatus, [ScanError]))] + -> [(FilePath, FileStatus)] + gatherFileStatuses = map (second fst) + + processFile :: FilePath -> IO (FileStatus, [ScanError]) + processFile file = case mscanner file of + Nothing -> pure (NotScannable, []) + Just scanner -> scanner file <&> _1 %~ Scanned ----------------------------------------------------------- -- Yaml instances diff --git a/src/Xrefcheck/Verify.hs b/src/Xrefcheck/Verify.hs index e7ebacd8..d61e46a2 100644 --- a/src/Xrefcheck/Verify.hs +++ b/src/Xrefcheck/Verify.hs @@ -120,6 +120,7 @@ instance (Given ColorMode, Buildable a) => Buildable (WithReferenceLoc a) where data VerifyError = LocalFileDoesNotExist FilePath | LocalFileOutsideRepo FilePath + | LinkTargetNotAddedToGit FilePath | AnchorDoesNotExist Text [Anchor] | AmbiguousAnchorRef FilePath Text (NonEmpty Anchor) | ExternalResourceInvalidUri URIBS.URIParseError @@ -148,6 +149,14 @@ instance Given ColorMode => Buildable VerifyError where #{file} |] + + LinkTargetNotAddedToGit file -> + [int|| + ⛀ Link target is not tracked by Git: + #{file} + Please run "git add" before running xrefcheck. + |] + AnchorDoesNotExist anchor similar -> case nonEmpty similar of Nothing -> [int|| @@ -296,10 +305,13 @@ verifyRepo (file, fileInfo) <- M.toList files guard . not $ matchesGlobPatterns root (ecIgnoreRefsFrom cExclusions) file case fileInfo of - Just fi -> do + Scanned fi -> do ref <- _fiReferences fi return (file, ref) - Nothing -> empty -- no support for such file, can do nothing + NotScannable -> empty -- No support for such file, can do nothing. + NotAddedToGit -> empty -- If this file is scannable, we've notified + -- user that we are scanning only files + -- added to Git while gathering RepoInfo. progressRef <- newIORef $ initVerifyProgress (map snd toScan) @@ -449,14 +461,15 @@ verifyReference checkRef mAnchor referredFile = verifying $ unless (isVirtual referredFile) do checkReferredFileIsInsideRepo referredFile - checkReferredFileExists referredFile - case lookupFilePath referredFile $ M.toList files of - Nothing -> pass -- no support for such file, can do nothing - Just referredFileInfo -> whenJust mAnchor $ + mFileStatus <- tryGetFileStatus referredFile + case mFileStatus of + Right (Scanned referredFileInfo) -> whenJust mAnchor $ checkAnchor referredFile (_fiAnchors referredFileInfo) - - lookupFilePath :: FilePath -> [(FilePath, Maybe FileInfo)] -> Maybe FileInfo - lookupFilePath fp = snd <=< find (equalFilePath (expandIndirections fp) . fst) + Right NotScannable -> pass -- no support for such file, can do nothing + Right NotAddedToGit -> throwError (LinkTargetNotAddedToGit referredFile) + Left UntrackedDirectory -> throwError (LinkTargetNotAddedToGit referredFile) + Left TrackedDirectory -> pass -- path leads to directory, currently + -- if such link contain anchor, we ignore it -- expands ".." and "." -- expandIndirections "a/b/../c" = "a/c" @@ -490,18 +503,21 @@ verifyReference nestingChange "." = 0 nestingChange _ = 1 - checkReferredFileExists file = do - unless (fileExists || dirExists) $ - throwError (LocalFileDoesNotExist file) + -- Returns `Nothing` when path corresponds to an existing (and tracked) directory + tryGetFileStatus :: FilePath -> ExceptT VerifyError IO (Either DirectoryStatus FileStatus) + tryGetFileStatus file + | Just f <- mFile = return $ Right f + | Just d <- mDir = return $ Left d + | otherwise = throwError (LocalFileDoesNotExist file) where matchesFilePath :: FilePath -> Bool matchesFilePath = equalFilePath $ expandIndirections file - fileExists :: Bool - fileExists = any matchesFilePath $ M.keys files + mFile :: Maybe FileStatus + mFile = (files M.!) <$> find matchesFilePath (M.keys files) - dirExists :: Bool - dirExists = any matchesFilePath dirs + mDir :: Maybe DirectoryStatus + mDir = (dirs M.!) <$> find matchesFilePath (M.keys dirs) checkAnchor file fileAnchors anchor = do checkAnchorReferenceAmbiguity file fileAnchors anchor diff --git a/tests/golden/check-git/check-git.bats b/tests/golden/check-git/check-git.bats index f1092be4..97a71de5 100644 --- a/tests/golden/check-git/check-git.bats +++ b/tests/golden/check-git/check-git.bats @@ -26,7 +26,16 @@ load '../helpers' run xrefcheck + assert_success + assert_output --partial "All repository links are valid." + + # this is printed to stderr + assert_output --partial - <> "git.md" + + touch ./a.md + + git add git.md + + to_temp xrefcheck + + assert_diff - <