mirror of
https://github.com/serokell/xrefcheck.git
synced 2024-10-26 15:35:29 +03:00
Allow to specify virtual files
For instance, reference to `issues` github page is a valid one despite there is no such file physically in the repository. Now user can specify list of "existing" virtual files in config.
This commit is contained in:
parent
3ecaf245f5
commit
90e160e7d2
@ -2,15 +2,28 @@
|
||||
traversal:
|
||||
# Full paths which should be excluded from consideration.
|
||||
excluded:
|
||||
# Stack files
|
||||
- .stack-work
|
||||
|
||||
# Github-specific files
|
||||
- .github/pull_request_template.md
|
||||
- docs/pull_request_template.md
|
||||
|
||||
# Parameters of verification.
|
||||
# Verification parameters.
|
||||
verification:
|
||||
# On 'anchor not found' error, how much similar anchors should be displayed as hint.
|
||||
# Number should be between 0 and 1, larger value means stricter filter.
|
||||
anchorSimilarityThreshold: 0.5
|
||||
|
||||
# When checking external references, how long to wait on request before
|
||||
# declaring "Response timeout".
|
||||
externalRefCheckTimeout: 10s
|
||||
|
||||
# Glob patterns describing the files which do not physically exist in the repository
|
||||
# but should be treated as existing nevertheless.
|
||||
virtualFiles:
|
||||
# Github pages
|
||||
- ../../issues
|
||||
- ../../issues/*
|
||||
- ../../pulls
|
||||
- ../../pulls/*
|
||||
|
@ -62,6 +62,7 @@ dependencies:
|
||||
- directory
|
||||
- filepath
|
||||
- fmt
|
||||
- Glob
|
||||
- http-client
|
||||
- http-types
|
||||
- lens
|
||||
|
@ -8,6 +8,8 @@ import Data.Aeson.TH (deriveFromJSON)
|
||||
import Data.Default (Default (..))
|
||||
import Time (KnownRatName, Second, Time, sec, unitsP)
|
||||
|
||||
import Crv.System (CanonicalizedGlobPattern)
|
||||
|
||||
-- | Overall config.
|
||||
data Config = Config
|
||||
{ cTraversal :: TraversalConfig
|
||||
@ -23,6 +25,7 @@ data TraversalConfig = TraversalConfig
|
||||
data VerifyConfig = VerifyConfig
|
||||
{ vcAnchorSimilarityThreshold :: Double
|
||||
, vcExternalRefCheckTimeout :: Time Second
|
||||
, vcVirtualFiles :: [CanonicalizedGlobPattern]
|
||||
}
|
||||
|
||||
-----------------------------------------------------------
|
||||
@ -44,6 +47,7 @@ instance Default VerifyConfig where
|
||||
VerifyConfig
|
||||
{ vcAnchorSimilarityThreshold = 0.5
|
||||
, vcExternalRefCheckTimeout = sec 3
|
||||
, vcVirtualFiles = []
|
||||
}
|
||||
|
||||
-----------------------------------------------------------
|
||||
|
@ -92,7 +92,7 @@ allowRewrite action =
|
||||
maxPrintedSize <- readIORef rMaxPrintedSize
|
||||
hPutStr stderr $ '\r' : replicate maxPrintedSize ' ' ++ "\r"
|
||||
-- prevent our output to interleave with further outputs
|
||||
threadDelay (ms 70)
|
||||
threadDelay (ms 100)
|
||||
|
||||
-- | Return caret and print the given text.
|
||||
putTextRewrite :: MonadIO m => Rewrite -> Text -> m ()
|
||||
|
24
src/Crv/System.hs
Normal file
24
src/Crv/System.hs
Normal file
@ -0,0 +1,24 @@
|
||||
module Crv.System
|
||||
( readingSystem
|
||||
, CanonicalizedGlobPattern (..)
|
||||
) where
|
||||
|
||||
import Data.Aeson (FromJSON (..), withText)
|
||||
import GHC.IO.Unsafe (unsafePerformIO)
|
||||
import System.Directory (canonicalizePath)
|
||||
import qualified System.FilePath.Glob as Glob
|
||||
|
||||
-- | We can quite safely treat surrounding filesystem as frozen,
|
||||
-- so IO reading operations can be turned into pure values.
|
||||
readingSystem :: IO a -> a
|
||||
readingSystem = unsafePerformIO
|
||||
|
||||
-- | Glob pattern with 'canonicalizePath' applied O_o.
|
||||
newtype CanonicalizedGlobPattern = CanonicalizedGlobPattern Glob.Pattern
|
||||
|
||||
instance FromJSON CanonicalizedGlobPattern where
|
||||
parseJSON = withText "Repo-rooted glob pattern" $ \path -> do
|
||||
let !cpath = readingSystem $ canonicalizePath (toString path)
|
||||
cpat <- Glob.tryCompileWith Glob.compDefault cpath
|
||||
& either fail pure
|
||||
return $ CanonicalizedGlobPattern cpat
|
@ -29,7 +29,8 @@ import Network.HTTP.Req (GET (..), HEAD (..), HttpException (..), NoReqBody (..)
|
||||
parseUrl, req, runReq)
|
||||
import Network.HTTP.Types.Status (Status, statusCode, statusMessage)
|
||||
import System.Console.Pretty (Style (..), style)
|
||||
import System.Directory (doesDirectoryExist, doesFileExist)
|
||||
import System.Directory (canonicalizePath, doesDirectoryExist, doesFileExist)
|
||||
import qualified System.FilePath.Glob as Glob
|
||||
import System.FilePath.Posix (takeDirectory)
|
||||
import System.FilePath.Posix ((</>))
|
||||
import Time (RatioNat, Second, Time (..), ms, threadDelay, timeout)
|
||||
@ -37,6 +38,7 @@ import Time (RatioNat, Second, Time (..), ms, threadDelay, timeout)
|
||||
import Crv.Config
|
||||
import Crv.Core
|
||||
import Crv.Progress
|
||||
import Crv.System
|
||||
|
||||
-----------------------------------------------------------
|
||||
-- General verification
|
||||
@ -148,10 +150,10 @@ verifyReference config@VerifyConfig{..} mode progressRef (RepoInfo repoInfo)
|
||||
if shouldCheckLocType mode locType
|
||||
then do
|
||||
res <- case locType of
|
||||
LocalLoc -> checkFileRef rAnchor containingFile
|
||||
RelativeLoc -> checkFileRef rAnchor
|
||||
LocalLoc -> checkRef rAnchor containingFile
|
||||
RelativeLoc -> checkRef rAnchor
|
||||
(takeDirectory containingFile </> toString rLink)
|
||||
AbsoluteLoc -> checkFileRef rAnchor (root <> toString rLink)
|
||||
AbsoluteLoc -> checkRef rAnchor (root <> toString rLink)
|
||||
ExternalLoc -> checkExternalResource config rLink
|
||||
OtherLoc -> verifying pass
|
||||
|
||||
@ -168,17 +170,25 @@ verifyReference config@VerifyConfig{..} mode progressRef (RepoInfo repoInfo)
|
||||
return $ fmap (WithReferenceLoc containingFile ref) res
|
||||
else return mempty
|
||||
where
|
||||
checkFileRef mAnchor file = verifying $ do
|
||||
fileExists <- liftIO $ doesFileExist file
|
||||
dirExists <- liftIO $ doesDirectoryExist file
|
||||
unless (fileExists || dirExists) $
|
||||
throwError (FileDoesNotExist file)
|
||||
|
||||
checkRef mAnchor file = verifying $ do
|
||||
checkReferredFileExists file
|
||||
case M.lookup file repoInfo of
|
||||
Nothing -> pass -- no support for such file, can do nothing
|
||||
Just referedFileInfo ->
|
||||
whenJust mAnchor $ checkAnchorExists (_fiAnchors referedFileInfo)
|
||||
|
||||
checkReferredFileExists file = do
|
||||
let fileExists = readingSystem $ doesFileExist file
|
||||
let dirExists = readingSystem $ doesDirectoryExist file
|
||||
|
||||
let cfile = readingSystem $ canonicalizePath file
|
||||
let isVirtual = or
|
||||
[ Glob.match pat cfile
|
||||
| CanonicalizedGlobPattern pat <- vcVirtualFiles ]
|
||||
|
||||
unless (fileExists || dirExists || isVirtual) $
|
||||
throwError (FileDoesNotExist file)
|
||||
|
||||
checkAnchorExists givenAnchors anchor =
|
||||
case find ((== anchor) . aName) givenAnchors of
|
||||
Just _ -> pass
|
||||
|
Loading…
Reference in New Issue
Block a user