serokell/xrefcheck
1
1
Fork 0
mirror of https://github.com/serokell/xrefcheck.git synced 2024-09-11 13:37:36 +03:00
Code Issues Projects Releases Wiki Activity

[#239][#249] Further filepath refactor

Browse Source 
Problem: After refactoring the FilePath usages in the codebase to have a
canonical representation of them, we noticed that further improvements
could be applied, such as clarifying whether the path is system
dependent and avoiding absolute file system paths.

Solution: We now use POSIX relative paths during the analysis, and
system dependent ones for reading file contents in the scan phase.
This commit is contained in:
Adrián Enríquez 2023-01-09 12:28:07 +01:00
parent 747c884bef
commit eea6118476
No known key found for this signature in database
GPG Key ID: 1D2A049F5866F977
32 changed files with 520 additions and 512 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Xrefcheck/CLI.hs
View File

@ -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 ->

188
src/Xrefcheck/Core.hs
View File

@ -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{..} =

15
src/Xrefcheck/Progress.hs
View File

@ -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

91
src/Xrefcheck/Scan.hs
View File

@ -40,7 +40,7 @@ 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 +56,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 +72,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 +99,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 +112,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 +177,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 . L.lines <$> getFiles
traverse scanFile $ filter (not . isIgnored) relativeFiles
where
@ -193,37 +192,40 @@ readDirectoryWith mode config scanner root = do
RdmBothTrackedAndUtracked -> liftA2 (<>) getTrackedFiles getUntrackedFiles
getTrackedFiles = readCreateProcess
(shell "git ls-files"){cwd = Just $ unCanonicalPath root} ""
(shell "git ls-files"){cwd = Just root} ""
getUntrackedFiles = readCreateProcess
(shell "git ls-files --others --exclude-standard"){cwd = Just $ unCanonicalPath root} ""
(shell "git ls-files --others --exclude-standard"){cwd = Just root} ""
scanFile :: CanonicalPath -> IO (CanonicalPath, a)
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 +233,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

15
src/Xrefcheck/Scanners/Markdown.hs
View File

@ -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)

300
src/Xrefcheck/System.hs
View File

@ -4,45 +4,38 @@
-}
module Xrefcheck.System
( readingSystem
, askWithinCI
( askWithinCI
, CanonicalPath
, canonicalizePath
, unCanonicalPath
, getDirsBetweenRootAndFile
, getPosixRelativeChild
, getPosixRelativeOrAbsoluteChild
, hasIndirectionThroughParent
, pathIsSymbolicLink
, RelPosixLink (..)
, (</>)
, mkRelPosixLink
, filePathFromRoot
, getIntermediateDirs
, 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 +44,128 @@ 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
-- | 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 +175,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

145
src/Xrefcheck/Verify.hs
View File

@ -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)
@ -406,8 +404,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 +449,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 +468,7 @@ verifyReference
-> IORef (S.Set DomainName)
-> IORef VerifyProgress
-> RepoInfo
-> CanonicalPath
-> RelPosixLink
-> Reference
-> IO (VerifyResult $ WithReferenceLoc VerifyError)
verifyReference
@ -475,29 +476,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 +508,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 +528,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 url vrExternal of
Just (TaskTimestamp ttc start)
| retryAfter +:+ now <= ttc +:+ start -> vrExternalAdvanced
_ -> setTaskTimestamp url retryAfter now vrExternalAdvanced
Nothing -> vrExternalAdvanced, .. }
, ()
)
@ -585,32 +584,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 +607,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

5
tests/Test/Xrefcheck/AnchorsInHeadersSpec.hs
View File

@ -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 @?= []
]

5
tests/Test/Xrefcheck/AnchorsSpec.hs
View File

@ -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"

63
tests/Test/Xrefcheck/CanonicalPathSpec.hs
View File

@ -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
View 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

21
tests/Test/Xrefcheck/IgnoreAnnotationsSpec.hs
View File

@ -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)

8
tests/Test/Xrefcheck/IgnoreRegexSpec.hs
View File

@ -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

6
tests/Test/Xrefcheck/TooManyRequestsSpec.hs
View File

@ -53,7 +53,7 @@ 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
@ -76,7 +76,7 @@ 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
@ -100,7 +100,7 @@ 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

6
tests/Test/Xrefcheck/TrailingSlashSpec.hs
View File

@ -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||

12
tests/Test/Xrefcheck/Util.hs
View File

@ -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

10
tests/Test/Xrefcheck/UtilRequests.hs
View File

@ -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

4
tests/golden/check-anchors/check-anchors.bats
View File

@ -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

3
tests/golden/check-autolinks/check-autolinks.bats
View File

@ -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

2
tests/golden/check-case-sensitivity/expected1.gold
View File

@ -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
tests/golden/check-case-sensitivity/expected2.gold
View File

@ -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:

1
tests/golden/check-color/expected-color.gold
View File

@ -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

1
tests/golden/check-color/expected-no-color.gold
View File

@ -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

2
tests/golden/check-footnotes/expected.gold
View File

@ -7,6 +7,6 @@
- anchor: -
File does not exist:
notExists
./notExists
Invalid references dumped, 1 in total.

6
tests/golden/check-git/check-git.bats
View File

@ -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
tests/golden/check-ignoreExternalRefsTo/expected_linux.gold
View File

@ -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
tests/golden/check-ignoreExternalRefsTo/expected_windows.gold
View File

@ -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))

4
tests/golden/check-ignoreLocalRefsTo/expected.gold
View File

@ -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.

10
tests/golden/check-images/expected.gold
View File

@ -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.

13
tests/golden/check-local-refs/expected1.gold
View File

@ -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:

15
tests/golden/check-local-refs/expected2.gold
View File

@ -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:

13
tests/golden/check-local-refs/expected3.gold
View File

@ -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: