mirror of
https://github.com/serokell/xrefcheck.git
synced 2024-09-11 13:37:36 +03:00
Merge pull request #263 from serokell/aeqz/#239-#249-further-filepath-refactor
[#239][#249] Further filepath refactor
This commit is contained in:
commit
25ec1a21d5
@ -39,7 +39,7 @@ import Paths_xrefcheck (version)
|
||||
import Xrefcheck.Config (NetworkingConfig, NetworkingConfig' (..))
|
||||
import Xrefcheck.Core
|
||||
import Xrefcheck.Scan
|
||||
import Xrefcheck.System (RelGlobPattern, mkGlobPattern)
|
||||
import Xrefcheck.System (CanonicalRelGlobPattern, mkCanonicalRelGlobPattern)
|
||||
import Xrefcheck.Util (ColorMode (WithColors, WithoutColors))
|
||||
|
||||
modeReadM :: ReadM VerifyMode
|
||||
@ -90,7 +90,7 @@ data Options = Options
|
||||
}
|
||||
|
||||
data ExclusionOptions = ExclusionOptions
|
||||
{ eoIgnore :: [RelGlobPattern]
|
||||
{ eoIgnore :: [CanonicalRelGlobPattern]
|
||||
}
|
||||
|
||||
addExclusionOptions :: ExclusionConfig -> ExclusionOptions -> ExclusionConfig
|
||||
@ -125,8 +125,8 @@ type RepoType = Flavor
|
||||
filepathOption :: Mod OptionFields FilePath -> Parser FilePath
|
||||
filepathOption = strOption
|
||||
|
||||
globOption :: Mod OptionFields RelGlobPattern -> Parser RelGlobPattern
|
||||
globOption = option $ eitherReader mkGlobPattern
|
||||
globOption :: Mod OptionFields CanonicalRelGlobPattern -> Parser CanonicalRelGlobPattern
|
||||
globOption = option $ eitherReader mkCanonicalRelGlobPattern
|
||||
|
||||
repoTypeReadM :: ReadM RepoType
|
||||
repoTypeReadM = eitherReader $ \name ->
|
||||
|
@ -11,13 +11,12 @@ module Xrefcheck.Core where
|
||||
|
||||
import Universum
|
||||
|
||||
import Control.Lens (makeLenses)
|
||||
import Control.Lens (folded, makeLenses, makePrisms, to, united)
|
||||
import Data.Aeson (FromJSON (..), withText)
|
||||
import Data.Char (isAlphaNum)
|
||||
import Data.Char qualified as C
|
||||
import Data.DList (DList)
|
||||
import Data.DList qualified as DList
|
||||
import Data.List qualified as L
|
||||
import Data.Map qualified as M
|
||||
import Data.Reflection (Given)
|
||||
import Data.Text qualified as T
|
||||
@ -71,66 +70,67 @@ instance Given ColorMode => Buildable Position where
|
||||
|
||||
-- | Full info about a reference.
|
||||
data Reference = Reference
|
||||
{ rName :: Text
|
||||
{ rName :: Text
|
||||
-- ^ Text displayed as reference.
|
||||
, rLink :: Text
|
||||
-- ^ File or site reference points to.
|
||||
, rAnchor :: Maybe Text
|
||||
-- ^ Section or custom anchor tag.
|
||||
, rPos :: Position
|
||||
, rPos :: Position
|
||||
-- ^ Position in source file.
|
||||
, rInfo :: ReferenceInfo
|
||||
-- ^ More info about the link.
|
||||
, rInfo :: ReferenceInfo
|
||||
-- ^ More info about the reference.
|
||||
} deriving stock (Show, Generic)
|
||||
|
||||
-- | Info about the reference.
|
||||
data ReferenceInfo
|
||||
= RIExternal
|
||||
-- ^ Reference to a file at outer site, e.g @[d](http://www.google.com/doodles)@
|
||||
| RIOtherProtocol
|
||||
-- ^ Entry not to be processed, e.g. @mailto:e-mail@
|
||||
| RIFileLocal
|
||||
-- ^ Reference to this file, e.g. @[a](#header)@
|
||||
| RIFileAbsolute
|
||||
-- ^ Reference to a file absolute to the root, e.g. @[c](/folder/file#header)@
|
||||
| RIFileRelative
|
||||
-- ^ Reference to a file relative to given one, e.g. @[b](folder/file#header)@
|
||||
= RIExternal ExternalLink
|
||||
| RIFile ReferenceInfoFile
|
||||
deriving stock (Show, Generic)
|
||||
|
||||
data ReferenceInfoFile = ReferenceInfoFile
|
||||
{ rifAnchor :: Maybe Text
|
||||
-- ^ Section or custom anchor tag.
|
||||
, rifLink :: FileLink
|
||||
-- ^ More info about the link.
|
||||
} deriving stock (Show, Generic)
|
||||
|
||||
data ExternalLink
|
||||
= ELUrl Text
|
||||
-- ^ Reference to a file at outer site, e.g @[d](http://www.google.com/doodles)@.
|
||||
| ELOther Text
|
||||
-- ^ Entry not to be processed, e.g. @mailto:e-mail@.
|
||||
deriving stock (Show, Generic)
|
||||
|
||||
data FileLink
|
||||
= FLAbsolute RelPosixLink
|
||||
-- ^ Reference to a file or directory relative to the repository root.
|
||||
| FLRelative RelPosixLink
|
||||
-- ^ Reference to a file or directory relative to the given one.
|
||||
| FLLocal
|
||||
-- ^ Reference to this file.
|
||||
deriving stock (Show, Generic)
|
||||
|
||||
makePrisms ''ReferenceInfo
|
||||
makePrisms ''ExternalLink
|
||||
|
||||
pattern PathSep :: Char
|
||||
pattern PathSep <- (isPathSeparator -> True)
|
||||
|
||||
-- | Compute the 'ReferenceInfo' corresponding to a given link.
|
||||
referenceInfo :: Text -> ReferenceInfo
|
||||
referenceInfo link = case toString link of
|
||||
[] -> RIFileLocal
|
||||
PathSep : _ -> RIFileAbsolute
|
||||
'.' : PathSep : _ -> RIFileRelative
|
||||
'.' : '.' : PathSep : _ -> RIFileRelative
|
||||
_ | hasUrlProtocol -> RIExternal
|
||||
| hasProtocol -> RIOtherProtocol
|
||||
| otherwise -> RIFileRelative
|
||||
referenceInfo url
|
||||
| hasUrlProtocol = RIExternal $ ELUrl url
|
||||
| hasProtocol = RIExternal $ ELOther url
|
||||
| null link = RIFile $ ReferenceInfoFile anchor FLLocal
|
||||
| otherwise = case T.uncons link of
|
||||
Just (PathSep, path) ->
|
||||
RIFile $ ReferenceInfoFile anchor $ FLAbsolute $ RelPosixLink path
|
||||
_ ->
|
||||
RIFile $ ReferenceInfoFile anchor $ FLRelative $ RelPosixLink link
|
||||
where
|
||||
hasUrlProtocol = "://" `T.isInfixOf` T.take 10 link
|
||||
hasProtocol = ":" `T.isInfixOf` T.take 10 link
|
||||
|
||||
-- | Whether this is a link to external resource.
|
||||
isExternal :: ReferenceInfo -> Bool
|
||||
isExternal = \case
|
||||
RIFileLocal -> False
|
||||
RIFileRelative -> False
|
||||
RIFileAbsolute -> False
|
||||
RIExternal -> True
|
||||
RIOtherProtocol -> False
|
||||
|
||||
-- | Whether this is a link to repo-local resource.
|
||||
isLocal :: ReferenceInfo -> Bool
|
||||
isLocal = \case
|
||||
RIFileLocal -> True
|
||||
RIFileRelative -> True
|
||||
RIFileAbsolute -> True
|
||||
RIExternal -> False
|
||||
RIOtherProtocol -> False
|
||||
hasUrlProtocol = "://" `T.isInfixOf` T.take 10 url
|
||||
hasProtocol = ":" `T.isInfixOf` T.take 10 url
|
||||
(link, anchor) = case T.splitOn "#" url of
|
||||
[t] -> (t, Nothing)
|
||||
t : ts -> (t, Just $ T.intercalate "#" ts)
|
||||
[] -> (url, Nothing)
|
||||
|
||||
-- | Context of anchor.
|
||||
data AnchorType
|
||||
@ -184,7 +184,7 @@ data ScanPolicy
|
||||
data FileStatus
|
||||
= Scanned FileInfo
|
||||
| NotScannable
|
||||
-- ^ Files that are not supported by our scanners
|
||||
-- ^ Files that are not supported by our scanners.
|
||||
| NotAddedToGit
|
||||
-- ^ We are not scanning files that are not added to git
|
||||
-- unless --include-untracked CLI option was enabled, but we're
|
||||
@ -198,51 +198,73 @@ data DirectoryStatus
|
||||
|
||||
-- | All tracked files and directories.
|
||||
data RepoInfo = RepoInfo
|
||||
{ riFiles :: Map CanonicalPath FileStatus
|
||||
{ riFiles :: Map CanonicalRelPosixLink (RelPosixLink, FileStatus)
|
||||
-- ^ Files from the repo with `FileInfo` attached to files that we've scanned.
|
||||
, riDirectories :: Map CanonicalPath DirectoryStatus
|
||||
, riDirectories :: Map CanonicalRelPosixLink (RelPosixLink, DirectoryStatus)
|
||||
-- ^ Directories containing those files.
|
||||
, riRoot :: CanonicalPath
|
||||
-- ^ Repository root.
|
||||
}
|
||||
|
||||
-- Search for a file in the repository.
|
||||
lookupFile :: CanonicalPath -> RepoInfo -> Maybe FileStatus
|
||||
lookupFile :: CanonicalRelPosixLink -> RepoInfo -> Maybe FileStatus
|
||||
lookupFile path RepoInfo{..} =
|
||||
M.lookup path riFiles
|
||||
snd <$> M.lookup path riFiles
|
||||
|
||||
-- Search for a directory in the repository.
|
||||
lookupDirectory :: CanonicalPath -> RepoInfo -> Maybe DirectoryStatus
|
||||
lookupDirectory :: CanonicalRelPosixLink -> RepoInfo -> Maybe DirectoryStatus
|
||||
lookupDirectory path RepoInfo{..} =
|
||||
M.lookup path riDirectories
|
||||
snd <$> M.lookup path riDirectories
|
||||
|
||||
-----------------------------------------------------------
|
||||
-- Instances
|
||||
-----------------------------------------------------------
|
||||
|
||||
instance NFData ReferenceInfo
|
||||
instance NFData Anchor
|
||||
instance NFData AnchorType
|
||||
instance NFData ExternalLink
|
||||
instance NFData FileInfo
|
||||
instance NFData FileLink
|
||||
instance NFData Position
|
||||
instance NFData Reference
|
||||
instance NFData ReferenceInfo
|
||||
instance NFData AnchorType
|
||||
instance NFData Anchor
|
||||
instance NFData FileInfo
|
||||
instance NFData ReferenceInfoFile
|
||||
|
||||
instance Given ColorMode => Buildable Reference where
|
||||
build Reference{..} =
|
||||
[int||
|
||||
reference #{paren . build $ rInfo} #{rPos}:
|
||||
- text: #s{rName}
|
||||
- link: #{if null rLink then "-" else rLink}
|
||||
- anchor: #{rAnchor ?: styleIfNeeded Faint "-"}
|
||||
|]
|
||||
|
||||
instance Given ColorMode => Buildable ReferenceInfo where
|
||||
build = \case
|
||||
RIFileLocal -> colorIfNeeded Green "file-local"
|
||||
RIFileRelative -> colorIfNeeded Yellow "relative"
|
||||
RIFileAbsolute -> colorIfNeeded Blue "absolute"
|
||||
RIExternal -> colorIfNeeded Red "external"
|
||||
RIOtherProtocol -> ""
|
||||
case rInfo of
|
||||
RIFile ReferenceInfoFile{..} ->
|
||||
case rifLink of
|
||||
FLLocal ->
|
||||
[int||
|
||||
reference #{paren $ colorIfNeeded Green "file-local"} #{rPos}:
|
||||
- text: #s{rName}
|
||||
- anchor: #{rifAnchor ?: styleIfNeeded Faint "-"}
|
||||
|]
|
||||
FLRelative link ->
|
||||
[int||
|
||||
reference #{paren $ colorIfNeeded Yellow "relative"} #{rPos}:
|
||||
- text: #s{rName}
|
||||
- link: #{link}
|
||||
- anchor: #{rifAnchor ?: styleIfNeeded Faint "-"}
|
||||
|]
|
||||
FLAbsolute link ->
|
||||
[int||
|
||||
reference #{paren $ colorIfNeeded Yellow "absolute"} #{rPos}:
|
||||
- text: #s{rName}
|
||||
- link: /#{link}
|
||||
- anchor: #{rifAnchor ?: styleIfNeeded Faint "-"}
|
||||
|]
|
||||
RIExternal (ELUrl url) ->
|
||||
[int||
|
||||
reference #{paren $ colorIfNeeded Red "external"} #{rPos}:
|
||||
- text: #s{rName}
|
||||
- link: #{url}
|
||||
|]
|
||||
RIExternal (ELOther url) ->
|
||||
[int||
|
||||
reference (other) #{rPos}:
|
||||
- text: #s{rName}
|
||||
- link: #{url}
|
||||
|]
|
||||
|
||||
instance Given ColorMode => Buildable AnchorType where
|
||||
build = styleIfNeeded Faint . \case
|
||||
@ -276,13 +298,13 @@ instance Given ColorMode => Buildable FileInfo where
|
||||
|
||||
instance Given ColorMode => Buildable RepoInfo where
|
||||
build RepoInfo{..}
|
||||
| Just scanned <- nonEmpty [(name, info) | (name, Scanned info) <- toPairs riFiles]
|
||||
| Just scanned <- nonEmpty [(name, info) | (_, (name, Scanned info)) <- toPairs riFiles]
|
||||
= interpolateUnlinesF $ buildFileReport <$> scanned
|
||||
where
|
||||
buildFileReport :: (CanonicalPath, FileInfo) -> Builder
|
||||
buildFileReport :: (RelPosixLink, FileInfo) -> Builder
|
||||
buildFileReport (name, info) =
|
||||
[int||
|
||||
#{ colorIfNeeded Cyan $ getPosixRelativeOrAbsoluteChild riRoot name }:
|
||||
#{ colorIfNeeded Cyan name }:
|
||||
#{ interpolateIndentF 2 $ build info }
|
||||
|]
|
||||
build _ = "No scannable files found."
|
||||
@ -357,17 +379,17 @@ stripAnchorDupNo t = do
|
||||
-----------------------------------------------------------
|
||||
|
||||
data VerifyProgress = VerifyProgress
|
||||
{ vrLocal :: !(Progress Int Text)
|
||||
{ vrLocal :: !(Progress Int ())
|
||||
, vrExternal :: !(Progress Int Text)
|
||||
} deriving stock (Show)
|
||||
|
||||
initVerifyProgress :: [Reference] -> VerifyProgress
|
||||
initVerifyProgress references = VerifyProgress
|
||||
{ vrLocal = initProgress (length localRefs)
|
||||
, vrExternal = initProgress (length (ordNub $ map rLink extRefs))
|
||||
{ vrLocal = initProgressWitnessed $
|
||||
references ^.. folded . to rInfo . (_RIFile . united <> _RIExternal . _ELOther . united)
|
||||
, vrExternal = initProgressWitnessed . ordNub $
|
||||
references ^.. folded . to rInfo . _RIExternal . _ELUrl
|
||||
}
|
||||
where
|
||||
(extRefs, localRefs) = L.partition (isExternal . rInfo) references
|
||||
|
||||
showAnalyseProgress :: Given ColorMode => VerifyMode -> Time Second -> VerifyProgress -> Text
|
||||
showAnalyseProgress mode posixTime VerifyProgress{..} =
|
||||
|
@ -11,6 +11,7 @@ module Xrefcheck.Progress
|
||||
-- * Progress
|
||||
, Progress
|
||||
, initProgress
|
||||
, initProgressWitnessed
|
||||
, reportSuccess
|
||||
, reportError
|
||||
, reportRetry
|
||||
@ -82,6 +83,20 @@ initProgress a = Progress
|
||||
, pTaskTimestamp = Nothing
|
||||
}
|
||||
|
||||
-- | Initialise null progress from a given list of witnesses.
|
||||
--
|
||||
-- This just initializes it with as many work to do as witnesses are in the list, so you can be
|
||||
-- more confident regarding the progress initialization because you actualy provided data that
|
||||
-- represents each unit of work to do.
|
||||
initProgressWitnessed :: [w] -> Progress Int w
|
||||
initProgressWitnessed ws = Progress
|
||||
{ pTotal = length ws
|
||||
, pSuccess = 0
|
||||
, pError = 0
|
||||
, pRetrying = S.empty
|
||||
, pTaskTimestamp = Nothing
|
||||
}
|
||||
|
||||
-- | Report a unit of success with witness @item@.
|
||||
reportSuccess :: (Num a, Ord w) => w -> Progress a w -> Progress a w
|
||||
reportSuccess item Progress{..} = Progress
|
||||
@ -105,14 +120,23 @@ reportRetry item Progress{..} = Progress
|
||||
, ..
|
||||
}
|
||||
|
||||
-- | Set the current `TaskTimestamp`.
|
||||
--
|
||||
-- It does require a witness because, although the `TaskTimestamp` is
|
||||
-- anonymous, at this point an actual task should be responsible for
|
||||
-- registering this timestamp.
|
||||
setTaskTimestamp :: w -> Time Second -> Time Second -> Progress a w -> Progress a w
|
||||
setTaskTimestamp _ ttc startTime Progress{..} = Progress
|
||||
{ pTaskTimestamp = Just (TaskTimestamp ttc startTime)
|
||||
, ..
|
||||
}
|
||||
|
||||
getTaskTimestamp :: w -> Progress a w -> Maybe TaskTimestamp
|
||||
getTaskTimestamp _ = pTaskTimestamp
|
||||
-- | Get the current `TaskTimestamp`.
|
||||
--
|
||||
-- It does not require a witness because the `TaskTimestamp` is anonymous
|
||||
-- and anyone should be able to observe it.
|
||||
getTaskTimestamp :: Progress a w -> Maybe TaskTimestamp
|
||||
getTaskTimestamp = pTaskTimestamp
|
||||
|
||||
removeTaskTimestamp :: Progress a w -> Progress a w
|
||||
removeTaskTimestamp Progress{..} = Progress
|
||||
|
@ -36,11 +36,10 @@ import Universum
|
||||
|
||||
import Control.Lens (makeLensesWith)
|
||||
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 (..), fmt)
|
||||
import System.Directory (doesDirectoryExist)
|
||||
import System.Directory (doesDirectoryExist, pathIsSymbolicLink)
|
||||
import System.Process (cwd, readCreateProcess, shell)
|
||||
import Text.Interpolation.Nyan
|
||||
import Text.Regex.TDFA.Common (CompOption (..), ExecOption (..), Regex)
|
||||
@ -56,11 +55,11 @@ type ExclusionConfig = ExclusionConfig' Identity
|
||||
|
||||
-- | Config of repositry exclusions.
|
||||
data ExclusionConfig' f = ExclusionConfig
|
||||
{ ecIgnore :: Field f [RelGlobPattern]
|
||||
{ ecIgnore :: Field f [CanonicalRelGlobPattern]
|
||||
-- ^ Files which we completely ignore.
|
||||
, ecIgnoreLocalRefsTo :: Field f [RelGlobPattern]
|
||||
, ecIgnoreLocalRefsTo :: Field f [CanonicalRelGlobPattern]
|
||||
-- ^ Files references to which we do not verify.
|
||||
, ecIgnoreRefsFrom :: Field f [RelGlobPattern]
|
||||
, ecIgnoreRefsFrom :: Field f [CanonicalRelGlobPattern]
|
||||
-- ^ Files, references in which we should not analyze.
|
||||
, ecIgnoreExternalRefsTo :: Field f [Regex]
|
||||
-- ^ Regular expressions that match external references we should not verify.
|
||||
@ -72,7 +71,7 @@ makeLensesWith postfixFields ''ExclusionConfig'
|
||||
type Extension = String
|
||||
|
||||
-- | Way to parse a file.
|
||||
type ScanAction = CanonicalPath -> IO (FileInfo, [ScanError 'Parse])
|
||||
type ScanAction = FilePath -> RelPosixLink -> IO (FileInfo, [ScanError 'Parse])
|
||||
|
||||
-- | All supported ways to parse a file.
|
||||
type FormatsSupport = Extension -> Maybe ScanAction
|
||||
@ -99,7 +98,7 @@ data ScanStage = Parse | Gather
|
||||
|
||||
type family ScanStageFile (a :: ScanStage) where
|
||||
ScanStageFile 'Parse = ()
|
||||
ScanStageFile 'Gather = FilePath
|
||||
ScanStageFile 'Gather = RelPosixLink
|
||||
|
||||
deriving stock instance Show (ScanError 'Parse)
|
||||
deriving stock instance Show (ScanError 'Gather)
|
||||
@ -112,7 +111,7 @@ mkParseScanError = ScanError ()
|
||||
|
||||
-- | Promote a 'ScanError' from the 'Parse' stage
|
||||
-- to the 'Gather' stage.
|
||||
mkGatherScanError :: FilePath -> ScanError 'Parse -> ScanError 'Gather
|
||||
mkGatherScanError :: RelPosixLink -> ScanError 'Parse -> ScanError 'Gather
|
||||
mkGatherScanError seFile ScanError{sePosition, seDescription} = ScanError
|
||||
{ seFile
|
||||
, sePosition
|
||||
@ -177,13 +176,12 @@ data ReadDirectoryMode
|
||||
readDirectoryWith
|
||||
:: forall a. ReadDirectoryMode
|
||||
-> ExclusionConfig
|
||||
-> (CanonicalPath -> IO a)
|
||||
-> CanonicalPath
|
||||
-> IO [(CanonicalPath, a)]
|
||||
-> (RelPosixLink -> IO a)
|
||||
-> FilePath
|
||||
-> IO [(RelPosixLink, a)]
|
||||
readDirectoryWith mode config scanner root = do
|
||||
relativeFiles <- L.lines <$> getFiles
|
||||
canonicalFiles <- mapM (root </) relativeFiles
|
||||
traverse scanFile $ filter (not . isIgnored) canonicalFiles
|
||||
relativeFiles <- fmap mkRelPosixLink . fileLines <$> getFiles
|
||||
traverse scanFile $ filter (not . isIgnored) relativeFiles
|
||||
|
||||
where
|
||||
|
||||
@ -193,37 +191,46 @@ readDirectoryWith mode config scanner root = do
|
||||
RdmBothTrackedAndUtracked -> liftA2 (<>) getTrackedFiles getUntrackedFiles
|
||||
|
||||
getTrackedFiles = readCreateProcess
|
||||
(shell "git ls-files"){cwd = Just $ unCanonicalPath root} ""
|
||||
(shell "git ls-files -z"){cwd = Just root} ""
|
||||
getUntrackedFiles = readCreateProcess
|
||||
(shell "git ls-files --others --exclude-standard"){cwd = Just $ unCanonicalPath root} ""
|
||||
(shell "git ls-files -z --others --exclude-standard"){cwd = Just root} ""
|
||||
|
||||
scanFile :: CanonicalPath -> IO (CanonicalPath, a)
|
||||
fileLines :: String -> [String]
|
||||
fileLines (dropWhile (== '\0') -> ls) =
|
||||
case break (== '\0') ls of
|
||||
([], _) -> []
|
||||
(f, ls') -> f : fileLines ls'
|
||||
|
||||
scanFile :: RelPosixLink -> IO (RelPosixLink, a)
|
||||
scanFile c = (c,) <$> scanner c
|
||||
|
||||
isIgnored :: CanonicalPath -> Bool
|
||||
isIgnored = matchesGlobPatterns root $ ecIgnore config
|
||||
isIgnored :: RelPosixLink -> Bool
|
||||
isIgnored = matchesGlobPatterns (ecIgnore config) . canonicalizeRelPosixLink
|
||||
|
||||
scanRepo
|
||||
:: MonadIO m
|
||||
=> ScanPolicy -> Rewrite -> FormatsSupport -> ExclusionConfig -> FilePath -> m ScanResult
|
||||
=> ScanPolicy
|
||||
-> Rewrite
|
||||
-> FormatsSupport
|
||||
-> ExclusionConfig
|
||||
-> FilePath
|
||||
-> m ScanResult
|
||||
scanRepo scanMode rw formatsSupport config root = do
|
||||
putTextRewrite rw "Scanning repository..."
|
||||
|
||||
liftIO $ whenM (not <$> doesDirectoryExist root) $
|
||||
die $ "Repository's root does not seem to be a directory: " <> root
|
||||
|
||||
canonicalRoot <- liftIO $ canonicalizePath root
|
||||
|
||||
(errs, processedFiles) <-
|
||||
let mode = case scanMode of
|
||||
OnlyTracked -> RdmTracked
|
||||
IncludeUntracked -> RdmBothTrackedAndUtracked
|
||||
in liftIO $ (gatherScanErrs canonicalRoot &&& gatherFileStatuses)
|
||||
<$> readDirectoryWith mode config processFile canonicalRoot
|
||||
in liftIO $ (gatherScanErrs &&& gatherFileStatuses)
|
||||
<$> readDirectoryWith mode config processFile root
|
||||
|
||||
notProcessedFiles <- case scanMode of
|
||||
OnlyTracked -> liftIO $
|
||||
readDirectoryWith RdmUntracked config (const $ pure NotAddedToGit) canonicalRoot
|
||||
readDirectoryWith RdmUntracked config (const $ pure NotAddedToGit) root
|
||||
IncludeUntracked -> pure []
|
||||
|
||||
let scannableNotProcessedFiles = filter (isJust . mscanner . fst) notProcessedFiles
|
||||
@ -231,45 +238,46 @@ scanRepo scanMode rw formatsSupport config root = do
|
||||
whenJust (nonEmpty $ map fst scannableNotProcessedFiles) $ \files -> hPutStrLn @Text stderr
|
||||
[int|A|
|
||||
Those files are not added by Git, so we're not scanning them:
|
||||
#{interpolateBlockListF $ getPosixRelativeOrAbsoluteChild canonicalRoot <$> files}
|
||||
#{interpolateBlockListF files}
|
||||
Please run "git add" before running xrefcheck or enable \
|
||||
--include-untracked CLI option to check these files.
|
||||
|]
|
||||
|
||||
let trackedDirs = foldMap (getDirsBetweenRootAndFile canonicalRoot . fst) processedFiles
|
||||
untrackedDirs = foldMap (getDirsBetweenRootAndFile canonicalRoot . fst) notProcessedFiles
|
||||
let trackedDirs = foldMap (getIntermediateDirs . fst) processedFiles
|
||||
untrackedDirs = foldMap (getIntermediateDirs . fst) notProcessedFiles
|
||||
|
||||
return . ScanResult errs $ RepoInfo
|
||||
{ riFiles = M.fromList $ processedFiles <> notProcessedFiles
|
||||
, riDirectories = M.fromList (fmap (, TrackedDirectory) trackedDirs
|
||||
{ riFiles = M.fromList $ fmap canonicalLinkEntry $ processedFiles <> notProcessedFiles
|
||||
, riDirectories = M.fromList $ fmap canonicalLinkEntry (fmap (, TrackedDirectory) trackedDirs
|
||||
<> fmap (, UntrackedDirectory) untrackedDirs)
|
||||
, riRoot = canonicalRoot
|
||||
}
|
||||
where
|
||||
mscanner :: CanonicalPath -> Maybe ScanAction
|
||||
mscanner :: RelPosixLink -> Maybe ScanAction
|
||||
mscanner = formatsSupport . takeExtension
|
||||
|
||||
gatherScanErrs
|
||||
:: CanonicalPath
|
||||
-> [(CanonicalPath, (FileStatus, [ScanError 'Parse]))]
|
||||
:: [(RelPosixLink, (FileStatus, [ScanError 'Parse]))]
|
||||
-> [ScanError 'Gather]
|
||||
gatherScanErrs canonicalRoot = foldMap $ \(file, (_, errs)) ->
|
||||
mkGatherScanError (showFilepath file) <$> errs
|
||||
where
|
||||
showFilepath = getPosixRelativeOrAbsoluteChild canonicalRoot
|
||||
gatherScanErrs = foldMap $ \(file, (_, errs)) ->
|
||||
mkGatherScanError file <$> errs
|
||||
|
||||
gatherFileStatuses
|
||||
:: [(CanonicalPath, (FileStatus, [ScanError 'Parse]))]
|
||||
-> [(CanonicalPath, FileStatus)]
|
||||
:: [(RelPosixLink, (FileStatus, [ScanError 'Parse]))]
|
||||
-> [(RelPosixLink, FileStatus)]
|
||||
gatherFileStatuses = map (second fst)
|
||||
|
||||
processFile :: CanonicalPath -> IO (FileStatus, [ScanError 'Parse])
|
||||
processFile canonicalFile =
|
||||
ifM (pathIsSymbolicLink canonicalFile)
|
||||
processFile :: RelPosixLink -> IO (FileStatus, [ScanError 'Parse])
|
||||
processFile file =
|
||||
ifM (pathIsSymbolicLink (filePathFromRoot root file))
|
||||
(pure (NotScannable, []))
|
||||
case mscanner canonicalFile of
|
||||
case mscanner file of
|
||||
Nothing -> pure (NotScannable, [])
|
||||
Just scanner -> scanner canonicalFile <&> _1 %~ Scanned
|
||||
Just scanner -> scanner root file <&> _1 %~ Scanned
|
||||
|
||||
canonicalLinkEntry
|
||||
:: (RelPosixLink, a)
|
||||
-> (CanonicalRelPosixLink, (RelPosixLink, a))
|
||||
canonicalLinkEntry (a, b) = (canonicalizeRelPosixLink a, (a, b))
|
||||
|
||||
-----------------------------------------------------------
|
||||
-- Yaml instances
|
||||
|
@ -326,17 +326,10 @@ nodeExtractInfo input@(Node _ _ nSubs) = do
|
||||
extractLink url = do
|
||||
let rName = nodeExtractText node
|
||||
rPos = toPosition pos
|
||||
link = if null url then rName else url
|
||||
|
||||
let (rLink, rAnchor) = case T.splitOn "#" link of
|
||||
[t] -> (t, Nothing)
|
||||
t : ts -> (t, Just $ T.intercalate "#" ts)
|
||||
[] -> error "impossible"
|
||||
|
||||
let rInfo = referenceInfo rLink
|
||||
rInfo = referenceInfo $ if null url then rName else url
|
||||
|
||||
return $ FileInfoDiff
|
||||
(DList.singleton $ Reference {rName, rPos, rLink, rAnchor, rInfo})
|
||||
(DList.singleton $ Reference {rName, rPos, rInfo})
|
||||
DList.empty
|
||||
|
||||
-- | Check if there is `ignore all` at the beginning of the file,
|
||||
@ -413,9 +406,9 @@ parseFileInfo config input
|
||||
$ toStrict input
|
||||
|
||||
markdownScanner :: MarkdownConfig -> ScanAction
|
||||
markdownScanner config canonicalFile =
|
||||
markdownScanner config root file =
|
||||
parseFileInfo config . decodeUtf8
|
||||
<$> BSL.readFile (unCanonicalPath canonicalFile)
|
||||
<$> BSL.readFile (filePathFromRoot root file)
|
||||
|
||||
markdownSupport :: MarkdownConfig -> ([Extension], ScanAction)
|
||||
markdownSupport config = ([".md"], markdownScanner config)
|
||||
|
@ -4,45 +4,39 @@
|
||||
-}
|
||||
|
||||
module Xrefcheck.System
|
||||
( readingSystem
|
||||
, askWithinCI
|
||||
( askWithinCI
|
||||
|
||||
, CanonicalPath
|
||||
, canonicalizePath
|
||||
, unCanonicalPath
|
||||
, getDirsBetweenRootAndFile
|
||||
, getPosixRelativeChild
|
||||
, getPosixRelativeOrAbsoluteChild
|
||||
, hasIndirectionThroughParent
|
||||
, pathIsSymbolicLink
|
||||
, RelPosixLink (..)
|
||||
, (</>)
|
||||
, mkRelPosixLink
|
||||
, filePathFromRoot
|
||||
, getIntermediateDirs
|
||||
, hasBackslash
|
||||
, takeDirectory
|
||||
, takeExtension
|
||||
, (</)
|
||||
|
||||
, RelGlobPattern (unRelGlobPattern)
|
||||
, mkGlobPattern
|
||||
, bindGlobPattern
|
||||
, CanonicalRelPosixLink (unCanonicalRelPosixLink)
|
||||
, hasUnexpanededParentIndirections
|
||||
, canonicalizeRelPosixLink
|
||||
|
||||
, CanonicalRelGlobPattern (unCanonicalRelGlobPattern)
|
||||
, matchesGlobPatterns
|
||||
, mkCanonicalRelGlobPattern
|
||||
) where
|
||||
|
||||
import Universum
|
||||
|
||||
import Data.Aeson (FromJSON (..), withText)
|
||||
import Data.Char qualified as C
|
||||
import Data.List (stripPrefix)
|
||||
import GHC.IO.Unsafe (unsafePerformIO)
|
||||
import System.Directory qualified as Directory
|
||||
import Data.Text qualified as T
|
||||
import Fmt (Buildable)
|
||||
import System.Console.Pretty (Pretty)
|
||||
import System.Environment (lookupEnv)
|
||||
import System.FilePath qualified as FP
|
||||
import System.FilePath.Glob qualified as Glob
|
||||
import System.FilePath.Posix qualified as FPP
|
||||
import Text.Interpolation.Nyan (int, rmode')
|
||||
|
||||
-- | 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
|
||||
|
||||
-- | Heuristics to check whether we are running within CI.
|
||||
-- Check the respective env variable which is usually set in all CIs.
|
||||
askWithinCI :: IO Bool
|
||||
@ -51,125 +45,133 @@ askWithinCI = lookupEnv "CI" <&> \case
|
||||
Just (map C.toLower -> "true") -> True
|
||||
_ -> False
|
||||
|
||||
-- | A FilePath that has been canonicalized.
|
||||
-- | Relative file path with POSIX path separators.
|
||||
--
|
||||
-- It should be created via 'canonicalizePath'.
|
||||
-- This type exist in contrast to 'FilePath' which, in this project,
|
||||
-- is used for platform-dependent file paths and related filesystem
|
||||
-- IO operations.
|
||||
--
|
||||
-- Currently, canonical paths have been made absolute, normalised
|
||||
-- regarding the running platform (e.g. Posix or Windows), with
|
||||
-- indirections syntactically expanded as much as possible and
|
||||
-- with no trailing path separator. All this results in a weaker
|
||||
-- version than that provided by 'System.Directory.canonicalizePath'.
|
||||
newtype CanonicalPath = UnsafeCanonicalPath
|
||||
{ unCanonicalPath :: FilePath
|
||||
} deriving newtype (Show, Eq, Ord)
|
||||
-- Note that `RelPosixLink` may contain `\` characters, but they are
|
||||
-- considered as part of the filename instead of denoting a path
|
||||
-- separator.
|
||||
newtype RelPosixLink = RelPosixLink
|
||||
{ unRelPosixLink :: Text
|
||||
} deriving newtype (Show, Eq, Ord, NFData, Buildable, Pretty)
|
||||
|
||||
canonicalizePath :: FilePath -> IO CanonicalPath
|
||||
canonicalizePath = fmap canonicalize . Directory.makeAbsolute
|
||||
where
|
||||
canonicalize :: FilePath -> CanonicalPath
|
||||
canonicalize = UnsafeCanonicalPath
|
||||
. expandIndirections
|
||||
. FP.normalise
|
||||
. FP.dropTrailingPathSeparator
|
||||
-- | Create a POSIX file path from a platform-dependent one.
|
||||
mkRelPosixLink :: FilePath -> RelPosixLink
|
||||
mkRelPosixLink = RelPosixLink
|
||||
. withPathSeparator FPP.pathSeparator
|
||||
. fromString
|
||||
|
||||
expandIndirections :: FilePath -> FilePath
|
||||
expandIndirections = FP.joinPath
|
||||
. reverse
|
||||
. expand 0
|
||||
. reverse
|
||||
. FP.splitDirectories
|
||||
-- | Join two 'RelPosixLink's.
|
||||
(</>) :: RelPosixLink -> RelPosixLink -> RelPosixLink
|
||||
RelPosixLink a </> RelPosixLink b =
|
||||
let a' = fromMaybe a $ T.stripSuffix "/" a
|
||||
b' = fromMaybe b $ T.stripPrefix "./" a
|
||||
in case (a', b') of
|
||||
("", _) -> RelPosixLink b
|
||||
(".", _) -> RelPosixLink b
|
||||
_ -> RelPosixLink $ a' <> "/" <> b'
|
||||
|
||||
expand :: Int -> [FilePath] -> [FilePath]
|
||||
expand acc (".." : xs) = expand (acc + 1) xs
|
||||
expand acc ("." : xs) = expand acc xs
|
||||
expand 0 (x : xs) = x : expand 0 xs
|
||||
expand acc (_ : xs) = expand (acc - 1) xs
|
||||
expand acc [] = replicate acc ".."
|
||||
|
||||
-- | 'FilePath.takeDirectory' version for 'CanonicalPath'.
|
||||
takeDirectory :: CanonicalPath -> CanonicalPath
|
||||
takeDirectory (UnsafeCanonicalPath p) = UnsafeCanonicalPath $ FP.takeDirectory p
|
||||
|
||||
-- | 'FilePath.takeExtension' version for 'CanonicalPath'.
|
||||
takeExtension :: CanonicalPath -> String
|
||||
takeExtension (UnsafeCanonicalPath p) = FP.takeExtension p
|
||||
|
||||
-- | 'System.Directory.pathIsSymbolicLink' version for 'CanonicalPath'.
|
||||
pathIsSymbolicLink :: CanonicalPath -> IO Bool
|
||||
pathIsSymbolicLink (UnsafeCanonicalPath p) = Directory.pathIsSymbolicLink p
|
||||
|
||||
-- | Get the list of directories, canonicalized, between two given paths.
|
||||
getDirsBetweenRootAndFile :: CanonicalPath -> CanonicalPath -> [CanonicalPath]
|
||||
getDirsBetweenRootAndFile (UnsafeCanonicalPath rootPath) file =
|
||||
case stripPrefix rootPath (unCanonicalPath (takeDirectory file)) of
|
||||
Just path -> UnsafeCanonicalPath <$> scanl (FP.</>) rootPath directories
|
||||
where
|
||||
directories = FP.splitDirectories $ dropWhile FP.isPathSeparator path
|
||||
Nothing -> []
|
||||
|
||||
-- | Get a relative 'FilePath' from the second given path (child) with
|
||||
-- respect to the first one (root).
|
||||
-- Get the platform-dependent file path from a 'RelPosixLink'
|
||||
-- considered as relative to another given platform-dependent
|
||||
-- 'FilePath'.
|
||||
--
|
||||
-- It returns Nothing if child cannot be reached from root downwards
|
||||
-- in the filesystem tree.
|
||||
-- In Windows, every `\` occurrence will be replaced by `/`.
|
||||
filePathFromRoot :: FilePath -> RelPosixLink -> FilePath
|
||||
filePathFromRoot rootPath = (rootPath FP.</>)
|
||||
. toString
|
||||
. withPathSeparator FP.pathSeparator
|
||||
. unRelPosixLink
|
||||
|
||||
-- | 'FilePath.takeDirectory' version for 'RelPosixLink'.
|
||||
takeDirectory :: RelPosixLink -> RelPosixLink
|
||||
takeDirectory = RelPosixLink
|
||||
. fromString
|
||||
. FPP.takeDirectory
|
||||
. toString
|
||||
. unRelPosixLink
|
||||
|
||||
-- | 'FilePath.takeExtension' version for 'RelPosixLink'.
|
||||
takeExtension :: RelPosixLink -> String
|
||||
takeExtension = FPP.takeExtension
|
||||
. toString
|
||||
. unRelPosixLink
|
||||
|
||||
-- | 'Check if a 'RelPosixLink' contains any backslash.
|
||||
hasBackslash :: RelPosixLink -> Bool
|
||||
hasBackslash = ('\\' `elem`)
|
||||
. unRelPosixLink
|
||||
|
||||
-- | Get the list of directories between a 'RelPosixLink' and its
|
||||
-- relative root.
|
||||
getIntermediateDirs :: RelPosixLink -> [RelPosixLink]
|
||||
getIntermediateDirs link = fmap RelPosixLink $
|
||||
case T.splitOn "/" $ unRelPosixLink $ takeDirectory link of
|
||||
[] -> []
|
||||
["."] -> [""]
|
||||
[".."] -> ["", ".."]
|
||||
d : ds -> scanl (\a b -> a <> "/" <> b) d ds
|
||||
|
||||
-- | Relative POSIX file path with some normalizations applied.
|
||||
--
|
||||
-- The resulting `FilePath` uses POSIX path separators.
|
||||
getPosixRelativeChild :: CanonicalPath -> CanonicalPath -> Maybe FilePath
|
||||
getPosixRelativeChild (UnsafeCanonicalPath root) (UnsafeCanonicalPath child) =
|
||||
dropLeadingSepAndEmptyCase . fmap replaceSeparator <$> stripPrefix root child
|
||||
where
|
||||
replaceSeparator :: Char -> Char
|
||||
replaceSeparator c
|
||||
| FP.isPathSeparator c = FPP.pathSeparator
|
||||
| otherwise = c
|
||||
-- It should be created from a 'RelPosixLink' via
|
||||
-- 'canonicalizeRelPosixLink'.
|
||||
newtype CanonicalRelPosixLink = UnsafeCanonicalRelPosixLink
|
||||
{ unCanonicalRelPosixLink :: RelPosixLink
|
||||
} deriving newtype (Show, Eq, Ord, NFData, Buildable, Pretty)
|
||||
|
||||
dropLeadingSepAndEmptyCase :: FilePath -> FilePath
|
||||
dropLeadingSepAndEmptyCase path = case dropWhile FP.isPathSeparator path of
|
||||
"" -> "."
|
||||
other -> other
|
||||
-- | Canonicalize a 'RelPosixLink'.
|
||||
--
|
||||
-- Applies the following normalizations:
|
||||
--
|
||||
-- * Drop trailing path separator.
|
||||
--
|
||||
-- * Expand '.' and '..' indirections syntactically.
|
||||
--
|
||||
canonicalizeRelPosixLink :: RelPosixLink -> CanonicalRelPosixLink
|
||||
canonicalizeRelPosixLink = UnsafeCanonicalRelPosixLink
|
||||
. RelPosixLink
|
||||
. expandPosixIndirections
|
||||
. dropTrailingPosixPathSeparator
|
||||
. withPathSeparator FPP.pathSeparator
|
||||
. unRelPosixLink
|
||||
|
||||
-- | Get the relative 'FilePath' using 'getPosixRelativeChild', but
|
||||
-- return the same passed absolute path instead of 'Nothing'.
|
||||
getPosixRelativeOrAbsoluteChild :: CanonicalPath -> CanonicalPath -> FilePath
|
||||
getPosixRelativeOrAbsoluteChild root child =
|
||||
fromMaybe (unCanonicalPath child) (getPosixRelativeChild root child)
|
||||
|
||||
-- | Check if some 'FilePath' passes through its parent while
|
||||
-- | Check if a 'CanonicalRelPosixLink' passes through its relative root when
|
||||
-- expanding indirections.
|
||||
hasIndirectionThroughParent :: FilePath -> Bool
|
||||
hasIndirectionThroughParent = go 0 . FP.splitDirectories
|
||||
where
|
||||
go :: Int -> [FilePath] -> Bool
|
||||
go _ [] = False
|
||||
go 0 (".." : _) = True
|
||||
go acc (".." : xs) = go (acc - 1) xs
|
||||
go acc ("." : xs) = go acc xs
|
||||
go acc (_ : xs) = go (acc + 1) xs
|
||||
hasUnexpanededParentIndirections :: CanonicalRelPosixLink -> Bool
|
||||
hasUnexpanededParentIndirections = elem ".."
|
||||
. T.splitOn "/"
|
||||
. unRelPosixLink
|
||||
. unCanonicalRelPosixLink
|
||||
|
||||
-- | Extend some 'CanonicalPath' with a given relative 'FilePath'.
|
||||
-- | Relative Glob pattern with some normalizations applied.
|
||||
--
|
||||
-- The right-hand side 'FilePath' can use both Posix and Windows
|
||||
-- path separators.
|
||||
(</) :: CanonicalPath -> FilePath -> IO CanonicalPath
|
||||
UnsafeCanonicalPath p </ f = canonicalizePath $ p FP.</> f
|
||||
infixr 5 </
|
||||
|
||||
-- | Glob pattern relative to repository root.
|
||||
--
|
||||
-- It should be created via 'mkGlobPattern'.
|
||||
newtype RelGlobPattern = UnsafeRelGlobPattern
|
||||
{ unRelGlobPattern :: FilePath
|
||||
-- It should be created via 'mkCanonicalRelGlobPattern'.
|
||||
newtype CanonicalRelGlobPattern = UnsafeCanonicalRelGlobPattern
|
||||
{ unCanonicalRelGlobPattern :: Glob.Pattern
|
||||
}
|
||||
|
||||
mkGlobPattern :: ToString s => s -> Either String RelGlobPattern
|
||||
mkGlobPattern path = do
|
||||
-- | Create a CanonicalRelGlobPattern from a 'ToString' instance value that
|
||||
-- represents a POSIX glob pattern.
|
||||
--
|
||||
-- Applies the following normalizations:
|
||||
--
|
||||
-- * Drop trailing path separator.
|
||||
--
|
||||
-- * FilePath.Posix.normalise.
|
||||
--
|
||||
-- * Expand '.' and '..' indirections syntactically.
|
||||
--
|
||||
mkCanonicalRelGlobPattern :: ToString s => s -> Either String CanonicalRelGlobPattern
|
||||
mkCanonicalRelGlobPattern path = do
|
||||
let spath = toString path
|
||||
unless (FPP.isRelative spath) $ Left $
|
||||
"Expected a relative glob pattern, but got " <> spath
|
||||
-- Checking correctness of glob, e.g. "a[b" is incorrect
|
||||
case Glob.tryCompileWith globCompileOptions spath of
|
||||
Right _ -> return (UnsafeRelGlobPattern spath)
|
||||
case Glob.tryCompileWith globCompileOptions (normalise spath) of
|
||||
Right pat -> return $ UnsafeCanonicalRelGlobPattern pat
|
||||
Left err -> Left
|
||||
[int||
|
||||
Glob pattern compilation failed.
|
||||
@ -179,27 +181,53 @@ mkGlobPattern path = do
|
||||
https://hackage.haskell.org/package/Glob/docs/System-FilePath-Glob.html#v:compile
|
||||
Special characters in file names can be escaped using square brackets, e.g. <a> -> [<]a[>].
|
||||
|]
|
||||
where
|
||||
normalise = toString
|
||||
. expandPosixIndirections
|
||||
. fromString
|
||||
. FPP.normalise
|
||||
. FPP.dropTrailingPathSeparator
|
||||
|
||||
bindGlobPattern :: CanonicalPath -> RelGlobPattern -> Glob.Pattern
|
||||
bindGlobPattern root (UnsafeRelGlobPattern relPat) = readingSystem $ do
|
||||
UnsafeCanonicalPath absPat <- root </ relPat
|
||||
case Glob.tryCompileWith globCompileOptions absPat of
|
||||
Left err -> error $
|
||||
"Glob pattern compilation failed after canonicalization: " <> toText err
|
||||
Right pat ->
|
||||
return pat
|
||||
|
||||
matchesGlobPatterns :: CanonicalPath -> [RelGlobPattern] -> CanonicalPath -> Bool
|
||||
matchesGlobPatterns root globPatterns file = or
|
||||
[ Glob.match pat $ unCanonicalPath file
|
||||
| globPattern <- globPatterns
|
||||
, let pat = bindGlobPattern root globPattern
|
||||
-- Checks if a 'CanonicalRelPosixLink' matches some of the given
|
||||
-- 'CanonicalRelGlobPattern's.
|
||||
--
|
||||
-- They are considered as relative to the same root.
|
||||
matchesGlobPatterns :: [CanonicalRelGlobPattern] -> CanonicalRelPosixLink -> Bool
|
||||
matchesGlobPatterns globPatterns file = or
|
||||
[ Glob.match pat . toString . unRelPosixLink . unCanonicalRelPosixLink $ file
|
||||
| UnsafeCanonicalRelGlobPattern pat <- globPatterns
|
||||
]
|
||||
|
||||
instance FromJSON RelGlobPattern where
|
||||
instance FromJSON CanonicalRelGlobPattern where
|
||||
parseJSON = withText "Repo-relative glob pattern" $
|
||||
either fail pure . mkGlobPattern
|
||||
either fail pure . mkCanonicalRelGlobPattern
|
||||
|
||||
-- | Glob compilation options we use.
|
||||
globCompileOptions :: Glob.CompOptions
|
||||
globCompileOptions = Glob.compDefault{Glob.errorRecovery = False}
|
||||
|
||||
dropTrailingPosixPathSeparator :: Text -> Text
|
||||
dropTrailingPosixPathSeparator p = fromMaybe p
|
||||
$ T.stripSuffix "/" p
|
||||
|
||||
expandPosixIndirections :: Text -> Text
|
||||
expandPosixIndirections = T.intercalate "/"
|
||||
. reverse
|
||||
. expand 0
|
||||
. reverse
|
||||
. T.split (FPP.isPathSeparator)
|
||||
where
|
||||
expand :: Int -> [Text] -> [Text]
|
||||
expand acc (".." : xs) = expand (acc + 1) xs
|
||||
expand acc ("." : xs) = expand acc xs
|
||||
expand 0 (x : xs) = x : expand 0 xs
|
||||
expand acc (_ : xs) = expand (acc - 1) xs
|
||||
expand acc [] = replicate acc ".."
|
||||
|
||||
withPathSeparator :: Char -> Text -> Text
|
||||
withPathSeparator pathSep = T.map replaceSeparator
|
||||
where
|
||||
replaceSeparator :: Char -> Char
|
||||
replaceSeparator c
|
||||
| FP.isPathSeparator c = pathSep
|
||||
| otherwise = c
|
||||
|
@ -62,8 +62,6 @@ import Network.HTTP.Req
|
||||
defaultHttpConfig, ignoreResponse, req, runReq, useURI)
|
||||
import Network.HTTP.Types.Header (hRetryAfter)
|
||||
import Network.HTTP.Types.Status (Status, statusCode, statusMessage)
|
||||
import System.FilePath (isPathSeparator)
|
||||
import System.FilePath.Posix ((</>))
|
||||
import Text.Interpolation.Nyan
|
||||
import Text.ParserCombinators.ReadPrec qualified as ReadPrec (lift)
|
||||
import Text.URI (Authority (..), ParseExceptionBs, URI (..), mkURIBs, unRText)
|
||||
@ -106,7 +104,7 @@ toVerifyRes = VerifyResult . either one (\() -> [])
|
||||
-----------------------------------------------------------
|
||||
|
||||
data WithReferenceLoc a = WithReferenceLoc
|
||||
{ wrlFile :: FilePath
|
||||
{ wrlFile :: RelPosixLink
|
||||
, wrlReference :: Reference
|
||||
, wrlItem :: a
|
||||
}
|
||||
@ -126,11 +124,11 @@ newtype DomainName = DomainName { unDomainName :: Text }
|
||||
deriving stock (Show, Eq, Ord)
|
||||
|
||||
data VerifyError
|
||||
= LocalFileDoesNotExist FilePath
|
||||
| LocalFileOutsideRepo FilePath
|
||||
| LinkTargetNotAddedToGit FilePath
|
||||
= LocalFileDoesNotExist RelPosixLink
|
||||
| LocalFileOutsideRepo RelPosixLink
|
||||
| LinkTargetNotAddedToGit RelPosixLink
|
||||
| AnchorDoesNotExist Text [Anchor]
|
||||
| AmbiguousAnchorRef FilePath Text (NonEmpty Anchor)
|
||||
| AmbiguousAnchorRef RelPosixLink Text (NonEmpty Anchor)
|
||||
| ExternalResourceInvalidUri URIBS.URIParseError
|
||||
| ExternalResourceUriConversionError ParseExceptionBs
|
||||
| ExternalResourceInvalidUrl (Maybe Text)
|
||||
@ -157,7 +155,11 @@ instance Given ColorMode => Buildable VerifyError where
|
||||
LocalFileDoesNotExist file ->
|
||||
[int||
|
||||
File does not exist:
|
||||
#{file}
|
||||
#{file}#l{
|
||||
if hasBackslash file
|
||||
then "\\n Its reference contains a backslash. Maybe it uses the wrong path separator."
|
||||
else ""
|
||||
}
|
||||
|]
|
||||
|
||||
LocalFileOutsideRepo file ->
|
||||
@ -406,8 +408,8 @@ verifyRepo
|
||||
repoInfo@RepoInfo{..}
|
||||
= do
|
||||
let toScan = do
|
||||
(file, fileInfo) <- toPairs riFiles
|
||||
guard . not $ matchesGlobPatterns riRoot (ecIgnoreRefsFrom cExclusions) file
|
||||
(canonicalFile, (file, fileInfo)) <- toPairs riFiles
|
||||
guard . not $ matchesGlobPatterns (ecIgnoreRefsFrom cExclusions) canonicalFile
|
||||
case fileInfo of
|
||||
Scanned fi -> do
|
||||
ref <- _fiReferences fi
|
||||
@ -451,15 +453,18 @@ verifyRepo
|
||||
|
||||
ifExternalThenCache :: (a, Reference) -> NeedsCaching Text
|
||||
ifExternalThenCache (_, Reference{..}) =
|
||||
if isExternal rInfo
|
||||
then CacheUnderKey rLink
|
||||
else NoCaching
|
||||
case rInfo of
|
||||
RIExternal (ELUrl url) ->
|
||||
CacheUnderKey url
|
||||
_ ->
|
||||
NoCaching
|
||||
|
||||
shouldCheckLocType :: VerifyMode -> ReferenceInfo -> Bool
|
||||
shouldCheckLocType mode locType
|
||||
| isExternal locType = shouldCheckExternal mode
|
||||
| isLocal locType = shouldCheckLocal mode
|
||||
| otherwise = False
|
||||
shouldCheckLocType mode rInfo =
|
||||
case rInfo of
|
||||
RIFile _ -> shouldCheckLocal mode
|
||||
RIExternal (ELUrl _) -> shouldCheckExternal mode
|
||||
RIExternal (ELOther _) -> False
|
||||
|
||||
verifyReference
|
||||
:: Config
|
||||
@ -467,7 +472,7 @@ verifyReference
|
||||
-> IORef (S.Set DomainName)
|
||||
-> IORef VerifyProgress
|
||||
-> RepoInfo
|
||||
-> CanonicalPath
|
||||
-> RelPosixLink
|
||||
-> Reference
|
||||
-> IO (VerifyResult $ WithReferenceLoc VerifyError)
|
||||
verifyReference
|
||||
@ -475,29 +480,29 @@ verifyReference
|
||||
mode
|
||||
domainsReturned429Ref
|
||||
progressRef
|
||||
repoInfo@RepoInfo{..}
|
||||
repoInfo
|
||||
file
|
||||
ref@Reference{..}
|
||||
= fmap (fmap addReference . toVerifyRes) $
|
||||
retryVerification (RetryCounter 0 0) $ runExceptT $
|
||||
if shouldCheckLocType mode rInfo
|
||||
then case rInfo of
|
||||
RIFileLocal -> checkRef rAnchor riRoot file ""
|
||||
RIFileRelative -> do
|
||||
let shownFilepath = getPosixRelativeOrAbsoluteChild riRoot (takeDirectory file)
|
||||
</> toString rLink
|
||||
canonicalPath <- liftIO $ takeDirectory file </ toString rLink
|
||||
checkRef rAnchor riRoot canonicalPath shownFilepath
|
||||
RIFileAbsolute -> do
|
||||
let shownFilepath = dropWhile isPathSeparator (toString rLink)
|
||||
canonicalPath <- liftIO $ riRoot </ shownFilepath
|
||||
checkRef rAnchor riRoot canonicalPath shownFilepath
|
||||
RIExternal -> checkExternalResource emptyChain config rLink
|
||||
RIOtherProtocol -> pass
|
||||
RIFile ReferenceInfoFile{..} ->
|
||||
case rifLink of
|
||||
FLLocal ->
|
||||
checkRef rifAnchor file
|
||||
FLRelative link ->
|
||||
checkRef rifAnchor $ takeDirectory file </> link
|
||||
FLAbsolute link ->
|
||||
checkRef rifAnchor link
|
||||
RIExternal (ELUrl url) ->
|
||||
checkExternalResource emptyChain config url
|
||||
RIExternal (ELOther _) ->
|
||||
pass
|
||||
else pass
|
||||
where
|
||||
addReference :: VerifyError -> WithReferenceLoc VerifyError
|
||||
addReference = WithReferenceLoc (getPosixRelativeOrAbsoluteChild riRoot file) ref
|
||||
addReference = WithReferenceLoc file ref
|
||||
|
||||
retryVerification
|
||||
:: RetryCounter
|
||||
@ -507,16 +512,12 @@ verifyReference
|
||||
res <- resIO
|
||||
case res of
|
||||
-- Success
|
||||
Right () -> do
|
||||
modifyProgressRef Nothing $ reportSuccess rLink
|
||||
pure res
|
||||
Right () -> modifyProgressRef Nothing reportSuccess $> res
|
||||
Left err -> do
|
||||
setOfReturned429 <- addDomainIf429 domainsReturned429Ref err
|
||||
case decideWhetherToRetry setOfReturned429 rc err of
|
||||
-- Unfixable
|
||||
Nothing -> do
|
||||
modifyProgressRef Nothing $ reportError rLink
|
||||
pure res
|
||||
Nothing -> modifyProgressRef Nothing reportError $> res
|
||||
-- Fixable, retry
|
||||
Just (mbCurrentRetryAfter, counterModifier) -> do
|
||||
now <- getPOSIXTime <&> posixTimeToTimeSecond
|
||||
@ -531,24 +532,26 @@ verifyReference
|
||||
let currentRetryAfter = fromMaybe (ncDefaultRetryAfter cNetworking) $
|
||||
fmap toSeconds mbCurrentRetryAfter
|
||||
|
||||
modifyProgressRef (Just (now, currentRetryAfter)) $ reportRetry rLink
|
||||
modifyProgressRef (Just (now, currentRetryAfter)) reportRetry
|
||||
threadDelay currentRetryAfter
|
||||
retryVerification
|
||||
(counterModifier rc)
|
||||
resIO
|
||||
retryVerification (counterModifier rc) resIO
|
||||
|
||||
modifyProgressRef :: Maybe (Time Second, Time Second) -> (Progress Int Text -> Progress Int Text) -> IO ()
|
||||
modifyProgressRef
|
||||
:: Maybe (Time Second, Time Second)
|
||||
-> (forall w. Ord w => w -> Progress Int w -> Progress Int w)
|
||||
-> IO ()
|
||||
modifyProgressRef mbRetryData moveProgress = atomicModifyIORef' progressRef $ \VerifyProgress{..} ->
|
||||
( if isExternal rInfo
|
||||
then VerifyProgress{ vrExternal =
|
||||
let vrExternalAdvanced = moveProgress vrExternal
|
||||
in case mbRetryData of
|
||||
Just (now, retryAfter) -> case getTaskTimestamp rLink vrExternal of
|
||||
Just (TaskTimestamp ttc start)
|
||||
| retryAfter +:+ now <= ttc +:+ start -> vrExternalAdvanced
|
||||
_ -> setTaskTimestamp rLink retryAfter now vrExternalAdvanced
|
||||
Nothing -> vrExternalAdvanced, .. }
|
||||
else VerifyProgress{ vrLocal = moveProgress vrLocal, .. }
|
||||
( case rInfo of
|
||||
RIFile _ -> VerifyProgress{ vrLocal = moveProgress () vrLocal, .. }
|
||||
RIExternal (ELOther _) -> VerifyProgress{ vrLocal = moveProgress () vrLocal, .. }
|
||||
RIExternal (ELUrl url) -> VerifyProgress{ vrExternal =
|
||||
let vrExternalAdvanced = moveProgress url vrExternal
|
||||
in case mbRetryData of
|
||||
Just (now, retryAfter) -> case getTaskTimestamp vrExternal of
|
||||
Just (TaskTimestamp ttc start)
|
||||
| retryAfter +:+ now <= ttc +:+ start -> vrExternalAdvanced
|
||||
_ -> setTaskTimestamp url retryAfter now vrExternalAdvanced
|
||||
Nothing -> vrExternalAdvanced, .. }
|
||||
, ()
|
||||
)
|
||||
|
||||
@ -585,32 +588,22 @@ verifyReference
|
||||
totalRetriesNotExceeded = rcTotalRetries rc < ncMaxRetries cNetworking
|
||||
timeoutRetriesNotExceeded = rcTimeoutRetries rc < ncMaxTimeoutRetries cNetworking
|
||||
|
||||
isVirtual canonicalRoot = matchesGlobPatterns canonicalRoot (ecIgnoreLocalRefsTo cExclusions)
|
||||
isVirtual = matchesGlobPatterns (ecIgnoreLocalRefsTo cExclusions)
|
||||
|
||||
-- Checks a local file reference.
|
||||
--
|
||||
-- The `shownFilepath` argument is intended to be shown in the error
|
||||
-- report when the `referredFile` path is not a child of `canonicalRoot`,
|
||||
-- so it allows indirections and should be suitable for being shown to
|
||||
-- the user. Also, it will be considered as outside the repository if
|
||||
-- it is relative and its idirections pass through the repository root.
|
||||
checkRef :: Maybe Text -> CanonicalPath -> CanonicalPath -> FilePath -> ExceptT VerifyError IO ()
|
||||
checkRef mAnchor canonicalRoot referredFile shownFilepath =
|
||||
unless (isVirtual canonicalRoot referredFile) do
|
||||
when (hasIndirectionThroughParent shownFilepath) $
|
||||
throwError $ LocalFileOutsideRepo shownFilepath
|
||||
checkRef :: Maybe Text -> RelPosixLink -> ExceptT VerifyError IO ()
|
||||
checkRef mAnchor referredFile = do
|
||||
let canonicalFile = canonicalizeRelPosixLink referredFile
|
||||
unless (isVirtual canonicalFile) do
|
||||
when (hasUnexpanededParentIndirections canonicalFile) $
|
||||
throwError $ LocalFileOutsideRepo referredFile
|
||||
|
||||
referredFileRelative <-
|
||||
case getPosixRelativeChild canonicalRoot referredFile of
|
||||
Just ps -> pure ps
|
||||
Nothing -> throwError (LocalFileOutsideRepo shownFilepath)
|
||||
|
||||
mFileStatus <- tryGetFileStatus referredFileRelative referredFile
|
||||
mFileStatus <- tryGetFileStatus referredFile
|
||||
case mFileStatus of
|
||||
Right (Scanned referredFileInfo) -> whenJust mAnchor $
|
||||
checkAnchor referredFileRelative (_fiAnchors referredFileInfo)
|
||||
Right NotAddedToGit -> throwError (LinkTargetNotAddedToGit referredFileRelative)
|
||||
Left UntrackedDirectory -> throwError (LinkTargetNotAddedToGit referredFileRelative)
|
||||
checkAnchor referredFile (_fiAnchors referredFileInfo)
|
||||
Right NotAddedToGit -> throwError (LinkTargetNotAddedToGit referredFile)
|
||||
Left UntrackedDirectory -> throwError (LinkTargetNotAddedToGit referredFile)
|
||||
Right NotScannable -> pass -- no support for such file, can do nothing
|
||||
Left TrackedDirectory -> pass -- path leads to directory, currently
|
||||
-- if such link contain anchor, we ignore it
|
||||
@ -618,11 +611,13 @@ verifyReference
|
||||
caseInsensitive = caseInsensitiveAnchors . mcFlavor . scMarkdown $ cScanners
|
||||
|
||||
-- Returns `Nothing` when path corresponds to an existing (and tracked) directory
|
||||
tryGetFileStatus :: FilePath -> CanonicalPath -> ExceptT VerifyError IO (Either DirectoryStatus FileStatus)
|
||||
tryGetFileStatus filePath canonicalPath
|
||||
| Just f <- lookupFile canonicalPath repoInfo = return (Right f)
|
||||
| Just d <- lookupDirectory canonicalPath repoInfo = return (Left d)
|
||||
tryGetFileStatus :: RelPosixLink -> ExceptT VerifyError IO (Either DirectoryStatus FileStatus)
|
||||
tryGetFileStatus filePath
|
||||
| Just f <- lookupFile canonicalFile repoInfo = return (Right f)
|
||||
| Just d <- lookupDirectory canonicalFile repoInfo = return (Left d)
|
||||
| otherwise = throwError (LocalFileDoesNotExist filePath)
|
||||
where
|
||||
canonicalFile = canonicalizeRelPosixLink filePath
|
||||
|
||||
checkAnchor filePath fileAnchors anchor = do
|
||||
checkAnchorReferenceAmbiguity filePath fileAnchors anchor
|
||||
|
@ -12,15 +12,16 @@ import Test.Tasty.HUnit (testCase, (@?=))
|
||||
|
||||
import Test.Xrefcheck.Util
|
||||
import Xrefcheck.Core
|
||||
import Xrefcheck.System
|
||||
|
||||
test_anchorsInHeaders :: TestTree
|
||||
test_anchorsInHeaders = testGroup "Anchors in headers"
|
||||
[ testCase "Check if anchors in headers are recognized" $ do
|
||||
(fi, errs) <- parse GitHub "tests/markdowns/without-annotations/anchors_in_headers.md"
|
||||
(fi, errs) <- parse GitHub "" $ mkRelPosixLink "tests/markdowns/without-annotations/anchors_in_headers.md"
|
||||
getAnchors fi @?= ["some-stuff", "stuff-section"]
|
||||
errs @?= []
|
||||
, testCase "Check if anchors with id attributes are recognized" $ do
|
||||
(fi, errs) <- parse GitHub "tests/markdowns/without-annotations/anchors_in_headers_with_id_attribute.md"
|
||||
(fi, errs) <- parse GitHub "" $ mkRelPosixLink "tests/markdowns/without-annotations/anchors_in_headers_with_id_attribute.md"
|
||||
getAnchors fi @?= ["some-stuff-with-id-attribute", "stuff-section-with-id-attribute"]
|
||||
errs @?= []
|
||||
]
|
||||
|
@ -3,7 +3,7 @@
|
||||
- SPDX-License-Identifier: MPL-2.0
|
||||
-}
|
||||
|
||||
module Test.Xrefcheck.AnchorsSpec (test_anchors) where
|
||||
module Test.Xrefcheck.AnchorsSpec where
|
||||
|
||||
import Universum
|
||||
|
||||
@ -12,6 +12,7 @@ import Test.Tasty.HUnit (testCase, (@?=))
|
||||
|
||||
import Test.Xrefcheck.Util
|
||||
import Xrefcheck.Core
|
||||
import Xrefcheck.System
|
||||
|
||||
checkHeaderConversions :: Flavor -> [(Text, Text)] -> TestTree
|
||||
checkHeaderConversions fl suites =
|
||||
@ -19,7 +20,7 @@ checkHeaderConversions fl suites =
|
||||
[testCase (show a <> " == " <> show b) $ headerToAnchor fl a @?= b | (a,b) <- suites]
|
||||
++
|
||||
[ testCase "Non-stripped header name should be stripped" $ do
|
||||
(fi, errs) <- parse fl "tests/markdowns/without-annotations/non_stripped_spaces.md"
|
||||
(fi, errs) <- parse fl "" $ mkRelPosixLink "tests/markdowns/without-annotations/non_stripped_spaces.md"
|
||||
getAnchors fi @?= [ case fl of GitHub -> "header--with-leading-spaces"
|
||||
GitLab -> "header-with-leading-spaces"
|
||||
, "edge-case"
|
||||
|
@ -1,63 +0,0 @@
|
||||
{- SPDX-FileCopyrightText: 2022 Serokell <https://serokell.io>
|
||||
-
|
||||
- SPDX-License-Identifier: MPL-2.0
|
||||
-}
|
||||
|
||||
module Test.Xrefcheck.CanonicalPathSpec where
|
||||
|
||||
import Universum
|
||||
|
||||
import System.Directory (getCurrentDirectory)
|
||||
import Test.Tasty (TestTree, testGroup)
|
||||
import Test.Tasty.HUnit (testCase, (@?=))
|
||||
|
||||
import Xrefcheck.System
|
||||
|
||||
test_canonicalPath :: IO TestTree
|
||||
test_canonicalPath = do
|
||||
current <- getCurrentDirectory >>= canonicalizePath
|
||||
return $ testGroup "Canonical paths"
|
||||
[ testGroup "Canonicalization"
|
||||
[ testCase "Trailing separator" $ do
|
||||
path <- canonicalizePath "./example/dir/"
|
||||
getPosixRelativeOrAbsoluteChild current path @?= "example/dir"
|
||||
, testCase "Parent directory indirection" $ do
|
||||
path <- canonicalizePath "dir1/../dir2"
|
||||
getPosixRelativeOrAbsoluteChild current path @?= "dir2"
|
||||
, testCase "Through parent directory indirection" $ do
|
||||
path <- canonicalizePath "dir1/../../../dir2"
|
||||
root <- current </ "../.."
|
||||
getPosixRelativeOrAbsoluteChild root path @?= "dir2"
|
||||
, testCase "Current directory indirection" $ do
|
||||
path <- canonicalizePath "././dir1/./././dir2/././"
|
||||
getPosixRelativeOrAbsoluteChild current path @?= "dir1/dir2"
|
||||
, testCase "Mixed indirections result in current directory" $ do
|
||||
path <- canonicalizePath "././dir1/./.././dir2/./../"
|
||||
getPosixRelativeOrAbsoluteChild current path @?= "."
|
||||
]
|
||||
, testGroup "Relative path"
|
||||
[ testCase "Child directory" $ do
|
||||
path <- canonicalizePath "./dir1/dir2/"
|
||||
getPosixRelativeChild current path @?= Just ("dir1/dir2")
|
||||
, testCase "Not a child directory" $ do
|
||||
root <- canonicalizePath "./dir1/dir2/"
|
||||
path <- canonicalizePath "./dir1/dir3/"
|
||||
getPosixRelativeChild root path @?= Nothing
|
||||
]
|
||||
, testGroup "Intermediate directories"
|
||||
[ testCase "No intermediate directories same" $ do
|
||||
path <- canonicalizePath "./dir1/dir3/"
|
||||
getDirsBetweenRootAndFile path path @?= []
|
||||
, testCase "No intermediate directories different" $ do
|
||||
root <- canonicalizePath "./dir1/dir2/"
|
||||
path <- canonicalizePath "./dir1/dir3/"
|
||||
getDirsBetweenRootAndFile root path @?= []
|
||||
, testCase "Intermediate directories" $ do
|
||||
path <- canonicalizePath "./example/dir/other"
|
||||
getPosixRelativeOrAbsoluteChild current <$> getDirsBetweenRootAndFile current path @?=
|
||||
[ "."
|
||||
, "example"
|
||||
, "example/dir"
|
||||
]
|
||||
]
|
||||
]
|
49
tests/Test/Xrefcheck/CanonicalRelPosixLinkSpec.hs
Normal file
49
tests/Test/Xrefcheck/CanonicalRelPosixLinkSpec.hs
Normal file
@ -0,0 +1,49 @@
|
||||
{- SPDX-FileCopyrightText: 2023 Serokell <https://serokell.io>
|
||||
-
|
||||
- SPDX-License-Identifier: MPL-2.0
|
||||
-}
|
||||
|
||||
module Test.Xrefcheck.CanonicalRelPosixLinkSpec where
|
||||
|
||||
import Universum
|
||||
|
||||
import Test.Tasty (TestTree, testGroup)
|
||||
import Test.Tasty.HUnit (testCase, (@?), (@?=))
|
||||
|
||||
import Xrefcheck.System
|
||||
|
||||
test_canonicalRelPosixLink :: TestTree
|
||||
test_canonicalRelPosixLink =
|
||||
testGroup "Canonical relative POSIX links"
|
||||
[ testGroup "Normalization"
|
||||
[ testCase "Trailing separator" $
|
||||
on (@?=) mkCanonicalLink "./example/dir/" "example/dir"
|
||||
, testCase "Parent directory indirection" $
|
||||
on (@?=) mkCanonicalLink "dir1/../dir2" "dir2"
|
||||
, testCase "Through parent directory indirection" $
|
||||
hasUnexpanededParentIndirections (mkCanonicalLink "dir1/../../../dir2") @? "Unexpanded indirections"
|
||||
, testCase "Current directory indirection" $
|
||||
on (@?=) mkCanonicalLink "././dir1/./././dir2/././" "dir1/dir2"
|
||||
, testCase "Mixed indirections result in current directory" $
|
||||
on (@?=) mkCanonicalLink "././dir1/./.././dir2/./../" "."
|
||||
]
|
||||
, testGroup "Intermediate directories"
|
||||
[ testCase "Current directory itself" $
|
||||
on (@?=) (fmap canonicalizeRelPosixLink) (getIntermediateDirs (mkRelPosixLink ".")) $
|
||||
fmap mkRelPosixLink ["."]
|
||||
, testCase "Current directory file" $
|
||||
on (@?=) (fmap canonicalizeRelPosixLink) (getIntermediateDirs (mkRelPosixLink "./file")) $
|
||||
fmap mkRelPosixLink ["."]
|
||||
, testCase "Parent directory itself" $
|
||||
on (@?=) (fmap canonicalizeRelPosixLink) (getIntermediateDirs (mkRelPosixLink "..")) $
|
||||
fmap mkRelPosixLink ["."]
|
||||
, testCase "Parent directory file" $
|
||||
on (@?=) (fmap canonicalizeRelPosixLink) (getIntermediateDirs (mkRelPosixLink "../file")) $
|
||||
fmap mkRelPosixLink [".", ".."]
|
||||
, testCase "Intermediate directories" $
|
||||
on (@?=) (fmap canonicalizeRelPosixLink) (getIntermediateDirs (mkRelPosixLink "./example/dir/file")) $
|
||||
fmap mkRelPosixLink [".", "example", "example/dir"]
|
||||
]
|
||||
]
|
||||
where
|
||||
mkCanonicalLink = canonicalizeRelPosixLink . mkRelPosixLink
|
@ -15,6 +15,7 @@ import Test.Xrefcheck.Util
|
||||
import Xrefcheck.Core
|
||||
import Xrefcheck.Scan
|
||||
import Xrefcheck.Scanners.Markdown
|
||||
import Xrefcheck.System
|
||||
|
||||
test_ignoreAnnotations :: [TestTree]
|
||||
test_ignoreAnnotations =
|
||||
@ -38,23 +39,25 @@ test_ignoreAnnotations =
|
||||
]
|
||||
, testGroup "\"ignore link\" mode"
|
||||
[ testCase "Check \"ignore link\" performance" $ do
|
||||
let file = "tests/markdowns/with-annotations/ignore_link.md"
|
||||
(fi, errs) <- parse GitHub file
|
||||
let file = mkRelPosixLink "tests/markdowns/with-annotations/ignore_link.md"
|
||||
(fi, errs) <- parse GitHub "" file
|
||||
getRefs fi @?=
|
||||
["team", "team", "team", "hire-us", "how-we-work", "privacy", "link2", "link2", "link3"]
|
||||
errs @?= makeError (Just $ PosInfo 42 1 42 31) LinkErr
|
||||
]
|
||||
, testGroup "\"ignore paragraph\" mode"
|
||||
[ testCase "Check \"ignore paragraph\" performance" $ do
|
||||
(fi, errs) <- parse GitHub "tests/markdowns/with-annotations/ignore_paragraph.md"
|
||||
getRefs fi @?= ["blog", "contacts"]
|
||||
errs @?= []
|
||||
let file = mkRelPosixLink "tests/markdowns/with-annotations/ignore_paragraph.md"
|
||||
(fi, errs) <- parse GitHub "" file
|
||||
getRefs fi @?= ["blog", "contacts"]
|
||||
errs @?= []
|
||||
]
|
||||
, testGroup "\"ignore all\" mode"
|
||||
[ testCase "Check \"ignore all\" performance" $ do
|
||||
(fi, errs) <- parse GitHub "tests/markdowns/with-annotations/ignore_file.md"
|
||||
getRefs fi @?= []
|
||||
errs @?= []
|
||||
let file = mkRelPosixLink "tests/markdowns/with-annotations/ignore_file.md"
|
||||
(fi, errs) <- parse GitHub "" file
|
||||
getRefs fi @?= []
|
||||
errs @?= []
|
||||
]
|
||||
]
|
||||
where
|
||||
@ -62,4 +65,4 @@ test_ignoreAnnotations =
|
||||
getRefs fi = map rName $ fi ^. fiReferences
|
||||
|
||||
getErrs :: FilePath -> IO [ScanError 'Parse]
|
||||
getErrs path = snd <$> parse GitHub path
|
||||
getErrs path = snd <$> parse GitHub "" (mkRelPosixLink path)
|
||||
|
@ -78,9 +78,15 @@ test_ignoreRegex = give WithoutColors $
|
||||
pickBrokenLinks :: VerifyResult (WithReferenceLoc VerifyError) -> [Text]
|
||||
pickBrokenLinks verifyRes =
|
||||
case verifyErrors verifyRes of
|
||||
Just neWithRefLoc -> map (rLink . wrlReference) $ toList neWithRefLoc
|
||||
Just neWithRefLoc -> mapMaybe (rUrl . wrlReference) $ toList neWithRefLoc
|
||||
Nothing -> []
|
||||
|
||||
rUrl :: Reference -> Maybe Text
|
||||
rUrl Reference{..} =
|
||||
case rInfo of
|
||||
RIExternal (ELUrl url) -> Just url
|
||||
_ -> Nothing
|
||||
|
||||
linksToRegexs :: [Text] -> [Regex]
|
||||
linksToRegexs links =
|
||||
let errOrRegexs = map (decodeEither' . encodeUtf8) links
|
||||
|
@ -53,11 +53,11 @@ test_tooManyRequests = testGroup "429 response tests"
|
||||
$ initProgress 2
|
||||
}
|
||||
_ <- verifyReferenceWithProgressDefault
|
||||
(Reference "" "http://127.0.0.1:5000/429" Nothing (Position Nothing) RIExternal)
|
||||
(Reference "" (Position Nothing) $ RIExternal $ ELUrl "http://127.0.0.1:5000/429")
|
||||
setRef
|
||||
progressRef
|
||||
progress <- vrExternal <$> readIORef progressRef
|
||||
let ttc = ttTimeToCompletion <$> getTaskTimestamp "" progress
|
||||
let ttc = ttTimeToCompletion <$> getTaskTimestamp progress
|
||||
flip assertBool (ttc == Just (sec 2)) $
|
||||
"Expected time to completion be equal to " ++ show (Just $ sec 2) ++
|
||||
", but instead it's " ++ show ttc
|
||||
@ -76,11 +76,11 @@ test_tooManyRequests = testGroup "429 response tests"
|
||||
$ initProgress 2
|
||||
}
|
||||
_ <- verifyReferenceWithProgressDefault
|
||||
(Reference "" "http://127.0.0.1:5000/429" Nothing (Position Nothing) RIExternal)
|
||||
(Reference "" (Position Nothing) $ RIExternal $ ELUrl "http://127.0.0.1:5000/429")
|
||||
setRef
|
||||
progressRef
|
||||
progress <- vrExternal <$> readIORef progressRef
|
||||
let ttc = fromMaybe (sec 0) $ ttTimeToCompletion <$> getTaskTimestamp "" progress
|
||||
let ttc = fromMaybe (sec 0) $ ttTimeToCompletion <$> getTaskTimestamp progress
|
||||
flip assertBool (sec 3 <= ttc && ttc <= sec 4) $
|
||||
"Expected time to completion be within range (seconds): 3 <= x <= 4" ++
|
||||
", but instead it's " ++ show ttc
|
||||
@ -100,11 +100,11 @@ test_tooManyRequests = testGroup "429 response tests"
|
||||
$ initProgress 2
|
||||
}
|
||||
_ <- verifyReferenceWithProgressDefault
|
||||
(Reference "" "http://127.0.0.1:5000/429" Nothing (Position Nothing) RIExternal)
|
||||
(Reference "" (Position Nothing) $ RIExternal $ ELUrl "http://127.0.0.1:5000/429")
|
||||
setRef
|
||||
progressRef
|
||||
progress <- vrExternal <$> readIORef progressRef
|
||||
let ttc = ttTimeToCompletion <$> getTaskTimestamp "" progress
|
||||
let ttc = ttTimeToCompletion <$> getTaskTimestamp progress
|
||||
flip assertBool (ttc == Just (sec 0)) $
|
||||
"Expected time to completion be 0 seconds" ++
|
||||
", but instead it's " ++ show ttc
|
||||
|
@ -30,11 +30,11 @@ test_slash = testGroup "Trailing forward slash detection" $
|
||||
"\" should exist") $ do
|
||||
(ScanResult _ RepoInfo{..}) <- allowRewrite False $ \rw ->
|
||||
scanRepo OnlyTracked rw format (cExclusions config & ecIgnoreL .~ []) root
|
||||
nonExistentFiles <- lefts <$> forM (fst <$> toPairs riFiles) (\filePath -> do
|
||||
predicate <- doesFileExist . unCanonicalPath $ filePath
|
||||
nonExistentFiles <- lefts <$> forM (fst . snd <$> toPairs riFiles) (\file -> do
|
||||
predicate <- doesFileExist . filePathFromRoot root $ file
|
||||
return $ if predicate
|
||||
then Right ()
|
||||
else Left . unCanonicalPath $ filePath)
|
||||
else Left . filePathFromRoot root $ file)
|
||||
whenJust (nonEmpty nonExistentFiles) $ \files ->
|
||||
assertFailure
|
||||
[int||
|
||||
|
@ -10,15 +10,13 @@ import Universum
|
||||
import Network.HTTP.Types (forbidden403, unauthorized401)
|
||||
import Web.Firefly (ToResponse (..), route, run)
|
||||
|
||||
import Xrefcheck.Core (FileInfo, Flavor)
|
||||
import Xrefcheck.Scan (ScanError, ScanStage (..))
|
||||
import Xrefcheck.Core (Flavor)
|
||||
import Xrefcheck.Scan (ScanAction)
|
||||
import Xrefcheck.Scanners.Markdown (MarkdownConfig (MarkdownConfig, mcFlavor), markdownScanner)
|
||||
import Xrefcheck.System (canonicalizePath)
|
||||
|
||||
parse :: Flavor -> FilePath -> IO (FileInfo, [ScanError 'Parse])
|
||||
parse fl path = do
|
||||
canonicalPath <- canonicalizePath path
|
||||
markdownScanner MarkdownConfig { mcFlavor = fl } canonicalPath
|
||||
parse :: Flavor -> ScanAction
|
||||
parse fl path =
|
||||
markdownScanner MarkdownConfig { mcFlavor = fl } path
|
||||
|
||||
mockServer :: IO ()
|
||||
mockServer = run 3000 $ do
|
||||
|
@ -27,7 +27,7 @@ import Xrefcheck.Config
|
||||
import Xrefcheck.Core
|
||||
import Xrefcheck.Progress
|
||||
import Xrefcheck.Scan
|
||||
import Xrefcheck.System (canonicalizePath)
|
||||
import Xrefcheck.System
|
||||
import Xrefcheck.Util
|
||||
import Xrefcheck.Verify
|
||||
|
||||
@ -97,7 +97,7 @@ verifyLink
|
||||
-> Text
|
||||
-> IO (VerifyResult VerifyError, Progress Int Text)
|
||||
verifyLink configModifier setRef link = do
|
||||
let reference = Reference "" link Nothing (Position Nothing) RIExternal
|
||||
let reference = Reference "" (Position Nothing) $ RIExternal $ ELUrl link
|
||||
progRef <- newIORef $ initVerifyProgress [reference]
|
||||
result <- verifyReferenceWithProgress configModifier reference setRef progRef
|
||||
progress <- readIORef progRef
|
||||
@ -115,13 +115,11 @@ verifyReferenceWithProgress
|
||||
-> IORef (S.Set DomainName)
|
||||
-> IORef VerifyProgress
|
||||
-> IO (VerifyResult VerifyError)
|
||||
verifyReferenceWithProgress configModifier reference setRef progRef = do
|
||||
canonicalRoot <- canonicalizePath "."
|
||||
file <- canonicalizePath ""
|
||||
verifyReferenceWithProgress configModifier reference setRef progRef =
|
||||
fmap wrlItem <$> verifyReference
|
||||
(defConfig GitHub & cExclusionsL . ecIgnoreExternalRefsToL .~ []
|
||||
& configModifier)
|
||||
FullMode setRef progRef (RepoInfo M.empty mempty canonicalRoot) file reference
|
||||
FullMode setRef progRef (RepoInfo M.empty mempty) (mkRelPosixLink "") reference
|
||||
|
||||
verifyReferenceWithProgressDefault
|
||||
:: Reference
|
||||
|
@ -17,7 +17,6 @@ assert_diff - <<EOF
|
||||
➥ In file a.md
|
||||
bad reference (file-local) at src:16:1-43:
|
||||
- text: "ambiguous anchor in this file"
|
||||
- link: -
|
||||
- anchor: some-text
|
||||
|
||||
Ambiguous reference to anchor 'some-text'
|
||||
@ -56,7 +55,6 @@ assert_diff - <<EOF
|
||||
➥ In file a.md
|
||||
bad reference (file-local) at src:12:1-13:
|
||||
- text: "broken"
|
||||
- link: -
|
||||
- anchor: h3
|
||||
|
||||
Anchor 'h3' is not present, did you mean:
|
||||
@ -66,7 +64,6 @@ assert_diff - <<EOF
|
||||
➥ In file a.md
|
||||
bad reference (file-local) at src:14:1-18:
|
||||
- text: "broken"
|
||||
- link: -
|
||||
- anchor: heading
|
||||
|
||||
Anchor 'heading' is not present, did you mean:
|
||||
@ -75,7 +72,6 @@ assert_diff - <<EOF
|
||||
➥ In file a.md
|
||||
bad reference (file-local) at src:16:1-31:
|
||||
- text: "broken"
|
||||
- link: -
|
||||
- anchor: really-unique-anchor
|
||||
|
||||
Anchor 'really-unique-anchor' is not present
|
||||
|
@ -19,11 +19,9 @@ assert_diff - <<EOF
|
||||
- reference (external) :
|
||||
- text: "https://www.google.com/doodles"
|
||||
- link: https://www.google.com/doodles
|
||||
- anchor: -
|
||||
- reference (external) at src:8:0-18:
|
||||
- text: "www.commonmark.org"
|
||||
- link: http://www.commonmark.org
|
||||
- anchor: -
|
||||
- anchors:
|
||||
none
|
||||
|
||||
@ -33,7 +31,6 @@ assert_diff - <<EOF
|
||||
bad reference (external) at src:8:0-18:
|
||||
- text: "www.commonmark.org"
|
||||
- link: http://www.commonmark.org
|
||||
- anchor: -
|
||||
|
||||
Permanent redirect found:
|
||||
-| http://www.commonmark.org
|
||||
|
10
tests/golden/check-backslash/a.md
Normal file
10
tests/golden/check-backslash/a.md
Normal file
@ -0,0 +1,10 @@
|
||||
<!--
|
||||
- SPDX-FileCopyrightText: 2023 Serokell <https://serokell.io>
|
||||
-
|
||||
- SPDX-License-Identifier: MPL-2.0
|
||||
-->
|
||||
# Header
|
||||
|
||||
[Reference to a\a](a\a.md#header)
|
||||
|
||||
[Bad reference to a\b](a\b.md)
|
33
tests/golden/check-backslash/check-backslash.bats
Normal file
33
tests/golden/check-backslash/check-backslash.bats
Normal file
@ -0,0 +1,33 @@
|
||||
#!/usr/bin/env bats
|
||||
|
||||
# SPDX-FileCopyrightText: 2023 Serokell <https://serokell.io>
|
||||
#
|
||||
# SPDX-License-Identifier: MPL-2.0
|
||||
|
||||
load '../helpers/bats-support/load'
|
||||
load '../helpers/bats-assert/load'
|
||||
load '../helpers/bats-file/load'
|
||||
load '../helpers'
|
||||
|
||||
|
||||
@test "Checking files with backslash" {
|
||||
cp a.md $TEST_TEMP_DIR
|
||||
cp expected.gold $TEST_TEMP_DIR
|
||||
touch "$TEST_TEMP_DIR/a\a.md" || \
|
||||
return 0 # Cannot be tested on Windows
|
||||
|
||||
cat <<EOF > "$TEST_TEMP_DIR/a\a.md"
|
||||
# Header
|
||||
[Reference to a](a.md)
|
||||
[Reference to myself](a\a.md)
|
||||
EOF
|
||||
|
||||
cd $TEST_TEMP_DIR
|
||||
git init
|
||||
git add a.md
|
||||
git add "a\a.md"
|
||||
|
||||
to_temp xrefcheck -v
|
||||
|
||||
assert_diff expected.gold
|
||||
}
|
41
tests/golden/check-backslash/expected.gold
Normal file
41
tests/golden/check-backslash/expected.gold
Normal file
@ -0,0 +1,41 @@
|
||||
=== Repository data ===
|
||||
|
||||
a.md:
|
||||
- references:
|
||||
- reference (relative) at src:8:1-33:
|
||||
- text: "Reference to a\\a"
|
||||
- link: a\a.md
|
||||
- anchor: header
|
||||
- reference (relative) at src:10:1-30:
|
||||
- text: "Bad reference to a\\b"
|
||||
- link: a\b.md
|
||||
- anchor: -
|
||||
- anchors:
|
||||
- header (header I) at src:6:1-8
|
||||
|
||||
a\a.md:
|
||||
- references:
|
||||
- reference (relative) at src:2:1-22:
|
||||
- text: "Reference to a"
|
||||
- link: a.md
|
||||
- anchor: -
|
||||
- reference (relative) at src:3:1-29:
|
||||
- text: "Reference to myself"
|
||||
- link: a\a.md
|
||||
- anchor: -
|
||||
- anchors:
|
||||
- header (header I) at src:1:1-8
|
||||
|
||||
=== Invalid references found ===
|
||||
|
||||
➥ In file a.md
|
||||
bad reference (relative) at src:10:1-30:
|
||||
- text: "Bad reference to a\\b"
|
||||
- link: a\b.md
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
a\b.md
|
||||
Its reference contains a backslash. Maybe it uses the wrong path separator.
|
||||
|
||||
Invalid references dumped, 1 in total.
|
@ -21,4 +21,4 @@ Some text
|
||||
|
||||
[Reference lowered](#uppercase-name)
|
||||
|
||||
[Maybe ambiguous reference](#another-header)
|
||||
[Maybe ambiguous reference](#another-header)
|
@ -3,7 +3,6 @@
|
||||
➥ In file a.md
|
||||
bad reference (file-local) at src:18:1-36:
|
||||
- text: "Mixing case reference"
|
||||
- link: -
|
||||
- anchor: SomE-HEADr
|
||||
|
||||
Anchor 'SomE-HEADr' is not present, did you mean:
|
||||
@ -16,7 +15,6 @@
|
||||
➥ In file a.md
|
||||
bad reference (file-local) at src:24:1-44:
|
||||
- text: "Maybe ambiguous reference"
|
||||
- link: -
|
||||
- anchor: another-header
|
||||
|
||||
Ambiguous reference to anchor 'another-header'
|
@ -3,7 +3,6 @@
|
||||
➥ In file a.md
|
||||
bad reference (file-local) at src:16:1-37:
|
||||
- text: "Mixing case reference"
|
||||
- link: -
|
||||
- anchor: SomE-HEADer
|
||||
|
||||
Anchor 'SomE-HEADer' is not present, did you mean:
|
||||
@ -16,7 +15,6 @@
|
||||
➥ In file a.md
|
||||
bad reference (file-local) at src:18:1-36:
|
||||
- text: "Mixing case reference"
|
||||
- link: -
|
||||
- anchor: SomE-HEADr
|
||||
|
||||
Anchor 'SomE-HEADr' is not present, did you mean:
|
||||
@ -29,7 +27,6 @@
|
||||
➥ In file a.md
|
||||
bad reference (file-local) at src:22:1-36:
|
||||
- text: "Reference lowered"
|
||||
- link: -
|
||||
- anchor: uppercase-name
|
||||
|
||||
Anchor 'uppercase-name' is not present, did you mean:
|
16
tests/golden/check-case-sensitivity-path/a.md
Normal file
16
tests/golden/check-case-sensitivity-path/a.md
Normal file
@ -0,0 +1,16 @@
|
||||
<!--
|
||||
- SPDX-FileCopyrightText: 2023 Serokell <https://serokell.io>
|
||||
-
|
||||
- SPDX-License-Identifier: MPL-2.0
|
||||
-->
|
||||
# Header
|
||||
|
||||
* [a](a.md)
|
||||
* [Header a](dir/b.md#header)
|
||||
* [b](dir/b.md)
|
||||
* [Header b](dir/b.md#header)
|
||||
* [Wrong a](A.md)
|
||||
* [Wrong a extension](a.Md)
|
||||
* [Wrong b](dir/B.md)
|
||||
* [Wrong b dir](/dIr/b.md)
|
||||
* [Wrong b extension](/dir/b.mD)
|
@ -0,0 +1,23 @@
|
||||
#!/usr/bin/env bats
|
||||
|
||||
# SPDX-FileCopyrightText: 2023 Serokell <https://serokell.io>
|
||||
#
|
||||
# SPDX-License-Identifier: MPL-2.0
|
||||
|
||||
load '../helpers/bats-support/load'
|
||||
load '../helpers/bats-assert/load'
|
||||
load '../helpers/bats-file/load'
|
||||
load '../helpers'
|
||||
|
||||
|
||||
@test "GitHub paths: case-sensitive" {
|
||||
to_temp xrefcheck -v -c config-github.yaml
|
||||
|
||||
assert_diff expected.gold
|
||||
}
|
||||
|
||||
@test "GitLab paths: case-sensitive" {
|
||||
to_temp xrefcheck -v -c config-gitlab.yaml
|
||||
|
||||
assert_diff expected.gold
|
||||
}
|
@ -0,0 +1,7 @@
|
||||
# SPDX-FileCopyrightText: 2023 Serokell <https://serokell.io>
|
||||
#
|
||||
# SPDX-License-Identifier: Unlicense
|
||||
|
||||
scanners:
|
||||
markdown:
|
||||
flavor: GitHub
|
@ -0,0 +1,7 @@
|
||||
# SPDX-FileCopyrightText: 2023 Serokell <https://serokell.io>
|
||||
#
|
||||
# SPDX-License-Identifier: Unlicense
|
||||
|
||||
scanners:
|
||||
markdown:
|
||||
flavor: GitLab
|
11
tests/golden/check-case-sensitivity-path/dir/b.md
Normal file
11
tests/golden/check-case-sensitivity-path/dir/b.md
Normal file
@ -0,0 +1,11 @@
|
||||
<!--
|
||||
- SPDX-FileCopyrightText: 2023 Serokell <https://serokell.io>
|
||||
-
|
||||
- SPDX-License-Identifier: MPL-2.0
|
||||
-->
|
||||
# Header
|
||||
|
||||
* [Right a](../a.md)
|
||||
* [Right b](./b.md)
|
||||
* [Wrong a](../A.md)
|
||||
* [Wrong b](./B.md)
|
130
tests/golden/check-case-sensitivity-path/expected.gold
Normal file
130
tests/golden/check-case-sensitivity-path/expected.gold
Normal file
@ -0,0 +1,130 @@
|
||||
=== Repository data ===
|
||||
|
||||
a.md:
|
||||
- references:
|
||||
- reference (relative) at src:8:3-11:
|
||||
- text: "a"
|
||||
- link: a.md
|
||||
- anchor: -
|
||||
- reference (relative) at src:9:3-29:
|
||||
- text: "Header a"
|
||||
- link: dir/b.md
|
||||
- anchor: header
|
||||
- reference (relative) at src:10:3-15:
|
||||
- text: "b"
|
||||
- link: dir/b.md
|
||||
- anchor: -
|
||||
- reference (relative) at src:11:3-29:
|
||||
- text: "Header b"
|
||||
- link: dir/b.md
|
||||
- anchor: header
|
||||
- reference (relative) at src:12:3-17:
|
||||
- text: "Wrong a"
|
||||
- link: A.md
|
||||
- anchor: -
|
||||
- reference (relative) at src:13:3-27:
|
||||
- text: "Wrong a extension"
|
||||
- link: a.Md
|
||||
- anchor: -
|
||||
- reference (relative) at src:14:3-21:
|
||||
- text: "Wrong b"
|
||||
- link: dir/B.md
|
||||
- anchor: -
|
||||
- reference (absolute) at src:15:3-26:
|
||||
- text: "Wrong b dir"
|
||||
- link: /dIr/b.md
|
||||
- anchor: -
|
||||
- reference (absolute) at src:16:3-32:
|
||||
- text: "Wrong b extension"
|
||||
- link: /dir/b.mD
|
||||
- anchor: -
|
||||
- anchors:
|
||||
- header (header I) at src:6:1-8
|
||||
|
||||
dir/b.md:
|
||||
- references:
|
||||
- reference (relative) at src:8:3-20:
|
||||
- text: "Right a"
|
||||
- link: ../a.md
|
||||
- anchor: -
|
||||
- reference (relative) at src:9:3-19:
|
||||
- text: "Right b"
|
||||
- link: ./b.md
|
||||
- anchor: -
|
||||
- reference (relative) at src:10:3-20:
|
||||
- text: "Wrong a"
|
||||
- link: ../A.md
|
||||
- anchor: -
|
||||
- reference (relative) at src:11:3-19:
|
||||
- text: "Wrong b"
|
||||
- link: ./B.md
|
||||
- anchor: -
|
||||
- anchors:
|
||||
- header (header I) at src:6:1-8
|
||||
|
||||
=== Invalid references found ===
|
||||
|
||||
➥ In file a.md
|
||||
bad reference (relative) at src:12:3-17:
|
||||
- text: "Wrong a"
|
||||
- link: A.md
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
A.md
|
||||
|
||||
➥ In file a.md
|
||||
bad reference (relative) at src:13:3-27:
|
||||
- text: "Wrong a extension"
|
||||
- link: a.Md
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
a.Md
|
||||
|
||||
➥ In file a.md
|
||||
bad reference (relative) at src:14:3-21:
|
||||
- text: "Wrong b"
|
||||
- link: dir/B.md
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
dir/B.md
|
||||
|
||||
➥ In file a.md
|
||||
bad reference (absolute) at src:15:3-26:
|
||||
- text: "Wrong b dir"
|
||||
- link: /dIr/b.md
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
dIr/b.md
|
||||
|
||||
➥ In file a.md
|
||||
bad reference (absolute) at src:16:3-32:
|
||||
- text: "Wrong b extension"
|
||||
- link: /dir/b.mD
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
dir/b.mD
|
||||
|
||||
➥ In file dir/b.md
|
||||
bad reference (relative) at src:10:3-20:
|
||||
- text: "Wrong a"
|
||||
- link: ../A.md
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
dir/../A.md
|
||||
|
||||
➥ In file dir/b.md
|
||||
bad reference (relative) at src:11:3-19:
|
||||
- text: "Wrong b"
|
||||
- link: ./B.md
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
dir/./B.md
|
||||
|
||||
Invalid references dumped, 7 in total.
|
@ -4,7 +4,6 @@
|
||||
- references:
|
||||
- reference ([92mfile-local[0m) [2mat src:9:1-15[0m:
|
||||
- text: "Color"
|
||||
- link: -
|
||||
- anchor: Color
|
||||
- anchors:
|
||||
- color ([2m[92mheader I[0m[0m) [2mat src:7:1-7[0m
|
||||
|
@ -4,7 +4,6 @@
|
||||
- references:
|
||||
- reference (file-local) at src:9:1-15:
|
||||
- text: "Color"
|
||||
- link: -
|
||||
- anchor: Color
|
||||
- anchors:
|
||||
- color (header I) at src:7:1-7
|
||||
|
@ -7,6 +7,6 @@
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
notExists
|
||||
./notExists
|
||||
|
||||
Invalid references dumped, 1 in total.
|
||||
|
@ -56,7 +56,7 @@ load '../helpers'
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
a.md
|
||||
./a.md
|
||||
|
||||
Invalid references dumped, 1 in total.
|
||||
EOF
|
||||
@ -83,7 +83,7 @@ EOF
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
a.md
|
||||
./a.md
|
||||
|
||||
Invalid references dumped, 1 in total.
|
||||
EOF
|
||||
@ -113,7 +113,7 @@ EOF
|
||||
- anchor: -
|
||||
|
||||
Link target is not tracked by Git:
|
||||
a.md
|
||||
./a.md
|
||||
Please run "git add" before running xrefcheck or enable --include-untracked CLI option.
|
||||
|
||||
Invalid references dumped, 1 in total.
|
||||
|
@ -4,7 +4,6 @@
|
||||
bad reference (external) at src:7:10-53:
|
||||
- text: "web-site"
|
||||
- link: https://localhost:20000/web-site
|
||||
- anchor: -
|
||||
|
||||
InternalException (HostCannotConnect "localhost" [Network.Socket.connect: <socket: N>: does not exist (Connection refused)])
|
||||
|
||||
@ -12,7 +11,6 @@
|
||||
bad reference (external) at src:9:10-45:
|
||||
- text: "team"
|
||||
- link: https://127.0.0.1:20000/team
|
||||
- anchor: -
|
||||
|
||||
InternalException (HostCannotConnect "127.0.0.1" [Network.Socket.connect: <socket: N>: does not exist (Connection refused)])
|
||||
|
||||
@ -20,7 +18,6 @@
|
||||
bad reference (external) at src:11:10-44:
|
||||
- text: "blog"
|
||||
- link: http://localhost:20000/blog
|
||||
- anchor: -
|
||||
|
||||
ConnectionFailure Network.Socket.connect: <socket: N>: does not exist (Connection refused)
|
||||
|
||||
@ -28,7 +25,6 @@
|
||||
bad reference (external) at src:13:10-44:
|
||||
- text: "labs"
|
||||
- link: http://127.0.0.1:20000/labs
|
||||
- anchor: -
|
||||
|
||||
ConnectionFailure Network.Socket.connect: <socket: N>: does not exist (Connection refused)
|
||||
|
||||
|
@ -4,7 +4,6 @@
|
||||
bad reference (external) at src:7:10-53:
|
||||
- text: "web-site"
|
||||
- link: https://localhost:20000/web-site
|
||||
- anchor: -
|
||||
|
||||
InternalException (HostCannotConnect "localhost" [Network.Socket.connect: <socket: N>: failed (Connection refused (WSAECONNREFUSED)),Network.Socket.connect: <socket: N>: failed (Connection refused (WSAECONNREFUSED))])
|
||||
|
||||
@ -12,7 +11,6 @@
|
||||
bad reference (external) at src:9:10-45:
|
||||
- text: "team"
|
||||
- link: https://127.0.0.1:20000/team
|
||||
- anchor: -
|
||||
|
||||
InternalException (HostCannotConnect "127.0.0.1" [Network.Socket.connect: <socket: N>: failed (Connection refused (WSAECONNREFUSED))])
|
||||
|
||||
@ -20,7 +18,6 @@
|
||||
bad reference (external) at src:11:10-44:
|
||||
- text: "blog"
|
||||
- link: http://localhost:20000/blog
|
||||
- anchor: -
|
||||
|
||||
ConnectionFailure Network.Socket.connect: <socket: N>: failed (Connection refused (WSAECONNREFUSED))
|
||||
|
||||
@ -28,7 +25,6 @@
|
||||
bad reference (external) at src:13:10-44:
|
||||
- text: "labs"
|
||||
- link: http://127.0.0.1:20000/labs
|
||||
- anchor: -
|
||||
|
||||
ConnectionFailure Network.Socket.connect: <socket: N>: failed (Connection refused (WSAECONNREFUSED))
|
||||
|
||||
|
@ -52,7 +52,7 @@
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
one/a.md
|
||||
one/./a.md
|
||||
|
||||
➥ In file one/file.md
|
||||
bad reference (relative) at src:9:1-23:
|
||||
@ -61,6 +61,6 @@
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
two/b.md
|
||||
one/../two/b.md
|
||||
|
||||
Invalid references dumped, 7 in total.
|
||||
|
@ -5,19 +5,15 @@
|
||||
- reference (external) at src:7:1-76:
|
||||
- text: "good image ref 1"
|
||||
- link: https://avatars.githubusercontent.com/u/13840520
|
||||
- anchor: -
|
||||
- reference (external) at src:9:1-35:
|
||||
- text: "good image ref 2"
|
||||
- link: https://avatars.githubusercontent.com/u/13840520
|
||||
- anchor: -
|
||||
- reference (external) at src:14:1-52:
|
||||
- text: "bad image ref 1"
|
||||
- link: https://serokell.io/1.png
|
||||
- anchor: -
|
||||
- reference (external) at src:16:1-33:
|
||||
- text: "bad image ref 2"
|
||||
- link: https://serokell.io/2.png
|
||||
- anchor: -
|
||||
- reference (relative) at src:20:1-34:
|
||||
- text: "bad image ref 3"
|
||||
- link: ./3.png
|
||||
@ -35,7 +31,6 @@
|
||||
bad reference (external) at src:14:1-52:
|
||||
- text: "bad image ref 1"
|
||||
- link: https://serokell.io/1.png
|
||||
- anchor: -
|
||||
|
||||
Resource unavailable (404 Not Found)
|
||||
|
||||
@ -43,7 +38,6 @@
|
||||
bad reference (external) at src:16:1-33:
|
||||
- text: "bad image ref 2"
|
||||
- link: https://serokell.io/2.png
|
||||
- anchor: -
|
||||
|
||||
Resource unavailable (404 Not Found)
|
||||
|
||||
@ -54,7 +48,7 @@
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
3.png
|
||||
./3.png
|
||||
|
||||
➥ In file check-images.md
|
||||
bad reference (relative) at src:21:1-33:
|
||||
@ -63,6 +57,6 @@
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
4.png
|
||||
./4.png
|
||||
|
||||
Invalid references dumped, 4 in total.
|
||||
|
@ -3,7 +3,6 @@
|
||||
➥ In file dir1/dir2/d2f1.md
|
||||
bad reference (file-local) at src:9:1-18:
|
||||
- text: "bad-cf-ref"
|
||||
- link: -
|
||||
- anchor: bad
|
||||
|
||||
Anchor 'bad' is not present
|
||||
@ -15,7 +14,7 @@
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
dir1/a/b/c/unexisting-file.md
|
||||
dir1/dir2/../a/b/c/unexisting-file.md
|
||||
|
||||
➥ In file dir1/dir2/d2f1.md
|
||||
bad reference (relative) at src:28:1-31:
|
||||
@ -24,7 +23,7 @@
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
dir1/dir2/D2F2.md
|
||||
dir1/dir2/D2F2.md/
|
||||
|
||||
➥ In file dir1/dir2/d2f1.md
|
||||
bad reference (relative) at src:29:1-32:
|
||||
@ -33,7 +32,7 @@
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
dir1/DIR2
|
||||
dir1/dir2/../DIR2
|
||||
|
||||
➥ In file dir1/dir2/d2f1.md
|
||||
bad reference (relative) at src:31:1-38:
|
||||
@ -77,7 +76,7 @@
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
d1f1.md
|
||||
./dir2/../d1f1.md
|
||||
|
||||
➥ In file dir1/dir2/d2f1.md
|
||||
bad reference (absolute) at src:45:1-37:
|
||||
@ -86,7 +85,7 @@
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
d1f1.md
|
||||
./dir2/../d1f1.md/
|
||||
|
||||
➥ In file dir1/dir2/d2f1.md
|
||||
bad reference (absolute) at src:46:1-55:
|
||||
@ -95,7 +94,7 @@
|
||||
- anchor: existing-anchor-d1f1
|
||||
|
||||
File does not exist:
|
||||
d1f1.md
|
||||
./dir2/../d1f1.md
|
||||
|
||||
➥ In file dir1/dir2/d2f1.md
|
||||
bad reference (absolute) at src:57:1-16:
|
||||
|
@ -3,7 +3,6 @@
|
||||
➥ In file dir2/d2f1.md
|
||||
bad reference (file-local) at src:9:1-18:
|
||||
- text: "bad-cf-ref"
|
||||
- link: -
|
||||
- anchor: bad
|
||||
|
||||
Anchor 'bad' is not present
|
||||
@ -15,7 +14,7 @@
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
a/b/c/unexisting-file.md
|
||||
dir2/../a/b/c/unexisting-file.md
|
||||
|
||||
➥ In file dir2/d2f1.md
|
||||
bad reference (relative) at src:28:1-31:
|
||||
@ -24,7 +23,7 @@
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
dir2/D2F2.md
|
||||
dir2/D2F2.md/
|
||||
|
||||
➥ In file dir2/d2f1.md
|
||||
bad reference (relative) at src:29:1-32:
|
||||
@ -33,7 +32,7 @@
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
DIR2
|
||||
dir2/../DIR2
|
||||
|
||||
➥ In file dir2/d2f1.md
|
||||
bad reference (relative) at src:31:1-38:
|
||||
@ -59,7 +58,7 @@
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
dir1/d1f1.md
|
||||
dir1/./d1f1.md
|
||||
|
||||
➥ In file dir2/d2f1.md
|
||||
bad reference (absolute) at src:37:1-21:
|
||||
@ -77,7 +76,7 @@
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
dir1
|
||||
dir1/dir2/../
|
||||
|
||||
➥ In file dir2/d2f1.md
|
||||
bad reference (absolute) at src:39:1-58:
|
||||
@ -86,7 +85,7 @@
|
||||
- anchor: existing-anchor-d1f1
|
||||
|
||||
File does not exist:
|
||||
dir1/d1f1.md
|
||||
dir1/../dir1/d1f1.md
|
||||
|
||||
➥ In file dir2/d2f1.md
|
||||
bad reference (absolute) at src:40:1-73:
|
||||
@ -95,7 +94,7 @@
|
||||
- anchor: existing-anchor-d2f2
|
||||
|
||||
File does not exist:
|
||||
dir1/dir2/d2f2.md
|
||||
dir1/dir2/../../dir1/./dir2/d2f2.md
|
||||
|
||||
➥ In file dir2/d2f1.md
|
||||
bad reference (relative) at src:51:1-42:
|
||||
|
@ -3,7 +3,6 @@
|
||||
➥ In file dir2/d2f1.md
|
||||
bad reference (file-local) at src:9:1-18:
|
||||
- text: "bad-cf-ref"
|
||||
- link: -
|
||||
- anchor: bad
|
||||
|
||||
Anchor 'bad' is not present
|
||||
@ -15,7 +14,7 @@
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
a/b/c/unexisting-file.md
|
||||
dir2/../a/b/c/unexisting-file.md
|
||||
|
||||
➥ In file dir2/d2f1.md
|
||||
bad reference (relative) at src:28:1-31:
|
||||
@ -24,7 +23,7 @@
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
dir2/D2F2.md
|
||||
dir2/D2F2.md/
|
||||
|
||||
➥ In file dir2/d2f1.md
|
||||
bad reference (relative) at src:31:1-38:
|
||||
@ -50,7 +49,7 @@
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
dir1/d1f1.md
|
||||
dir1/./d1f1.md
|
||||
|
||||
➥ In file dir2/d2f1.md
|
||||
bad reference (absolute) at src:37:1-21:
|
||||
@ -68,7 +67,7 @@
|
||||
- anchor: -
|
||||
|
||||
File does not exist:
|
||||
dir1
|
||||
dir1/dir2/../
|
||||
|
||||
➥ In file dir2/d2f1.md
|
||||
bad reference (absolute) at src:39:1-58:
|
||||
@ -77,7 +76,7 @@
|
||||
- anchor: existing-anchor-d1f1
|
||||
|
||||
File does not exist:
|
||||
dir1/d1f1.md
|
||||
dir1/../dir1/d1f1.md
|
||||
|
||||
➥ In file dir2/d2f1.md
|
||||
bad reference (absolute) at src:40:1-73:
|
||||
@ -86,7 +85,7 @@
|
||||
- anchor: existing-anchor-d2f2
|
||||
|
||||
File does not exist:
|
||||
dir1/dir2/d2f2.md
|
||||
dir1/dir2/../../dir1/./dir2/d2f2.md
|
||||
|
||||
➥ In file dir2/d2f1.md
|
||||
bad reference (relative) at src:51:1-42:
|
||||
|
Loading…
Reference in New Issue
Block a user