mirror of
https://github.com/serokell/xrefcheck.git
synced 2024-08-17 01:20:44 +03:00
[#197] Canonicalize filepaths
Problem: the current usage of filepaths is error-prone and can be simplified. Solution: canonicalize filepaths at the boundaries, so their management will be safer and will simplify the codebase.
This commit is contained in:
parent
a13910d433
commit
0886062500
@ -41,7 +41,6 @@ instance IsOption FtpHostOpt where
|
|||||||
<> help (untag (optionHelp :: Tagged FtpHostOpt String))
|
<> help (untag (optionHelp :: Tagged FtpHostOpt String))
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
config :: Config
|
config :: Config
|
||||||
config = defConfig GitHub & cExclusionsL . ecIgnoreExternalRefsToL .~ []
|
config = defConfig GitHub & cExclusionsL . ecIgnoreExternalRefsToL .~ []
|
||||||
|
|
||||||
|
@ -87,7 +87,6 @@ library:
|
|||||||
- bytestring
|
- bytestring
|
||||||
- containers
|
- containers
|
||||||
- cmark-gfm >= 0.2.5
|
- cmark-gfm >= 0.2.5
|
||||||
- data-default
|
|
||||||
- directory
|
- directory
|
||||||
- dlist
|
- dlist
|
||||||
- filepath
|
- filepath
|
||||||
|
@ -39,7 +39,7 @@ import Xrefcheck.Config (NetworkingConfig, NetworkingConfig' (..))
|
|||||||
import Xrefcheck.Core
|
import Xrefcheck.Core
|
||||||
import Xrefcheck.Scan
|
import Xrefcheck.Scan
|
||||||
import Xrefcheck.System (RelGlobPattern, mkGlobPattern)
|
import Xrefcheck.System (RelGlobPattern, mkGlobPattern)
|
||||||
import Xrefcheck.Util (ColorMode (WithColors, WithoutColors), normaliseWithNoTrailing)
|
import Xrefcheck.Util (ColorMode (WithColors, WithoutColors))
|
||||||
|
|
||||||
modeReadM :: ReadM VerifyMode
|
modeReadM :: ReadM VerifyMode
|
||||||
modeReadM = eitherReader $ \s ->
|
modeReadM = eitherReader $ \s ->
|
||||||
@ -118,7 +118,7 @@ defaultConfigPaths = ["./xrefcheck.yaml", "./.xrefcheck.yaml"]
|
|||||||
type RepoType = Flavor
|
type RepoType = Flavor
|
||||||
|
|
||||||
filepathOption :: Mod OptionFields FilePath -> Parser FilePath
|
filepathOption :: Mod OptionFields FilePath -> Parser FilePath
|
||||||
filepathOption = fmap normaliseWithNoTrailing <$> strOption
|
filepathOption = strOption
|
||||||
|
|
||||||
globOption :: Mod OptionFields RelGlobPattern -> Parser RelGlobPattern
|
globOption :: Mod OptionFields RelGlobPattern -> Parser RelGlobPattern
|
||||||
globOption = option $ eitherReader $ mkGlobPattern
|
globOption = option $ eitherReader $ mkGlobPattern
|
||||||
|
@ -18,8 +18,7 @@ import Text.Interpolation.Nyan
|
|||||||
|
|
||||||
import Xrefcheck.CLI (Options (..), addExclusionOptions, addNetworkingOptions, defaultConfigPaths)
|
import Xrefcheck.CLI (Options (..), addExclusionOptions, addNetworkingOptions, defaultConfigPaths)
|
||||||
import Xrefcheck.Config
|
import Xrefcheck.Config
|
||||||
(Config, Config' (..), ScannersConfig, ScannersConfig' (..), defConfig, normaliseConfigFilePaths,
|
(Config, Config' (..), ScannersConfig, ScannersConfig' (..), defConfig, overrideConfig)
|
||||||
overrideConfig)
|
|
||||||
import Xrefcheck.Core (Flavor (..))
|
import Xrefcheck.Core (Flavor (..))
|
||||||
import Xrefcheck.Progress (allowRewrite)
|
import Xrefcheck.Progress (allowRewrite)
|
||||||
import Xrefcheck.Scan
|
import Xrefcheck.Scan
|
||||||
@ -31,7 +30,7 @@ import Xrefcheck.Util
|
|||||||
import Xrefcheck.Verify (reportVerifyErrs, verifyErrors, verifyRepo)
|
import Xrefcheck.Verify (reportVerifyErrs, verifyErrors, verifyRepo)
|
||||||
|
|
||||||
readConfig :: FilePath -> IO Config
|
readConfig :: FilePath -> IO Config
|
||||||
readConfig path = fmap (normaliseConfigFilePaths . overrideConfig) do
|
readConfig path = fmap overrideConfig do
|
||||||
decodeFileEither path
|
decodeFileEither path
|
||||||
>>= either (error . toText . prettyPrintParseException) pure
|
>>= either (error . toText . prettyPrintParseException) pure
|
||||||
|
|
||||||
@ -70,7 +69,8 @@ defaultAction Options{..} = do
|
|||||||
|
|
||||||
(ScanResult scanErrs repoInfo) <- allowRewrite showProgressBar $ \rw -> do
|
(ScanResult scanErrs repoInfo) <- allowRewrite showProgressBar $ \rw -> do
|
||||||
let fullConfig = addExclusionOptions (cExclusions config) oExclusionOptions
|
let fullConfig = addExclusionOptions (cExclusions config) oExclusionOptions
|
||||||
scanRepo oScanPolicy rw (formats $ cScanners config) fullConfig oRoot
|
formatsSupport = formats $ cScanners config
|
||||||
|
scanRepo oScanPolicy rw formatsSupport fullConfig oRoot
|
||||||
|
|
||||||
when oVerbose $
|
when oVerbose $
|
||||||
fmt [int||
|
fmt [int||
|
||||||
@ -84,7 +84,7 @@ defaultAction Options{..} = do
|
|||||||
verifyRes <- allowRewrite showProgressBar $ \rw -> do
|
verifyRes <- allowRewrite showProgressBar $ \rw -> do
|
||||||
let fullConfig = config
|
let fullConfig = config
|
||||||
{ cNetworking = addNetworkingOptions (cNetworking config) oNetworkingOptions }
|
{ cNetworking = addNetworkingOptions (cNetworking config) oNetworkingOptions }
|
||||||
verifyRepo rw fullConfig oMode oRoot repoInfo
|
verifyRepo rw fullConfig oMode repoInfo
|
||||||
|
|
||||||
case verifyErrors verifyRes of
|
case verifyErrors verifyRes of
|
||||||
Nothing | null scanErrs -> fmtLn "All repository links are valid."
|
Nothing | null scanErrs -> fmtLn "All repository links are valid."
|
||||||
|
@ -10,7 +10,6 @@ module Xrefcheck.Config
|
|||||||
, defConfigText
|
, defConfigText
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
|
||||||
import Universum
|
import Universum
|
||||||
|
|
||||||
import Control.Lens (makeLensesWith)
|
import Control.Lens (makeLensesWith)
|
||||||
@ -38,13 +37,6 @@ data Config' f = Config
|
|||||||
, cScanners :: ScannersConfig' f
|
, cScanners :: ScannersConfig' f
|
||||||
} deriving stock (Generic)
|
} deriving stock (Generic)
|
||||||
|
|
||||||
normaliseConfigFilePaths :: Config -> Config
|
|
||||||
normaliseConfigFilePaths Config{..}
|
|
||||||
= Config
|
|
||||||
{ cExclusions = normaliseExclusionConfigFilePaths cExclusions
|
|
||||||
, ..
|
|
||||||
}
|
|
||||||
|
|
||||||
-- | Type alias for NetworkingConfig' with all required fields.
|
-- | Type alias for NetworkingConfig' with all required fields.
|
||||||
type NetworkingConfig = NetworkingConfig' Identity
|
type NetworkingConfig = NetworkingConfig' Identity
|
||||||
|
|
||||||
@ -79,9 +71,10 @@ makeLensesWith postfixFields ''Config'
|
|||||||
makeLensesWith postfixFields ''NetworkingConfig'
|
makeLensesWith postfixFields ''NetworkingConfig'
|
||||||
|
|
||||||
defConfig :: HasCallStack => Flavor -> Config
|
defConfig :: HasCallStack => Flavor -> Config
|
||||||
defConfig flavor = normaliseConfigFilePaths $
|
defConfig = either (error . toText . prettyPrintParseException) id
|
||||||
either (error . toText . prettyPrintParseException) id $
|
. decodeEither'
|
||||||
decodeEither' $ encodeUtf8 $ defConfigText flavor
|
. encodeUtf8
|
||||||
|
. defConfigText
|
||||||
|
|
||||||
-- | Override missed fields with default values.
|
-- | Override missed fields with default values.
|
||||||
overrideConfig :: ConfigOptional -> Config
|
overrideConfig :: ConfigOptional -> Config
|
||||||
|
@ -15,10 +15,10 @@ import Control.Lens (makeLenses)
|
|||||||
import Data.Aeson (FromJSON (..), withText)
|
import Data.Aeson (FromJSON (..), withText)
|
||||||
import Data.Char (isAlphaNum)
|
import Data.Char (isAlphaNum)
|
||||||
import Data.Char qualified as C
|
import Data.Char qualified as C
|
||||||
import Data.Default (Default (..))
|
|
||||||
import Data.DList (DList)
|
import Data.DList (DList)
|
||||||
import Data.DList qualified as DList
|
import Data.DList qualified as DList
|
||||||
import Data.List qualified as L
|
import Data.List qualified as L
|
||||||
|
import Data.Map qualified as M
|
||||||
import Data.Reflection (Given)
|
import Data.Reflection (Given)
|
||||||
import Data.Text qualified as T
|
import Data.Text qualified as T
|
||||||
import Fmt (Buildable (..), Builder)
|
import Fmt (Buildable (..), Builder)
|
||||||
@ -27,6 +27,7 @@ import Text.Interpolation.Nyan
|
|||||||
import Time (Second, Time)
|
import Time (Second, Time)
|
||||||
|
|
||||||
import Xrefcheck.Progress
|
import Xrefcheck.Progress
|
||||||
|
import Xrefcheck.System
|
||||||
import Xrefcheck.Util
|
import Xrefcheck.Util
|
||||||
|
|
||||||
-----------------------------------------------------------
|
-----------------------------------------------------------
|
||||||
@ -77,8 +78,60 @@ data Reference = Reference
|
|||||||
, rAnchor :: Maybe Text
|
, rAnchor :: Maybe Text
|
||||||
-- ^ Section or custom anchor tag.
|
-- ^ Section or custom anchor tag.
|
||||||
, rPos :: Position
|
, rPos :: Position
|
||||||
|
-- ^ Position in source file.
|
||||||
|
, rInfo :: ReferenceInfo
|
||||||
|
-- ^ More info about the link.
|
||||||
} deriving stock (Show, Generic)
|
} 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)@
|
||||||
|
deriving stock (Show, Generic)
|
||||||
|
|
||||||
|
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
|
||||||
|
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
|
||||||
|
|
||||||
-- | Context of anchor.
|
-- | Context of anchor.
|
||||||
data AnchorType
|
data AnchorType
|
||||||
= HeaderAnchor Int
|
= HeaderAnchor Int
|
||||||
@ -119,9 +172,6 @@ data FileInfo = FileInfo
|
|||||||
} deriving stock (Show, Generic)
|
} deriving stock (Show, Generic)
|
||||||
makeLenses ''FileInfo
|
makeLenses ''FileInfo
|
||||||
|
|
||||||
instance Default FileInfo where
|
|
||||||
def = diffToFileInfo mempty
|
|
||||||
|
|
||||||
data ScanPolicy
|
data ScanPolicy
|
||||||
= OnlyTracked
|
= OnlyTracked
|
||||||
-- ^ Scan and treat as existing only files tracked by Git.
|
-- ^ Scan and treat as existing only files tracked by Git.
|
||||||
@ -148,11 +198,23 @@ data DirectoryStatus
|
|||||||
|
|
||||||
-- | All tracked files and directories.
|
-- | All tracked files and directories.
|
||||||
data RepoInfo = RepoInfo
|
data RepoInfo = RepoInfo
|
||||||
{ riFiles :: Map FilePath FileStatus
|
{ riFiles :: Map CanonicalPath FileStatus
|
||||||
-- ^ Files from the repo with `FileInfo` attached to files that we've scanned.
|
-- ^ Files from the repo with `FileInfo` attached to files that we've scanned.
|
||||||
, riDirectories :: Map FilePath DirectoryStatus
|
, riDirectories :: Map CanonicalPath DirectoryStatus
|
||||||
-- ^ Directories containing those files.
|
-- ^ Directories containing those files.
|
||||||
} deriving stock (Show)
|
, riRoot :: CanonicalPath
|
||||||
|
-- ^ Repository root.
|
||||||
|
}
|
||||||
|
|
||||||
|
-- Search for a file in the repository.
|
||||||
|
lookupFile :: CanonicalPath -> RepoInfo -> Maybe FileStatus
|
||||||
|
lookupFile path RepoInfo{..} =
|
||||||
|
M.lookup path riFiles
|
||||||
|
|
||||||
|
-- Search for a directory in the repository.
|
||||||
|
lookupDirectory :: CanonicalPath -> RepoInfo -> Maybe DirectoryStatus
|
||||||
|
lookupDirectory path RepoInfo{..} =
|
||||||
|
M.lookup path riDirectories
|
||||||
|
|
||||||
-----------------------------------------------------------
|
-----------------------------------------------------------
|
||||||
-- Instances
|
-- Instances
|
||||||
@ -160,6 +222,7 @@ data RepoInfo = RepoInfo
|
|||||||
|
|
||||||
instance NFData Position
|
instance NFData Position
|
||||||
instance NFData Reference
|
instance NFData Reference
|
||||||
|
instance NFData ReferenceInfo
|
||||||
instance NFData AnchorType
|
instance NFData AnchorType
|
||||||
instance NFData Anchor
|
instance NFData Anchor
|
||||||
instance NFData FileInfo
|
instance NFData FileInfo
|
||||||
@ -167,12 +230,20 @@ instance NFData FileInfo
|
|||||||
instance Given ColorMode => Buildable Reference where
|
instance Given ColorMode => Buildable Reference where
|
||||||
build Reference{..} =
|
build Reference{..} =
|
||||||
[int||
|
[int||
|
||||||
reference #{paren . build $ locationType rLink} #{rPos}:
|
reference #{paren . build $ rInfo} #{rPos}:
|
||||||
- text: #s{rName}
|
- text: #s{rName}
|
||||||
- link: #{if null rLink then "-" else rLink}
|
- link: #{if null rLink then "-" else rLink}
|
||||||
- anchor: #{rAnchor ?: styleIfNeeded Faint "-"}
|
- 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 -> ""
|
||||||
|
|
||||||
instance Given ColorMode => Buildable AnchorType where
|
instance Given ColorMode => Buildable AnchorType where
|
||||||
build = styleIfNeeded Faint . \case
|
build = styleIfNeeded Faint . \case
|
||||||
HeaderAnchor l -> colorIfNeeded Green ("header " <> headerLevelToRoman l)
|
HeaderAnchor l -> colorIfNeeded Green ("header " <> headerLevelToRoman l)
|
||||||
@ -204,14 +275,14 @@ instance Given ColorMode => Buildable FileInfo where
|
|||||||
|]
|
|]
|
||||||
|
|
||||||
instance Given ColorMode => Buildable RepoInfo where
|
instance Given ColorMode => Buildable RepoInfo where
|
||||||
build (RepoInfo m _)
|
build RepoInfo{..}
|
||||||
| Just scanned <- nonEmpty [(name, info) | (name, Scanned info) <- toPairs m]
|
| Just scanned <- nonEmpty [(name, info) | (name, Scanned info) <- toPairs riFiles]
|
||||||
= interpolateUnlinesF $ buildFileReport <$> scanned
|
= interpolateUnlinesF $ buildFileReport <$> scanned
|
||||||
where
|
where
|
||||||
buildFileReport :: ([Char], FileInfo) -> Builder
|
buildFileReport :: (CanonicalPath, FileInfo) -> Builder
|
||||||
buildFileReport (name, info) =
|
buildFileReport (name, info) =
|
||||||
[int||
|
[int||
|
||||||
#{ colorIfNeeded Cyan $ name }:
|
#{ colorIfNeeded Cyan $ getPosixRelativeOrAbsoluteChild riRoot name }:
|
||||||
#{ interpolateIndentF 2 $ build info }
|
#{ interpolateIndentF 2 $ build info }
|
||||||
|]
|
|]
|
||||||
build _ = "No scannable files found."
|
build _ = "No scannable files found."
|
||||||
@ -220,60 +291,6 @@ instance Given ColorMode => Buildable RepoInfo where
|
|||||||
-- Analysing
|
-- Analysing
|
||||||
-----------------------------------------------------------
|
-----------------------------------------------------------
|
||||||
|
|
||||||
pattern PathSep :: Char
|
|
||||||
pattern PathSep <- (isPathSeparator -> True)
|
|
||||||
|
|
||||||
-- | Type of reference.
|
|
||||||
data LocationType
|
|
||||||
= FileLocalLoc
|
|
||||||
-- ^ Reference to this file, e.g. @[a](#header)@
|
|
||||||
| RelativeLoc
|
|
||||||
-- ^ Reference to a file relative to given one, e.g. @[b](folder/file#header)@
|
|
||||||
| AbsoluteLoc
|
|
||||||
-- ^ Reference to a file relative to the root, e.g. @[c](/folder/file#header)@
|
|
||||||
| ExternalLoc
|
|
||||||
-- ^ Reference to a file at outer site, e.g @[d](http://www.google.com/doodles)@
|
|
||||||
| OtherLoc
|
|
||||||
-- ^ Entry not to be processed, e.g. @mailto:e-mail@
|
|
||||||
deriving stock (Eq, Show)
|
|
||||||
|
|
||||||
instance Given ColorMode => Buildable LocationType where
|
|
||||||
build = \case
|
|
||||||
FileLocalLoc -> colorIfNeeded Green "file-local"
|
|
||||||
RelativeLoc -> colorIfNeeded Yellow "relative"
|
|
||||||
AbsoluteLoc -> colorIfNeeded Blue "absolute"
|
|
||||||
ExternalLoc -> colorIfNeeded Red "external"
|
|
||||||
OtherLoc -> ""
|
|
||||||
|
|
||||||
-- | Whether this is a link to external resource.
|
|
||||||
isExternal :: LocationType -> Bool
|
|
||||||
isExternal = \case
|
|
||||||
ExternalLoc -> True
|
|
||||||
_ -> False
|
|
||||||
|
|
||||||
-- | Whether this is a link to repo-local resource.
|
|
||||||
isLocal :: LocationType -> Bool
|
|
||||||
isLocal = \case
|
|
||||||
FileLocalLoc -> True
|
|
||||||
RelativeLoc -> True
|
|
||||||
AbsoluteLoc -> True
|
|
||||||
ExternalLoc -> False
|
|
||||||
OtherLoc -> False
|
|
||||||
|
|
||||||
-- | Get type of reference.
|
|
||||||
locationType :: Text -> LocationType
|
|
||||||
locationType location = case toString location of
|
|
||||||
[] -> FileLocalLoc
|
|
||||||
PathSep : _ -> AbsoluteLoc
|
|
||||||
'.' : PathSep : _ -> RelativeLoc
|
|
||||||
'.' : '.' : PathSep : _ -> RelativeLoc
|
|
||||||
_ | hasUrlProtocol -> ExternalLoc
|
|
||||||
| hasProtocol -> OtherLoc
|
|
||||||
| otherwise -> RelativeLoc
|
|
||||||
where
|
|
||||||
hasUrlProtocol = "://" `T.isInfixOf` T.take 10 location
|
|
||||||
hasProtocol = ":" `T.isInfixOf` T.take 10 location
|
|
||||||
|
|
||||||
-- | Which parts of verification do we perform.
|
-- | Which parts of verification do we perform.
|
||||||
data VerifyMode
|
data VerifyMode
|
||||||
= LocalOnlyMode
|
= LocalOnlyMode
|
||||||
@ -335,13 +352,6 @@ stripAnchorDupNo t = do
|
|||||||
guard (length strippedNo < length t)
|
guard (length strippedNo < length t)
|
||||||
T.stripSuffix "-" strippedNo
|
T.stripSuffix "-" strippedNo
|
||||||
|
|
||||||
-- | Strip './' prefix from local references.
|
|
||||||
canonizeLocalRef :: Text -> Text
|
|
||||||
canonizeLocalRef ref =
|
|
||||||
maybe ref canonizeLocalRef (T.stripPrefix localPrefix ref)
|
|
||||||
where
|
|
||||||
localPrefix = "./"
|
|
||||||
|
|
||||||
-----------------------------------------------------------
|
-----------------------------------------------------------
|
||||||
-- Visualisation
|
-- Visualisation
|
||||||
-----------------------------------------------------------
|
-----------------------------------------------------------
|
||||||
@ -357,7 +367,7 @@ initVerifyProgress references = VerifyProgress
|
|||||||
, vrExternal = initProgress (length (ordNub $ map rLink extRefs))
|
, vrExternal = initProgress (length (ordNub $ map rLink extRefs))
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
(extRefs, localRefs) = L.partition (isExternal . locationType . rLink) references
|
(extRefs, localRefs) = L.partition (isExternal . rInfo) references
|
||||||
|
|
||||||
showAnalyseProgress :: Given ColorMode => VerifyMode -> Time Second -> VerifyProgress -> Text
|
showAnalyseProgress :: Given ColorMode => VerifyMode -> Time Second -> VerifyProgress -> Text
|
||||||
showAnalyseProgress mode posixTime VerifyProgress{..} =
|
showAnalyseProgress mode posixTime VerifyProgress{..} =
|
||||||
|
@ -13,13 +13,14 @@ module Xrefcheck.Scan
|
|||||||
, Extension
|
, Extension
|
||||||
, ScanAction
|
, ScanAction
|
||||||
, FormatsSupport
|
, FormatsSupport
|
||||||
, RepoInfo (..)
|
|
||||||
, ReadDirectoryMode(..)
|
, ReadDirectoryMode(..)
|
||||||
, ScanError (..)
|
, ScanError (..)
|
||||||
, ScanErrorDescription (..)
|
, ScanErrorDescription (..)
|
||||||
, ScanResult (..)
|
, ScanResult (..)
|
||||||
|
, ScanStage (..)
|
||||||
|
|
||||||
, normaliseExclusionConfigFilePaths
|
, mkParseScanError
|
||||||
|
, mkGatherScanError
|
||||||
, scanRepo
|
, scanRepo
|
||||||
, specificFormatsSupport
|
, specificFormatsSupport
|
||||||
, ecIgnoreL
|
, ecIgnoreL
|
||||||
@ -38,8 +39,6 @@ import Data.Map qualified as M
|
|||||||
import Data.Reflection (Given)
|
import Data.Reflection (Given)
|
||||||
import Fmt (Buildable (..), fmt)
|
import Fmt (Buildable (..), fmt)
|
||||||
import System.Directory (doesDirectoryExist)
|
import System.Directory (doesDirectoryExist)
|
||||||
import System.FilePath.Posix
|
|
||||||
(dropTrailingPathSeparator, equalFilePath, splitDirectories, takeDirectory, takeExtension, (</>))
|
|
||||||
import System.Process (cwd, readCreateProcess, shell)
|
import System.Process (cwd, readCreateProcess, shell)
|
||||||
import Text.Interpolation.Nyan
|
import Text.Interpolation.Nyan
|
||||||
import Text.Regex.TDFA.Common (CompOption (..), ExecOption (..), Regex)
|
import Text.Regex.TDFA.Common (CompOption (..), ExecOption (..), Regex)
|
||||||
@ -47,7 +46,7 @@ import Text.Regex.TDFA.Text qualified as R
|
|||||||
|
|
||||||
import Xrefcheck.Core
|
import Xrefcheck.Core
|
||||||
import Xrefcheck.Progress
|
import Xrefcheck.Progress
|
||||||
import Xrefcheck.System (RelGlobPattern, matchesGlobPatterns, normaliseGlobPattern, readingSystem)
|
import Xrefcheck.System
|
||||||
import Xrefcheck.Util
|
import Xrefcheck.Util
|
||||||
|
|
||||||
-- | Type alias for ExclusionConfig' with all required fields.
|
-- | Type alias for ExclusionConfig' with all required fields.
|
||||||
@ -67,35 +66,58 @@ data ExclusionConfig' f = ExclusionConfig
|
|||||||
|
|
||||||
makeLensesWith postfixFields ''ExclusionConfig'
|
makeLensesWith postfixFields ''ExclusionConfig'
|
||||||
|
|
||||||
normaliseExclusionConfigFilePaths :: ExclusionConfig -> ExclusionConfig
|
|
||||||
normaliseExclusionConfigFilePaths ec@ExclusionConfig{..}
|
|
||||||
= ec
|
|
||||||
{ ecIgnore = map normaliseGlobPattern ecIgnore
|
|
||||||
, ecIgnoreLocalRefsTo = map normaliseGlobPattern ecIgnoreLocalRefsTo
|
|
||||||
, ecIgnoreRefsFrom = map normaliseGlobPattern ecIgnoreRefsFrom
|
|
||||||
}
|
|
||||||
|
|
||||||
-- | File extension, dot included.
|
-- | File extension, dot included.
|
||||||
type Extension = String
|
type Extension = String
|
||||||
|
|
||||||
-- | Way to parse a file.
|
-- | Way to parse a file.
|
||||||
type ScanAction = FilePath -> IO (FileInfo, [ScanError])
|
type ScanAction = CanonicalPath -> IO (FileInfo, [ScanError 'Parse])
|
||||||
|
|
||||||
-- | All supported ways to parse a file.
|
-- | All supported ways to parse a file.
|
||||||
type FormatsSupport = Extension -> Maybe ScanAction
|
type FormatsSupport = Extension -> Maybe ScanAction
|
||||||
|
|
||||||
data ScanResult = ScanResult
|
data ScanResult = ScanResult
|
||||||
{ srScanErrors :: [ScanError]
|
{ srScanErrors :: [ScanError 'Gather]
|
||||||
, srRepoInfo :: RepoInfo
|
, srRepoInfo :: RepoInfo
|
||||||
} deriving stock (Show)
|
}
|
||||||
|
|
||||||
data ScanError = ScanError
|
-- | A scan error indexed by different process stages.
|
||||||
{ sePosition :: Position
|
--
|
||||||
, seFile :: FilePath
|
-- Within 'Parse', 'seFile' has no information because the same
|
||||||
|
-- file is being parsed.
|
||||||
|
--
|
||||||
|
-- Within 'Gather', 'seFile' stores the 'FilePath' corresponding
|
||||||
|
-- to the file in where the error was found.
|
||||||
|
data ScanError (a :: ScanStage) = ScanError
|
||||||
|
{ seFile :: ScanStageFile a
|
||||||
|
, sePosition :: Position
|
||||||
, seDescription :: ScanErrorDescription
|
, seDescription :: ScanErrorDescription
|
||||||
} deriving stock (Show, Eq)
|
}
|
||||||
|
|
||||||
instance Given ColorMode => Buildable ScanError where
|
data ScanStage = Parse | Gather
|
||||||
|
|
||||||
|
type family ScanStageFile (a :: ScanStage) where
|
||||||
|
ScanStageFile 'Parse = ()
|
||||||
|
ScanStageFile 'Gather = FilePath
|
||||||
|
|
||||||
|
deriving stock instance Show (ScanError 'Parse)
|
||||||
|
deriving stock instance Show (ScanError 'Gather)
|
||||||
|
deriving stock instance Eq (ScanError 'Parse)
|
||||||
|
deriving stock instance Eq (ScanError 'Gather)
|
||||||
|
|
||||||
|
-- | Make a 'ScanError' for the 'Parse' stage.
|
||||||
|
mkParseScanError :: Position -> ScanErrorDescription -> ScanError 'Parse
|
||||||
|
mkParseScanError = ScanError ()
|
||||||
|
|
||||||
|
-- | Promote a 'ScanError' from the 'Parse' stage
|
||||||
|
-- to the 'Gather' stage.
|
||||||
|
mkGatherScanError :: FilePath -> ScanError 'Parse -> ScanError 'Gather
|
||||||
|
mkGatherScanError seFile ScanError{sePosition, seDescription} = ScanError
|
||||||
|
{ seFile
|
||||||
|
, sePosition
|
||||||
|
, seDescription
|
||||||
|
}
|
||||||
|
|
||||||
|
instance Given ColorMode => Buildable (ScanError 'Gather) where
|
||||||
build ScanError{..} = [int||
|
build ScanError{..} = [int||
|
||||||
In file #{styleIfNeeded Faint (styleIfNeeded Bold seFile)}
|
In file #{styleIfNeeded Faint (styleIfNeeded Bold seFile)}
|
||||||
scan error #{sePosition}:
|
scan error #{sePosition}:
|
||||||
@ -104,7 +126,7 @@ instance Given ColorMode => Buildable ScanError where
|
|||||||
|
|
||||||
|]
|
|]
|
||||||
|
|
||||||
reportScanErrs :: Given ColorMode => NonEmpty ScanError -> IO ()
|
reportScanErrs :: Given ColorMode => NonEmpty (ScanError 'Gather) -> IO ()
|
||||||
reportScanErrs errs = fmt
|
reportScanErrs errs = fmt
|
||||||
[int||
|
[int||
|
||||||
=== Scan errors found ===
|
=== Scan errors found ===
|
||||||
@ -153,14 +175,13 @@ data ReadDirectoryMode
|
|||||||
readDirectoryWith
|
readDirectoryWith
|
||||||
:: forall a. ReadDirectoryMode
|
:: forall a. ReadDirectoryMode
|
||||||
-> ExclusionConfig
|
-> ExclusionConfig
|
||||||
-> (FilePath -> IO a)
|
-> (CanonicalPath -> IO a)
|
||||||
-> FilePath
|
-> CanonicalPath
|
||||||
-> IO [(FilePath, a)]
|
-> IO [(CanonicalPath, a)]
|
||||||
readDirectoryWith mode config scanner root =
|
readDirectoryWith mode config scanner root = do
|
||||||
traverse scanFile
|
relativeFiles <- L.lines <$> getFiles
|
||||||
. filter (not . isIgnored)
|
canonicalFiles <- mapM (root </) relativeFiles
|
||||||
. fmap (location </>)
|
traverse scanFile $ filter (not . isIgnored) canonicalFiles
|
||||||
. L.lines =<< getFiles
|
|
||||||
|
|
||||||
where
|
where
|
||||||
|
|
||||||
@ -170,43 +191,37 @@ readDirectoryWith mode config scanner root =
|
|||||||
RdmBothTrackedAndUtracked -> liftA2 (<>) getTrackedFiles getUntrackedFiles
|
RdmBothTrackedAndUtracked -> liftA2 (<>) getTrackedFiles getUntrackedFiles
|
||||||
|
|
||||||
getTrackedFiles = readCreateProcess
|
getTrackedFiles = readCreateProcess
|
||||||
(shell "git ls-files"){cwd = Just root} ""
|
(shell "git ls-files"){cwd = Just $ unCanonicalPath root} ""
|
||||||
getUntrackedFiles = readCreateProcess
|
getUntrackedFiles = readCreateProcess
|
||||||
(shell "git ls-files --others --exclude-standard"){cwd = Just root} ""
|
(shell "git ls-files --others --exclude-standard"){cwd = Just $ unCanonicalPath root} ""
|
||||||
|
|
||||||
scanFile :: FilePath -> IO (FilePath, a)
|
scanFile :: CanonicalPath -> IO (CanonicalPath, a)
|
||||||
scanFile = sequence . (normaliseWithNoTrailing &&& scanner)
|
scanFile c = (c,) <$> scanner c
|
||||||
|
|
||||||
isIgnored :: FilePath -> Bool
|
isIgnored :: CanonicalPath -> Bool
|
||||||
isIgnored = matchesGlobPatterns root $ ecIgnore config
|
isIgnored = matchesGlobPatterns root $ ecIgnore config
|
||||||
|
|
||||||
-- Strip leading "." and trailing "/"
|
|
||||||
location :: FilePath
|
|
||||||
location =
|
|
||||||
if root `equalFilePath` "."
|
|
||||||
then ""
|
|
||||||
else dropTrailingPathSeparator root
|
|
||||||
|
|
||||||
scanRepo
|
scanRepo
|
||||||
:: MonadIO m
|
:: MonadIO m
|
||||||
=> ScanPolicy -> Rewrite -> FormatsSupport -> ExclusionConfig -> FilePath -> m ScanResult
|
=> ScanPolicy -> Rewrite -> FormatsSupport -> ExclusionConfig -> FilePath -> m ScanResult
|
||||||
scanRepo scanMode rw formatsSupport config root = do
|
scanRepo scanMode rw formatsSupport config root = do
|
||||||
putTextRewrite rw "Scanning repository..."
|
putTextRewrite rw "Scanning repository..."
|
||||||
|
|
||||||
when (not $ isDirectory root) $
|
liftIO $ whenM (not <$> doesDirectoryExist root) $
|
||||||
die $ "Repository's root does not seem to be a directory: " <> root
|
die $ "Repository's root does not seem to be a directory: " <> root
|
||||||
|
|
||||||
|
canonicalRoot <- liftIO $ canonicalizePath root
|
||||||
|
|
||||||
(errs, processedFiles) <-
|
(errs, processedFiles) <-
|
||||||
let mode = case scanMode of
|
let mode = case scanMode of
|
||||||
OnlyTracked -> RdmTracked
|
OnlyTracked -> RdmTracked
|
||||||
IncludeUntracked -> RdmBothTrackedAndUtracked
|
IncludeUntracked -> RdmBothTrackedAndUtracked
|
||||||
in liftIO
|
in liftIO $ (gatherScanErrs canonicalRoot &&& gatherFileStatuses)
|
||||||
$ (gatherScanErrs &&& gatherFileStatuses)
|
<$> readDirectoryWith mode config processFile canonicalRoot
|
||||||
<$> readDirectoryWith mode config processFile root
|
|
||||||
|
|
||||||
notProcessedFiles <- case scanMode of
|
notProcessedFiles <- case scanMode of
|
||||||
OnlyTracked -> liftIO $
|
OnlyTracked -> liftIO $
|
||||||
readDirectoryWith RdmUntracked config (const $ pure NotAddedToGit) root
|
readDirectoryWith RdmUntracked config (const $ pure NotAddedToGit) canonicalRoot
|
||||||
IncludeUntracked -> pure []
|
IncludeUntracked -> pure []
|
||||||
|
|
||||||
let scannableNotProcessedFiles = filter (isJust . mscanner . fst) notProcessedFiles
|
let scannableNotProcessedFiles = filter (isJust . mscanner . fst) notProcessedFiles
|
||||||
@ -214,44 +229,42 @@ scanRepo scanMode rw formatsSupport config root = do
|
|||||||
whenJust (nonEmpty $ map fst scannableNotProcessedFiles) $ \files -> hPutStrLn @Text stderr
|
whenJust (nonEmpty $ map fst scannableNotProcessedFiles) $ \files -> hPutStrLn @Text stderr
|
||||||
[int|A|
|
[int|A|
|
||||||
Those files are not added by Git, so we're not scanning them:
|
Those files are not added by Git, so we're not scanning them:
|
||||||
#{interpolateBlockListF files}
|
#{interpolateBlockListF $ getPosixRelativeOrAbsoluteChild canonicalRoot <$> files}
|
||||||
Please run "git add" before running xrefcheck or enable \
|
Please run "git add" before running xrefcheck or enable \
|
||||||
--include-untracked CLI option to check these files.
|
--include-untracked CLI option to check these files.
|
||||||
|]
|
|]
|
||||||
|
|
||||||
let trackedDirs = foldMap (getDirs . fst) processedFiles
|
let trackedDirs = foldMap (getDirsBetweenRootAndFile canonicalRoot . fst) processedFiles
|
||||||
untrackedDirs = foldMap (getDirs . fst) notProcessedFiles
|
untrackedDirs = foldMap (getDirsBetweenRootAndFile canonicalRoot . fst) notProcessedFiles
|
||||||
|
|
||||||
return . ScanResult errs $ RepoInfo
|
return . ScanResult errs $ RepoInfo
|
||||||
{ riFiles = M.fromList $ processedFiles <> notProcessedFiles
|
{ riFiles = M.fromList $ processedFiles <> notProcessedFiles
|
||||||
, riDirectories = M.fromList
|
, riDirectories = M.fromList $ (fmap (, TrackedDirectory) trackedDirs
|
||||||
$ map (, TrackedDirectory) trackedDirs
|
<> fmap (, UntrackedDirectory) untrackedDirs)
|
||||||
<> map (, UntrackedDirectory) untrackedDirs
|
, riRoot = canonicalRoot
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
mscanner :: FilePath -> Maybe ScanAction
|
mscanner :: CanonicalPath -> Maybe ScanAction
|
||||||
mscanner = formatsSupport . takeExtension
|
mscanner = formatsSupport . takeExtension
|
||||||
|
|
||||||
isDirectory :: FilePath -> Bool
|
|
||||||
isDirectory = readingSystem . doesDirectoryExist
|
|
||||||
|
|
||||||
-- Get all directories from filepath.
|
|
||||||
getDirs :: FilePath -> [FilePath]
|
|
||||||
getDirs = scanl (</>) "" . splitDirectories . takeDirectory
|
|
||||||
|
|
||||||
gatherScanErrs
|
gatherScanErrs
|
||||||
:: [(FilePath, (FileStatus, [ScanError]))]
|
:: CanonicalPath
|
||||||
-> [ScanError]
|
-> [(CanonicalPath, (FileStatus, [ScanError 'Parse]))]
|
||||||
gatherScanErrs = foldMap (snd . snd)
|
-> [ScanError 'Gather]
|
||||||
|
gatherScanErrs canonicalRoot = foldMap $ \(file, (_, errs)) ->
|
||||||
|
mkGatherScanError (showFilepath file) <$> errs
|
||||||
|
where
|
||||||
|
showFilepath = getPosixRelativeOrAbsoluteChild canonicalRoot
|
||||||
|
|
||||||
gatherFileStatuses
|
gatherFileStatuses
|
||||||
:: [(FilePath, (FileStatus, [ScanError]))]
|
:: [(CanonicalPath, (FileStatus, [ScanError 'Parse]))]
|
||||||
-> [(FilePath, FileStatus)]
|
-> [(CanonicalPath, FileStatus)]
|
||||||
gatherFileStatuses = map (second fst)
|
gatherFileStatuses = map (second fst)
|
||||||
|
|
||||||
processFile :: FilePath -> IO (FileStatus, [ScanError])
|
processFile :: CanonicalPath -> IO (FileStatus, [ScanError 'Parse])
|
||||||
processFile file = case mscanner file of
|
processFile canonicalFile = case mscanner canonicalFile of
|
||||||
Nothing -> pure (NotScannable, [])
|
Nothing -> pure (NotScannable, [])
|
||||||
Just scanner -> scanner file <&> _1 %~ Scanned
|
Just scanner -> scanner canonicalFile <&> _1 %~ Scanned
|
||||||
|
|
||||||
-----------------------------------------------------------
|
-----------------------------------------------------------
|
||||||
-- Yaml instances
|
-- Yaml instances
|
||||||
|
@ -26,7 +26,6 @@ import Control.Monad.Trans.Writer.CPS (Writer, runWriter, tell)
|
|||||||
import Data.Aeson (FromJSON (..), genericParseJSON)
|
import Data.Aeson (FromJSON (..), genericParseJSON)
|
||||||
import Data.ByteString.Lazy qualified as BSL
|
import Data.ByteString.Lazy qualified as BSL
|
||||||
import Data.DList qualified as DList
|
import Data.DList qualified as DList
|
||||||
import Data.Default (def)
|
|
||||||
import Data.Text qualified as T
|
import Data.Text qualified as T
|
||||||
import Data.Text.Lazy qualified as LT
|
import Data.Text.Lazy qualified as LT
|
||||||
import Fmt (Buildable (..), nameF)
|
import Fmt (Buildable (..), nameF)
|
||||||
@ -35,6 +34,7 @@ import Text.Interpolation.Nyan
|
|||||||
|
|
||||||
import Xrefcheck.Core
|
import Xrefcheck.Core
|
||||||
import Xrefcheck.Scan
|
import Xrefcheck.Scan
|
||||||
|
import Xrefcheck.System
|
||||||
import Xrefcheck.Util
|
import Xrefcheck.Util
|
||||||
|
|
||||||
data MarkdownConfig = MarkdownConfig
|
data MarkdownConfig = MarkdownConfig
|
||||||
@ -124,8 +124,6 @@ data GetIgnoreMode
|
|||||||
| InvalidMode Text
|
| InvalidMode Text
|
||||||
deriving stock (Eq)
|
deriving stock (Eq)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
data ScannerState = ScannerState
|
data ScannerState = ScannerState
|
||||||
{ _ssIgnore :: Maybe Ignore
|
{ _ssIgnore :: Maybe Ignore
|
||||||
, _ssParentNodeType :: Maybe NodeType
|
, _ssParentNodeType :: Maybe NodeType
|
||||||
@ -139,7 +137,7 @@ initialScannerState = ScannerState
|
|||||||
, _ssParentNodeType = Nothing
|
, _ssParentNodeType = Nothing
|
||||||
}
|
}
|
||||||
|
|
||||||
type ScannerM a = StateT ScannerState (Writer [ScanError]) a
|
type ScannerM a = StateT ScannerState (Writer [ScanError 'Parse]) a
|
||||||
|
|
||||||
-- | A fold over a `Node`.
|
-- | A fold over a `Node`.
|
||||||
cataNode :: (Maybe PosInfo -> NodeType -> [c] -> c) -> Node -> c
|
cataNode :: (Maybe PosInfo -> NodeType -> [c] -> c) -> Node -> c
|
||||||
@ -156,9 +154,9 @@ cataNodeWithParentNodeInfo f node = cataNode f' node
|
|||||||
map (ssParentNodeType .= Just ty >>) childScanners
|
map (ssParentNodeType .= Just ty >>) childScanners
|
||||||
|
|
||||||
-- | Find ignore annotations (ignore paragraph and ignore link)
|
-- | Find ignore annotations (ignore paragraph and ignore link)
|
||||||
-- and remove nodes that should be ignored
|
-- and remove nodes that should be ignored.
|
||||||
removeIgnored :: FilePath -> Node -> Writer [ScanError] Node
|
removeIgnored :: Node -> Writer [ScanError 'Parse] Node
|
||||||
removeIgnored fp = withIgnoreMode . cataNodeWithParentNodeInfo remove
|
removeIgnored = withIgnoreMode . cataNodeWithParentNodeInfo remove
|
||||||
where
|
where
|
||||||
remove
|
remove
|
||||||
:: Maybe PosInfo
|
:: Maybe PosInfo
|
||||||
@ -178,7 +176,7 @@ removeIgnored fp = withIgnoreMode . cataNodeWithParentNodeInfo remove
|
|||||||
-- found we should report an error.
|
-- found we should report an error.
|
||||||
(IMSParagraph, PARAGRAPH) -> (ssIgnore .= Nothing) $> defNode
|
(IMSParagraph, PARAGRAPH) -> (ssIgnore .= Nothing) $> defNode
|
||||||
(IMSParagraph, x) -> do
|
(IMSParagraph, x) -> do
|
||||||
lift . tell . makeError modePos fp . ParagraphErr $ prettyType x
|
lift . tell . makeError modePos . ParagraphErr $ prettyType x
|
||||||
ssIgnore .= Nothing
|
ssIgnore .= Nothing
|
||||||
Node pos ty <$> sequence subs
|
Node pos ty <$> sequence subs
|
||||||
|
|
||||||
@ -187,7 +185,7 @@ removeIgnored fp = withIgnoreMode . cataNodeWithParentNodeInfo remove
|
|||||||
-- the file should already be ignored when `checkIgnoreFile` is called.
|
-- the file should already be ignored when `checkIgnoreFile` is called.
|
||||||
-- We should report an error if we find it anyway.
|
-- We should report an error if we find it anyway.
|
||||||
(IMSAll, _) -> do
|
(IMSAll, _) -> do
|
||||||
lift . tell $ makeError modePos fp FileErr
|
lift . tell $ makeError modePos FileErr
|
||||||
ssIgnore .= Nothing
|
ssIgnore .= Nothing
|
||||||
Node pos ty <$> sequence subs
|
Node pos ty <$> sequence subs
|
||||||
|
|
||||||
@ -205,14 +203,14 @@ removeIgnored fp = withIgnoreMode . cataNodeWithParentNodeInfo remove
|
|||||||
currentIgnore <- use ssIgnore
|
currentIgnore <- use ssIgnore
|
||||||
case currentIgnore of
|
case currentIgnore of
|
||||||
Just (Ignore {_ignoreMode = IMSLink ParentExpectsLink}) -> do
|
Just (Ignore {_ignoreMode = IMSLink ParentExpectsLink}) -> do
|
||||||
lift $ tell $ makeError modePos fp LinkErr
|
lift $ tell $ makeError modePos LinkErr
|
||||||
ssIgnore .= Nothing
|
ssIgnore .= Nothing
|
||||||
_ -> pass
|
_ -> pass
|
||||||
return node'
|
return node'
|
||||||
|
|
||||||
when (ty == PARAGRAPH) $ use ssIgnore >>= \case
|
when (ty == PARAGRAPH) $ use ssIgnore >>= \case
|
||||||
Just (Ignore (IMSLink ExpectingLinkInParagraph) pragmaPos) ->
|
Just (Ignore (IMSLink ExpectingLinkInParagraph) pragmaPos) ->
|
||||||
lift $ tell $ makeError pragmaPos fp LinkErr
|
lift $ tell $ makeError pragmaPos LinkErr
|
||||||
_ -> pass
|
_ -> pass
|
||||||
|
|
||||||
return scan
|
return scan
|
||||||
@ -236,7 +234,7 @@ removeIgnored fp = withIgnoreMode . cataNodeWithParentNodeInfo remove
|
|||||||
|
|
||||||
(ssIgnore .= Just (Ignore ignoreModeState correctPos)) $> defNode
|
(ssIgnore .= Just (Ignore ignoreModeState correctPos)) $> defNode
|
||||||
InvalidMode msg -> do
|
InvalidMode msg -> do
|
||||||
lift . tell $ makeError correctPos fp $ UnrecognisedErr msg
|
lift . tell $ makeError correctPos $ UnrecognisedErr msg
|
||||||
(ssIgnore .= Nothing) $> defNode
|
(ssIgnore .= Nothing) $> defNode
|
||||||
NotAnAnnotation -> Node pos nodeType <$> sequence subs
|
NotAnAnnotation -> Node pos nodeType <$> sequence subs
|
||||||
where
|
where
|
||||||
@ -249,20 +247,20 @@ removeIgnored fp = withIgnoreMode . cataNodeWithParentNodeInfo remove
|
|||||||
|
|
||||||
withIgnoreMode
|
withIgnoreMode
|
||||||
:: ScannerM Node
|
:: ScannerM Node
|
||||||
-> Writer [ScanError] Node
|
-> Writer [ScanError 'Parse] Node
|
||||||
withIgnoreMode action = action `runStateT` initialScannerState >>= \case
|
withIgnoreMode action = action `runStateT` initialScannerState >>= \case
|
||||||
-- We expect `Ignore` state to be `Nothing` when we reach EOF,
|
-- We expect `Ignore` state to be `Nothing` when we reach EOF,
|
||||||
-- otherwise that means there was an annotation that didn't match
|
-- otherwise that means there was an annotation that didn't match
|
||||||
-- any node, so we have to report that.
|
-- any node, so we have to report that.
|
||||||
(node, ScannerState {_ssIgnore = Just (Ignore mode pos)}) -> case mode of
|
(node, ScannerState {_ssIgnore = Just (Ignore mode pos)}) -> case mode of
|
||||||
IMSParagraph -> do
|
IMSParagraph -> do
|
||||||
tell . makeError pos fp $ ParagraphErr "EOF"
|
tell . makeError pos $ ParagraphErr "EOF"
|
||||||
pure node
|
pure node
|
||||||
IMSLink _ -> do
|
IMSLink _ -> do
|
||||||
tell $ makeError pos fp LinkErr
|
tell $ makeError pos LinkErr
|
||||||
pure node
|
pure node
|
||||||
IMSAll -> do
|
IMSAll -> do
|
||||||
tell $ makeError pos fp FileErr
|
tell $ makeError pos FileErr
|
||||||
pure node
|
pure node
|
||||||
(node, _) -> pure node
|
(node, _) -> pure node
|
||||||
|
|
||||||
@ -273,17 +271,14 @@ foldNode action node@(Node _ _ subs) = do
|
|||||||
b <- concatForM subs (foldNode action)
|
b <- concatForM subs (foldNode action)
|
||||||
return (a <> b)
|
return (a <> b)
|
||||||
|
|
||||||
type ExtractorM a = ReaderT MarkdownConfig (Writer [ScanError]) a
|
type ExtractorM a = ReaderT MarkdownConfig (Writer [ScanError 'Parse]) a
|
||||||
|
|
||||||
-- | Extract information from source tree.
|
-- | Extract information from source tree.
|
||||||
nodeExtractInfo
|
nodeExtractInfo :: Node -> ExtractorM FileInfo
|
||||||
:: FilePath
|
nodeExtractInfo input@(Node _ _ nSubs) = do
|
||||||
-> Node
|
|
||||||
-> ExtractorM FileInfo
|
|
||||||
nodeExtractInfo fp input@(Node _ _ nSubs) = do
|
|
||||||
if checkIgnoreAllFile nSubs
|
if checkIgnoreAllFile nSubs
|
||||||
then return def
|
then return (diffToFileInfo mempty)
|
||||||
else diffToFileInfo <$> (foldNode extractor =<< lift (removeIgnored fp input))
|
else diffToFileInfo <$> (foldNode extractor =<< lift (removeIgnored input))
|
||||||
|
|
||||||
where
|
where
|
||||||
extractor :: Node -> ExtractorM FileInfoDiff
|
extractor :: Node -> ExtractorM FileInfoDiff
|
||||||
@ -332,12 +327,16 @@ nodeExtractInfo fp input@(Node _ _ nSubs) = do
|
|||||||
let rName = nodeExtractText node
|
let rName = nodeExtractText node
|
||||||
rPos = toPosition pos
|
rPos = toPosition pos
|
||||||
link = if null url then rName else url
|
link = if null url then rName else url
|
||||||
|
|
||||||
let (rLink, rAnchor) = case T.splitOn "#" link of
|
let (rLink, rAnchor) = case T.splitOn "#" link of
|
||||||
[t] -> (t, Nothing)
|
[t] -> (t, Nothing)
|
||||||
t : ts -> (t, Just $ T.intercalate "#" ts)
|
t : ts -> (t, Just $ T.intercalate "#" ts)
|
||||||
[] -> error "impossible"
|
[] -> error "impossible"
|
||||||
|
|
||||||
|
let rInfo = referenceInfo rLink
|
||||||
|
|
||||||
return $ FileInfoDiff
|
return $ FileInfoDiff
|
||||||
(DList.singleton $ Reference {rName, rPos, rLink, rAnchor})
|
(DList.singleton $ Reference {rName, rPos, rLink, rAnchor, rInfo})
|
||||||
DList.empty
|
DList.empty
|
||||||
|
|
||||||
-- | Check if there is `ignore all` at the beginning of the file,
|
-- | Check if there is `ignore all` at the beginning of the file,
|
||||||
@ -361,10 +360,9 @@ defNode = Node Nothing DOCUMENT [] -- hard-coded default Node
|
|||||||
|
|
||||||
makeError
|
makeError
|
||||||
:: Maybe PosInfo
|
:: Maybe PosInfo
|
||||||
-> FilePath
|
|
||||||
-> ScanErrorDescription
|
-> ScanErrorDescription
|
||||||
-> [ScanError]
|
-> [ScanError 'Parse]
|
||||||
makeError pos fp errDescription = one $ ScanError (toPosition pos) fp errDescription
|
makeError pos errDescription = one $ mkParseScanError (toPosition pos) errDescription
|
||||||
|
|
||||||
getCommentContent :: Node -> Maybe Text
|
getCommentContent :: Node -> Maybe Text
|
||||||
getCommentContent node = do
|
getCommentContent node = do
|
||||||
@ -406,16 +404,18 @@ textToMode ("ignore" : [x])
|
|||||||
| otherwise = InvalidMode x
|
| otherwise = InvalidMode x
|
||||||
textToMode _ = NotAnAnnotation
|
textToMode _ = NotAnAnnotation
|
||||||
|
|
||||||
parseFileInfo :: MarkdownConfig -> FilePath -> LT.Text -> (FileInfo, [ScanError])
|
parseFileInfo :: MarkdownConfig -> LT.Text -> (FileInfo, [ScanError 'Parse])
|
||||||
parseFileInfo config fp input
|
parseFileInfo config input
|
||||||
= runWriter
|
= runWriter
|
||||||
$ flip runReaderT config
|
$ flip runReaderT config
|
||||||
$ nodeExtractInfo fp
|
$ nodeExtractInfo
|
||||||
$ commonmarkToNode [optFootnotes] [extAutolink]
|
$ commonmarkToNode [optFootnotes] [extAutolink]
|
||||||
$ toStrict input
|
$ toStrict input
|
||||||
|
|
||||||
markdownScanner :: MarkdownConfig -> ScanAction
|
markdownScanner :: MarkdownConfig -> ScanAction
|
||||||
markdownScanner config path = parseFileInfo config path . decodeUtf8 <$> BSL.readFile path
|
markdownScanner config canonicalFile =
|
||||||
|
parseFileInfo config . decodeUtf8
|
||||||
|
<$> BSL.readFile (unCanonicalPath canonicalFile)
|
||||||
|
|
||||||
markdownSupport :: MarkdownConfig -> ([Extension], ScanAction)
|
markdownSupport :: MarkdownConfig -> ([Extension], ScanAction)
|
||||||
markdownSupport config = ([".md"], markdownScanner config)
|
markdownSupport config = ([".md"], markdownScanner config)
|
||||||
|
@ -6,9 +6,20 @@
|
|||||||
module Xrefcheck.System
|
module Xrefcheck.System
|
||||||
( readingSystem
|
( readingSystem
|
||||||
, askWithinCI
|
, askWithinCI
|
||||||
, RelGlobPattern
|
|
||||||
|
, CanonicalPath
|
||||||
|
, canonicalizePath
|
||||||
|
, unCanonicalPath
|
||||||
|
, getDirsBetweenRootAndFile
|
||||||
|
, getPosixRelativeChild
|
||||||
|
, getPosixRelativeOrAbsoluteChild
|
||||||
|
, hasIndirectionThroughParent
|
||||||
|
, takeDirectory
|
||||||
|
, takeExtension
|
||||||
|
, (</)
|
||||||
|
|
||||||
|
, RelGlobPattern (unRelGlobPattern)
|
||||||
, mkGlobPattern
|
, mkGlobPattern
|
||||||
, normaliseGlobPattern
|
|
||||||
, bindGlobPattern
|
, bindGlobPattern
|
||||||
, matchesGlobPatterns
|
, matchesGlobPatterns
|
||||||
) where
|
) where
|
||||||
@ -17,15 +28,14 @@ import Universum
|
|||||||
|
|
||||||
import Data.Aeson (FromJSON (..), withText)
|
import Data.Aeson (FromJSON (..), withText)
|
||||||
import Data.Char qualified as C
|
import Data.Char qualified as C
|
||||||
import Data.Coerce (coerce)
|
import Data.List (stripPrefix)
|
||||||
import GHC.IO.Unsafe (unsafePerformIO)
|
import GHC.IO.Unsafe (unsafePerformIO)
|
||||||
import System.Directory (canonicalizePath)
|
import System.Directory qualified as Directory
|
||||||
import System.Environment (lookupEnv)
|
import System.Environment (lookupEnv)
|
||||||
|
import System.FilePath qualified as FP
|
||||||
import System.FilePath.Glob qualified as Glob
|
import System.FilePath.Glob qualified as Glob
|
||||||
import System.FilePath.Posix (isRelative, (</>))
|
import System.FilePath.Posix qualified as FPP
|
||||||
import Text.Interpolation.Nyan
|
import Text.Interpolation.Nyan (int, rmode')
|
||||||
|
|
||||||
import Xrefcheck.Util (normaliseWithNoTrailing)
|
|
||||||
|
|
||||||
-- | We can quite safely treat surrounding filesystem as frozen,
|
-- | We can quite safely treat surrounding filesystem as frozen,
|
||||||
-- so IO reading operations can be turned into pure values.
|
-- so IO reading operations can be turned into pure values.
|
||||||
@ -36,21 +46,125 @@ readingSystem = unsafePerformIO
|
|||||||
-- Check the respective env variable which is usually set in all CIs.
|
-- Check the respective env variable which is usually set in all CIs.
|
||||||
askWithinCI :: IO Bool
|
askWithinCI :: IO Bool
|
||||||
askWithinCI = lookupEnv "CI" <&> \case
|
askWithinCI = lookupEnv "CI" <&> \case
|
||||||
Just "1" -> True
|
Just "1" -> True
|
||||||
Just (map C.toLower -> "true") -> True
|
Just (map C.toLower -> "true") -> True
|
||||||
_ -> False
|
_ -> False
|
||||||
|
|
||||||
-- | Glob pattern relative to repository root. Should be created via @mkGlobPattern@
|
-- | A FilePath that has been canonicalized.
|
||||||
newtype RelGlobPattern = RelGlobPattern FilePath
|
--
|
||||||
|
-- It should be created via 'canonicalizePath'.
|
||||||
|
--
|
||||||
|
-- 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)
|
||||||
|
|
||||||
|
canonicalizePath :: FilePath -> IO CanonicalPath
|
||||||
|
canonicalizePath = fmap canonicalize . Directory.makeAbsolute
|
||||||
|
where
|
||||||
|
canonicalize :: FilePath -> CanonicalPath
|
||||||
|
canonicalize = UnsafeCanonicalPath
|
||||||
|
. expandIndirections
|
||||||
|
. FP.normalise
|
||||||
|
. FP.dropTrailingPathSeparator
|
||||||
|
|
||||||
|
expandIndirections :: FilePath -> FilePath
|
||||||
|
expandIndirections = FP.joinPath
|
||||||
|
. reverse
|
||||||
|
. expand 0
|
||||||
|
. reverse
|
||||||
|
. FP.splitDirectories
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
-- | 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).
|
||||||
|
--
|
||||||
|
-- It returns Nothing if child cannot be reached from root downwards
|
||||||
|
-- in the filesystem tree.
|
||||||
|
--
|
||||||
|
-- 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
|
||||||
|
|
||||||
|
dropLeadingSepAndEmptyCase :: FilePath -> FilePath
|
||||||
|
dropLeadingSepAndEmptyCase path = case dropWhile FP.isPathSeparator path of
|
||||||
|
"" -> "."
|
||||||
|
other -> other
|
||||||
|
|
||||||
|
-- | 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
|
||||||
|
-- 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
|
||||||
|
|
||||||
|
-- | Extend some 'CanonicalPath' with a given relative 'FilePath'.
|
||||||
|
--
|
||||||
|
-- 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
|
||||||
|
}
|
||||||
|
|
||||||
mkGlobPattern :: ToString s => s -> Either String RelGlobPattern
|
mkGlobPattern :: ToString s => s -> Either String RelGlobPattern
|
||||||
mkGlobPattern path = do
|
mkGlobPattern path = do
|
||||||
let spath = toString path
|
let spath = toString path
|
||||||
unless (isRelative spath) $ Left $
|
unless (FPP.isRelative spath) $ Left $
|
||||||
"Expected a relative glob pattern, but got " <> spath
|
"Expected a relative glob pattern, but got " <> spath
|
||||||
-- Checking correctness of glob, e.g. "a[b" is incorrect
|
-- Checking correctness of glob, e.g. "a[b" is incorrect
|
||||||
case Glob.tryCompileWith globCompileOptions spath of
|
case Glob.tryCompileWith globCompileOptions spath of
|
||||||
Right _ -> return (RelGlobPattern spath)
|
Right _ -> return (UnsafeRelGlobPattern spath)
|
||||||
Left err -> Left
|
Left err -> Left
|
||||||
[int||
|
[int||
|
||||||
Glob pattern compilation failed.
|
Glob pattern compilation failed.
|
||||||
@ -61,25 +175,20 @@ mkGlobPattern path = do
|
|||||||
Special characters in file names can be escaped using square brackets, e.g. <a> -> [<]a[>].
|
Special characters in file names can be escaped using square brackets, e.g. <a> -> [<]a[>].
|
||||||
|]
|
|]
|
||||||
|
|
||||||
normaliseGlobPattern :: RelGlobPattern -> RelGlobPattern
|
bindGlobPattern :: CanonicalPath -> RelGlobPattern -> Glob.Pattern
|
||||||
normaliseGlobPattern = RelGlobPattern . normaliseWithNoTrailing . coerce
|
bindGlobPattern root (UnsafeRelGlobPattern relPat) = readingSystem $ do
|
||||||
|
UnsafeCanonicalPath absPat <- root </ relPat
|
||||||
bindGlobPattern :: FilePath -> RelGlobPattern -> Glob.Pattern
|
|
||||||
bindGlobPattern root (RelGlobPattern relPat) = readingSystem $ do
|
|
||||||
-- TODO [#26] try to avoid using canonicalization
|
|
||||||
absPat <- canonicalizePath (root </> relPat)
|
|
||||||
case Glob.tryCompileWith globCompileOptions absPat of
|
case Glob.tryCompileWith globCompileOptions absPat of
|
||||||
Left err -> error $
|
Left err -> error $
|
||||||
"Glob pattern compilation failed after canonicalization: " <> toText err
|
"Glob pattern compilation failed after canonicalization: " <> toText err
|
||||||
Right pat ->
|
Right pat ->
|
||||||
return pat
|
return pat
|
||||||
|
|
||||||
matchesGlobPatterns :: FilePath -> [RelGlobPattern] -> FilePath -> Bool
|
matchesGlobPatterns :: CanonicalPath -> [RelGlobPattern] -> CanonicalPath -> Bool
|
||||||
matchesGlobPatterns root globPatterns file = or
|
matchesGlobPatterns root globPatterns file = or
|
||||||
[ Glob.match pat cFile
|
[ Glob.match pat $ unCanonicalPath file
|
||||||
| globPattern <- globPatterns
|
| globPattern <- globPatterns
|
||||||
, let pat = bindGlobPattern root globPattern
|
, let pat = bindGlobPattern root globPattern
|
||||||
, let cFile = readingSystem $ canonicalizePath file
|
|
||||||
]
|
]
|
||||||
|
|
||||||
instance FromJSON RelGlobPattern where
|
instance FromJSON RelGlobPattern where
|
||||||
|
@ -9,7 +9,6 @@ module Xrefcheck.Util
|
|||||||
, postfixFields
|
, postfixFields
|
||||||
, (-:)
|
, (-:)
|
||||||
, aesonConfigOption
|
, aesonConfigOption
|
||||||
, normaliseWithNoTrailing
|
|
||||||
, posixTimeToTimeSecond
|
, posixTimeToTimeSecond
|
||||||
, utcTimeToTimeSecond
|
, utcTimeToTimeSecond
|
||||||
, module Xrefcheck.Util.Colorize
|
, module Xrefcheck.Util.Colorize
|
||||||
@ -27,7 +26,6 @@ import Data.Time (UTCTime)
|
|||||||
import Data.Time.Clock (nominalDiffTimeToSeconds)
|
import Data.Time.Clock (nominalDiffTimeToSeconds)
|
||||||
import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)
|
import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)
|
||||||
import Fmt (Builder)
|
import Fmt (Builder)
|
||||||
import System.FilePath.Posix (dropTrailingPathSeparator, normalise)
|
|
||||||
import Time (Second, Time (..), sec)
|
import Time (Second, Time (..), sec)
|
||||||
|
|
||||||
import Xrefcheck.Util.Colorize
|
import Xrefcheck.Util.Colorize
|
||||||
@ -54,9 +52,6 @@ type family Field f a where
|
|||||||
Field Identity a = a
|
Field Identity a = a
|
||||||
Field Maybe a = Maybe a
|
Field Maybe a = Maybe a
|
||||||
|
|
||||||
normaliseWithNoTrailing :: FilePath -> FilePath
|
|
||||||
normaliseWithNoTrailing = dropTrailingPathSeparator . normalise
|
|
||||||
|
|
||||||
posixTimeToTimeSecond :: POSIXTime -> Time Second
|
posixTimeToTimeSecond :: POSIXTime -> Time Second
|
||||||
posixTimeToTimeSecond posixTime =
|
posixTimeToTimeSecond posixTime =
|
||||||
let picos@(MkFixed ps) = nominalDiffTimeToSeconds posixTime
|
let picos@(MkFixed ps) = nominalDiffTimeToSeconds posixTime
|
||||||
|
@ -35,11 +35,15 @@ import Universum
|
|||||||
|
|
||||||
import Control.Concurrent.Async (Async, async, cancel, poll, wait, withAsync)
|
import Control.Concurrent.Async (Async, async, cancel, poll, wait, withAsync)
|
||||||
import Control.Exception (AsyncException (..), throwIO)
|
import Control.Exception (AsyncException (..), throwIO)
|
||||||
|
import Control.Exception.Safe (handleAsync, handleJust)
|
||||||
import Control.Monad.Except (MonadError (..))
|
import Control.Monad.Except (MonadError (..))
|
||||||
|
import Data.Bits (toIntegralSized)
|
||||||
import Data.ByteString qualified as BS
|
import Data.ByteString qualified as BS
|
||||||
|
import Data.List (lookup)
|
||||||
import Data.List qualified as L
|
import Data.List qualified as L
|
||||||
import Data.Map qualified as M
|
import Data.Map qualified as M
|
||||||
import Data.Reflection (Given)
|
import Data.Reflection (Given)
|
||||||
|
import Data.Text (toCaseFold)
|
||||||
import Data.Text.Metrics (damerauLevenshteinNorm)
|
import Data.Text.Metrics (damerauLevenshteinNorm)
|
||||||
import Data.Time (UTCTime, defaultTimeLocale, formatTime, readPTime, rfc822DateFormat)
|
import Data.Time (UTCTime, defaultTimeLocale, formatTime, readPTime, rfc822DateFormat)
|
||||||
import Data.Time.Clock.POSIX (getPOSIXTime)
|
import Data.Time.Clock.POSIX (getPOSIXTime)
|
||||||
@ -57,8 +61,8 @@ import Network.HTTP.Req
|
|||||||
defaultHttpConfig, ignoreResponse, req, runReq, useURI)
|
defaultHttpConfig, ignoreResponse, req, runReq, useURI)
|
||||||
import Network.HTTP.Types.Header (hRetryAfter)
|
import Network.HTTP.Types.Header (hRetryAfter)
|
||||||
import Network.HTTP.Types.Status (Status, statusCode, statusMessage)
|
import Network.HTTP.Types.Status (Status, statusCode, statusMessage)
|
||||||
import System.FilePath.Posix
|
import System.FilePath (isPathSeparator)
|
||||||
(equalFilePath, joinPath, makeRelative, normalise, splitDirectories, takeDirectory, (</>))
|
import System.FilePath.Posix ((</>))
|
||||||
import Text.Interpolation.Nyan
|
import Text.Interpolation.Nyan
|
||||||
import Text.ParserCombinators.ReadPrec qualified as ReadPrec (lift)
|
import Text.ParserCombinators.ReadPrec qualified as ReadPrec (lift)
|
||||||
import Text.Regex.TDFA.Text (Regex, regexec)
|
import Text.Regex.TDFA.Text (Regex, regexec)
|
||||||
@ -66,10 +70,6 @@ import Text.URI (Authority (..), ParseExceptionBs, URI (..), mkURIBs)
|
|||||||
import Time (RatioNat, Second, Time (..), ms, sec, threadDelay, timeout, (+:+), (-:-))
|
import Time (RatioNat, Second, Time (..), ms, sec, threadDelay, timeout, (+:+), (-:-))
|
||||||
import URI.ByteString qualified as URIBS
|
import URI.ByteString qualified as URIBS
|
||||||
|
|
||||||
import Control.Exception.Safe (handleAsync, handleJust)
|
|
||||||
import Data.Bits (toIntegralSized)
|
|
||||||
import Data.List (lookup)
|
|
||||||
import Data.Text (toCaseFold)
|
|
||||||
import Xrefcheck.Config
|
import Xrefcheck.Config
|
||||||
import Xrefcheck.Core
|
import Xrefcheck.Core
|
||||||
import Xrefcheck.Orphans ()
|
import Xrefcheck.Orphans ()
|
||||||
@ -265,7 +265,6 @@ reportVerifyErrs errs = fmt
|
|||||||
Invalid references dumped, #{length errs} in total.
|
Invalid references dumped, #{length errs} in total.
|
||||||
|]
|
|]
|
||||||
|
|
||||||
|
|
||||||
data RetryAfter = Date UTCTime | Seconds (Time Second)
|
data RetryAfter = Date UTCTime | Seconds (Time Second)
|
||||||
deriving stock (Show, Eq)
|
deriving stock (Show, Eq)
|
||||||
|
|
||||||
@ -353,19 +352,17 @@ verifyRepo
|
|||||||
=> Rewrite
|
=> Rewrite
|
||||||
-> Config
|
-> Config
|
||||||
-> VerifyMode
|
-> VerifyMode
|
||||||
-> FilePath
|
|
||||||
-> RepoInfo
|
-> RepoInfo
|
||||||
-> IO (VerifyResult $ WithReferenceLoc VerifyError)
|
-> IO (VerifyResult $ WithReferenceLoc VerifyError)
|
||||||
verifyRepo
|
verifyRepo
|
||||||
rw
|
rw
|
||||||
config@Config{..}
|
config@Config{..}
|
||||||
mode
|
mode
|
||||||
root
|
repoInfo@RepoInfo{..}
|
||||||
repoInfo'@(RepoInfo files _)
|
|
||||||
= do
|
= do
|
||||||
let toScan = do
|
let toScan = do
|
||||||
(file, fileInfo) <- M.toList files
|
(file, fileInfo) <- toPairs riFiles
|
||||||
guard . not $ matchesGlobPatterns root (ecIgnoreRefsFrom cExclusions) file
|
guard . not $ matchesGlobPatterns riRoot (ecIgnoreRefsFrom cExclusions) file
|
||||||
case fileInfo of
|
case fileInfo of
|
||||||
Scanned fi -> do
|
Scanned fi -> do
|
||||||
ref <- _fiReferences fi
|
ref <- _fiReferences fi
|
||||||
@ -379,7 +376,7 @@ verifyRepo
|
|||||||
|
|
||||||
accumulated <- loopAsyncUntil (printer progressRef) do
|
accumulated <- loopAsyncUntil (printer progressRef) do
|
||||||
forConcurrentlyCaching toScan ifExternalThenCache $ \(file, ref) ->
|
forConcurrentlyCaching toScan ifExternalThenCache $ \(file, ref) ->
|
||||||
verifyReference config mode progressRef repoInfo' root file ref
|
verifyReference config mode progressRef repoInfo file ref
|
||||||
case accumulated of
|
case accumulated of
|
||||||
Right res -> return $ fold res
|
Right res -> return $ fold res
|
||||||
Left (exception, partialRes) -> do
|
Left (exception, partialRes) -> do
|
||||||
@ -408,11 +405,12 @@ verifyRepo
|
|||||||
threadDelay (ms 100)
|
threadDelay (ms 100)
|
||||||
|
|
||||||
ifExternalThenCache :: (a, Reference) -> NeedsCaching Text
|
ifExternalThenCache :: (a, Reference) -> NeedsCaching Text
|
||||||
ifExternalThenCache (_, Reference{..}) = case locationType rLink of
|
ifExternalThenCache (_, Reference{..}) =
|
||||||
ExternalLoc -> CacheUnderKey rLink
|
if isExternal rInfo
|
||||||
_ -> NoCaching
|
then CacheUnderKey rLink
|
||||||
|
else NoCaching
|
||||||
|
|
||||||
shouldCheckLocType :: VerifyMode -> LocationType -> Bool
|
shouldCheckLocType :: VerifyMode -> ReferenceInfo -> Bool
|
||||||
shouldCheckLocType mode locType
|
shouldCheckLocType mode locType
|
||||||
| isExternal locType = shouldCheckExternal mode
|
| isExternal locType = shouldCheckExternal mode
|
||||||
| isLocal locType = shouldCheckLocal mode
|
| isLocal locType = shouldCheckLocal mode
|
||||||
@ -423,29 +421,31 @@ verifyReference
|
|||||||
-> VerifyMode
|
-> VerifyMode
|
||||||
-> IORef VerifyProgress
|
-> IORef VerifyProgress
|
||||||
-> RepoInfo
|
-> RepoInfo
|
||||||
-> FilePath
|
-> CanonicalPath
|
||||||
-> FilePath
|
|
||||||
-> Reference
|
-> Reference
|
||||||
-> IO (VerifyResult $ WithReferenceLoc VerifyError)
|
-> IO (VerifyResult $ WithReferenceLoc VerifyError)
|
||||||
verifyReference
|
verifyReference
|
||||||
config@Config{..}
|
config@Config{..}
|
||||||
mode
|
mode
|
||||||
progressRef
|
progressRef
|
||||||
(RepoInfo files dirs)
|
repoInfo@RepoInfo{..}
|
||||||
root
|
file
|
||||||
fileWithReference
|
|
||||||
ref@Reference{..}
|
ref@Reference{..}
|
||||||
= retryVerification 0 $ do
|
= retryVerification 0 $
|
||||||
let locType = locationType rLink
|
if shouldCheckLocType mode rInfo
|
||||||
if shouldCheckLocType mode locType
|
then case rInfo of
|
||||||
then case locType of
|
RIFileLocal -> checkRef rAnchor riRoot file ""
|
||||||
FileLocalLoc -> checkRef rAnchor fileWithReference
|
RIFileRelative -> do
|
||||||
RelativeLoc -> checkRef rAnchor
|
let shownFilepath = getPosixRelativeOrAbsoluteChild riRoot (takeDirectory file)
|
||||||
(normalise $ takeDirectory fileWithReference
|
</> toString rLink
|
||||||
</> toString (canonizeLocalRef rLink))
|
canonicalPath <- takeDirectory file </ toString rLink
|
||||||
AbsoluteLoc -> checkRef rAnchor (root <> toString rLink)
|
checkRef rAnchor riRoot canonicalPath shownFilepath
|
||||||
ExternalLoc -> checkExternalResource config rLink
|
RIFileAbsolute -> do
|
||||||
OtherLoc -> verifying pass
|
let shownFilepath = dropWhile isPathSeparator (toString rLink)
|
||||||
|
canonicalPath <- riRoot </ shownFilepath
|
||||||
|
checkRef rAnchor riRoot canonicalPath shownFilepath
|
||||||
|
RIExternal -> checkExternalResource config rLink
|
||||||
|
RIOtherProtocol -> verifying pass
|
||||||
else return mempty
|
else return mempty
|
||||||
where
|
where
|
||||||
retryVerification
|
retryVerification
|
||||||
@ -472,7 +472,7 @@ verifyReference
|
|||||||
. alterProgressErrors res numberOfRetries
|
. alterProgressErrors res numberOfRetries
|
||||||
|
|
||||||
atomicModifyIORef' progressRef $ \VerifyProgress{..} ->
|
atomicModifyIORef' progressRef $ \VerifyProgress{..} ->
|
||||||
( if isExternal $ locationType rLink
|
( if isExternal rInfo
|
||||||
then VerifyProgress{ vrExternal =
|
then VerifyProgress{ vrExternal =
|
||||||
let vrExternalAdvanced = moveProgress vrExternal
|
let vrExternalAdvanced = moveProgress vrExternal
|
||||||
in if toRetry
|
in if toRetry
|
||||||
@ -488,7 +488,8 @@ verifyReference
|
|||||||
then do
|
then do
|
||||||
threadDelay currentRetryAfter
|
threadDelay currentRetryAfter
|
||||||
retryVerification (numberOfRetries + 1) resIO
|
retryVerification (numberOfRetries + 1) resIO
|
||||||
else return $ fmap (WithReferenceLoc fileWithReference ref) res
|
else return . (<$> res) $
|
||||||
|
WithReferenceLoc (getPosixRelativeOrAbsoluteChild riRoot file) ref
|
||||||
|
|
||||||
alterOverallProgress
|
alterOverallProgress
|
||||||
:: (Num a)
|
:: (Num a)
|
||||||
@ -530,76 +531,51 @@ verifyReference
|
|||||||
VerifyResult [ExternalHttpTooManyRequests retryAfter] -> retryAfter
|
VerifyResult [ExternalHttpTooManyRequests retryAfter] -> retryAfter
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|
||||||
isVirtual = matchesGlobPatterns root (ecIgnoreLocalRefsTo cExclusions)
|
isVirtual canonicalRoot = matchesGlobPatterns canonicalRoot (ecIgnoreLocalRefsTo cExclusions)
|
||||||
|
|
||||||
checkRef mAnchor referredFile = verifying $
|
-- Checks a local file reference.
|
||||||
unless (isVirtual referredFile) do
|
--
|
||||||
checkReferredFileIsInsideRepo referredFile
|
-- The `shownFilepath` argument is intended to be shown in the error
|
||||||
mFileStatus <- tryGetFileStatus referredFile
|
-- 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 mAnchor canonicalRoot referredFile shownFilepath = verifying $
|
||||||
|
unless (isVirtual canonicalRoot referredFile) do
|
||||||
|
when (hasIndirectionThroughParent shownFilepath) $
|
||||||
|
throwError $ LocalFileOutsideRepo shownFilepath
|
||||||
|
|
||||||
|
referredFileRelative <-
|
||||||
|
case getPosixRelativeChild canonicalRoot referredFile of
|
||||||
|
Just ps -> pure ps
|
||||||
|
Nothing -> throwError (LocalFileOutsideRepo shownFilepath)
|
||||||
|
|
||||||
|
mFileStatus <- tryGetFileStatus referredFileRelative referredFile
|
||||||
case mFileStatus of
|
case mFileStatus of
|
||||||
Right (Scanned referredFileInfo) -> whenJust mAnchor $
|
Right (Scanned referredFileInfo) -> whenJust mAnchor $
|
||||||
checkAnchor referredFile (_fiAnchors referredFileInfo)
|
checkAnchor referredFileRelative (_fiAnchors referredFileInfo)
|
||||||
Right NotScannable -> pass -- no support for such file, can do nothing
|
Right NotAddedToGit -> throwError (LinkTargetNotAddedToGit referredFileRelative)
|
||||||
Right NotAddedToGit -> throwError (LinkTargetNotAddedToGit referredFile)
|
Left UntrackedDirectory -> throwError (LinkTargetNotAddedToGit referredFileRelative)
|
||||||
Left UntrackedDirectory -> throwError (LinkTargetNotAddedToGit referredFile)
|
Right NotScannable -> pass -- no support for such file, can do nothing
|
||||||
Left TrackedDirectory -> pass -- path leads to directory, currently
|
Left TrackedDirectory -> pass -- path leads to directory, currently
|
||||||
-- if such link contain anchor, we ignore it
|
-- if such link contain anchor, we ignore it
|
||||||
|
|
||||||
-- expands ".." and "."
|
caseInsensitive = caseInsensitiveAnchors . mcFlavor . scMarkdown $ cScanners
|
||||||
-- expandIndirections "a/b/../c" = "a/c"
|
|
||||||
-- expandIndirections "a/b/c/../../d" = "a/d"
|
|
||||||
-- expandIndirections "../../a" = "../../a"
|
|
||||||
-- expandIndirections "a/./b" = "a/b"
|
|
||||||
-- expandIndirections "a/b/./../c" = "a/c"
|
|
||||||
expandIndirections :: FilePath -> FilePath
|
|
||||||
expandIndirections = joinPath . reverse . expand 0 . reverse . splitDirectories
|
|
||||||
where
|
|
||||||
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 ".."
|
|
||||||
|
|
||||||
checkReferredFileIsInsideRepo file = unless
|
|
||||||
(noNegativeNesting $ makeRelative root file) $
|
|
||||||
throwError (LocalFileOutsideRepo file)
|
|
||||||
where
|
|
||||||
-- checks that relative filepath fully belongs to the root directory
|
|
||||||
-- noNegativeNesting "a/../b" = True
|
|
||||||
-- noNegativeNesting "a/../../b" = False
|
|
||||||
noNegativeNesting path = all (>= 0) $ scanl
|
|
||||||
(\n dir -> n + nestingChange dir)
|
|
||||||
(0 :: Integer)
|
|
||||||
$ splitDirectories path
|
|
||||||
|
|
||||||
nestingChange ".." = -1
|
|
||||||
nestingChange "." = 0
|
|
||||||
nestingChange _ = 1
|
|
||||||
|
|
||||||
-- Returns `Nothing` when path corresponds to an existing (and tracked) directory
|
-- Returns `Nothing` when path corresponds to an existing (and tracked) directory
|
||||||
tryGetFileStatus :: FilePath -> ExceptT VerifyError IO (Either DirectoryStatus FileStatus)
|
tryGetFileStatus :: FilePath -> CanonicalPath -> ExceptT VerifyError IO (Either DirectoryStatus FileStatus)
|
||||||
tryGetFileStatus file
|
tryGetFileStatus filePath canonicalPath
|
||||||
| Just f <- mFile = return $ Right f
|
| Just f <- lookupFile canonicalPath repoInfo = return (Right f)
|
||||||
| Just d <- mDir = return $ Left d
|
| Just d <- lookupDirectory canonicalPath repoInfo = return (Left d)
|
||||||
| otherwise = throwError (LocalFileDoesNotExist file)
|
| otherwise = throwError (LocalFileDoesNotExist filePath)
|
||||||
where
|
|
||||||
matchesFilePath :: FilePath -> Bool
|
|
||||||
matchesFilePath = equalFilePath $ expandIndirections file
|
|
||||||
|
|
||||||
mFile :: Maybe FileStatus
|
checkAnchor filePath fileAnchors anchor = do
|
||||||
mFile = (files M.!) <$> find matchesFilePath (M.keys files)
|
checkAnchorReferenceAmbiguity filePath fileAnchors anchor
|
||||||
|
checkDeduplicatedAnchorReference filePath fileAnchors anchor
|
||||||
mDir :: Maybe DirectoryStatus
|
|
||||||
mDir = (dirs M.!) <$> find matchesFilePath (M.keys dirs)
|
|
||||||
|
|
||||||
checkAnchor file fileAnchors anchor = do
|
|
||||||
checkAnchorReferenceAmbiguity file fileAnchors anchor
|
|
||||||
checkDeduplicatedAnchorReference file fileAnchors anchor
|
|
||||||
checkAnchorExists fileAnchors anchor
|
checkAnchorExists fileAnchors anchor
|
||||||
|
|
||||||
anchorNameEq =
|
anchorNameEq =
|
||||||
if caseInsensitiveAnchors . mcFlavor . scMarkdown $ cScanners
|
if caseInsensitive
|
||||||
then (==) `on` toCaseFold
|
then (==) `on` toCaseFold
|
||||||
else (==)
|
else (==)
|
||||||
|
|
||||||
@ -607,16 +583,16 @@ verifyReference
|
|||||||
-- has added a suffix to the duplicate, and now the original is referrenced -
|
-- has added a suffix to the duplicate, and now the original is referrenced -
|
||||||
-- such links are pretty fragile and we discourage their use despite
|
-- such links are pretty fragile and we discourage their use despite
|
||||||
-- they are in fact unambiguous.
|
-- they are in fact unambiguous.
|
||||||
checkAnchorReferenceAmbiguity file fileAnchors anchor = do
|
checkAnchorReferenceAmbiguity filePath fileAnchors anchor = do
|
||||||
let similarAnchors = filter (anchorNameEq anchor . aName) fileAnchors
|
let similarAnchors = filter (anchorNameEq anchor . aName) fileAnchors
|
||||||
when (length similarAnchors > 1) $
|
when (length similarAnchors > 1) $
|
||||||
throwError $ AmbiguousAnchorRef file anchor (Exts.fromList similarAnchors)
|
throwError $ AmbiguousAnchorRef filePath anchor (Exts.fromList similarAnchors)
|
||||||
|
|
||||||
-- Similar to the previous one, but for the case when we reference the
|
-- Similar to the previous one, but for the case when we reference the
|
||||||
-- renamed duplicate.
|
-- renamed duplicate.
|
||||||
checkDeduplicatedAnchorReference file fileAnchors anchor =
|
checkDeduplicatedAnchorReference filePath fileAnchors anchor =
|
||||||
whenJust (stripAnchorDupNo anchor) $ \origAnchor ->
|
whenJust (stripAnchorDupNo anchor) $ \origAnchor ->
|
||||||
checkAnchorReferenceAmbiguity file fileAnchors origAnchor
|
checkAnchorReferenceAmbiguity filePath fileAnchors origAnchor
|
||||||
|
|
||||||
checkAnchorExists givenAnchors anchor =
|
checkAnchorExists givenAnchors anchor =
|
||||||
case find (anchorNameEq anchor . aName) givenAnchors of
|
case find (anchorNameEq anchor . aName) givenAnchors of
|
||||||
|
63
tests/Test/Xrefcheck/CanonicalPathSpec.hs
Normal file
63
tests/Test/Xrefcheck/CanonicalPathSpec.hs
Normal file
@ -0,0 +1,63 @@
|
|||||||
|
{- 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"
|
||||||
|
]
|
||||||
|
]
|
||||||
|
]
|
@ -22,19 +22,19 @@ test_ignoreAnnotations =
|
|||||||
[ testCase "Check if broken link annotation produce error" do
|
[ testCase "Check if broken link annotation produce error" do
|
||||||
let file = "tests/markdowns/with-annotations/no_link.md"
|
let file = "tests/markdowns/with-annotations/no_link.md"
|
||||||
errs <- getErrs file
|
errs <- getErrs file
|
||||||
errs @?= makeError (Just $ PosInfo 7 1 7 31) file LinkErr
|
errs @?= makeError (Just $ PosInfo 7 1 7 31) LinkErr
|
||||||
, testCase "Check if broken paragraph annotation produce error" do
|
, testCase "Check if broken paragraph annotation produce error" do
|
||||||
let file = "tests/markdowns/with-annotations/no_paragraph.md"
|
let file = "tests/markdowns/with-annotations/no_paragraph.md"
|
||||||
errs <- getErrs file
|
errs <- getErrs file
|
||||||
errs @?= makeError (Just $ PosInfo 7 1 7 35) file (ParagraphErr "HEADING")
|
errs @?= makeError (Just $ PosInfo 7 1 7 35) (ParagraphErr "HEADING")
|
||||||
, testCase "Check if broken ignore all annotation produce error" do
|
, testCase "Check if broken ignore all annotation produce error" do
|
||||||
let file = "tests/markdowns/with-annotations/unexpected_ignore_file.md"
|
let file = "tests/markdowns/with-annotations/unexpected_ignore_file.md"
|
||||||
errs <- getErrs file
|
errs <- getErrs file
|
||||||
errs @?= makeError (Just $ PosInfo 9 1 9 29) file FileErr
|
errs @?= makeError (Just $ PosInfo 9 1 9 29) FileErr
|
||||||
, testCase "Check if broken unrecognised annotation produce error" do
|
, testCase "Check if broken unrecognised annotation produce error" do
|
||||||
let file = "tests/markdowns/with-annotations/unrecognised_option.md"
|
let file = "tests/markdowns/with-annotations/unrecognised_option.md"
|
||||||
errs <- getErrs file
|
errs <- getErrs file
|
||||||
errs @?= makeError (Just $ PosInfo 7 1 7 46) file (UnrecognisedErr "unrecognised-option")
|
errs @?= makeError (Just $ PosInfo 7 1 7 46) (UnrecognisedErr "unrecognised-option")
|
||||||
]
|
]
|
||||||
, testGroup "\"ignore link\" mode"
|
, testGroup "\"ignore link\" mode"
|
||||||
[ testCase "Check \"ignore link\" performance" $ do
|
[ testCase "Check \"ignore link\" performance" $ do
|
||||||
@ -42,7 +42,7 @@ test_ignoreAnnotations =
|
|||||||
(fi, errs) <- parse GitHub file
|
(fi, errs) <- parse GitHub file
|
||||||
getRefs fi @?=
|
getRefs fi @?=
|
||||||
["team", "team", "team", "hire-us", "how-we-work", "privacy", "link2", "link2", "link3"]
|
["team", "team", "team", "hire-us", "how-we-work", "privacy", "link2", "link2", "link3"]
|
||||||
errs @?= makeError (Just $ PosInfo 42 1 42 31) file LinkErr
|
errs @?= makeError (Just $ PosInfo 42 1 42 31) LinkErr
|
||||||
]
|
]
|
||||||
, testGroup "\"ignore paragraph\" mode"
|
, testGroup "\"ignore paragraph\" mode"
|
||||||
[ testCase "Check \"ignore paragraph\" performance" $ do
|
[ testCase "Check \"ignore paragraph\" performance" $ do
|
||||||
@ -61,5 +61,5 @@ test_ignoreAnnotations =
|
|||||||
getRefs :: FileInfo -> [Text]
|
getRefs :: FileInfo -> [Text]
|
||||||
getRefs fi = map rName $ fi ^. fiReferences
|
getRefs fi = map rName $ fi ^. fiReferences
|
||||||
|
|
||||||
getErrs :: FilePath -> IO [ScanError]
|
getErrs :: FilePath -> IO [ScanError 'Parse]
|
||||||
getErrs path = snd <$> parse GitHub path
|
getErrs path = snd <$> parse GitHub path
|
||||||
|
@ -42,7 +42,7 @@ test_ignoreRegex = give WithoutColors $
|
|||||||
scanRepo OnlyTracked rw formats (config ^. cExclusionsL) root
|
scanRepo OnlyTracked rw formats (config ^. cExclusionsL) root
|
||||||
|
|
||||||
verifyRes <- allowRewrite showProgressBar $ \rw ->
|
verifyRes <- allowRewrite showProgressBar $ \rw ->
|
||||||
verifyRepo rw config verifyMode root $ srRepoInfo scanResult
|
verifyRepo rw config verifyMode $ srRepoInfo scanResult
|
||||||
|
|
||||||
let brokenLinks = pickBrokenLinks verifyRes
|
let brokenLinks = pickBrokenLinks verifyRes
|
||||||
|
|
||||||
|
@ -1,25 +0,0 @@
|
|||||||
{- SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>
|
|
||||||
-
|
|
||||||
- SPDX-License-Identifier: MPL-2.0
|
|
||||||
-}
|
|
||||||
|
|
||||||
module Test.Xrefcheck.LocalSpec where
|
|
||||||
|
|
||||||
import Universum
|
|
||||||
|
|
||||||
import Test.Tasty (TestTree, testGroup)
|
|
||||||
import Test.Tasty.HUnit (testCase, (@?=))
|
|
||||||
|
|
||||||
import Xrefcheck.Core (canonizeLocalRef)
|
|
||||||
|
|
||||||
test_local_refs_canonizing :: TestTree
|
|
||||||
test_local_refs_canonizing = testGroup "Local refs canonizing" $
|
|
||||||
[ testCase "Strips ./" $
|
|
||||||
canonizeLocalRef "./AnchorsSpec.hs" @?= "AnchorsSpec.hs"
|
|
||||||
|
|
||||||
, testCase "Strips ././" $
|
|
||||||
canonizeLocalRef "././AnchorsSpec.hs" @?= "AnchorsSpec.hs"
|
|
||||||
|
|
||||||
, testCase "Leaves plain other intact" $
|
|
||||||
canonizeLocalRef "../AnchorsSpec.hs" @?= "../AnchorsSpec.hs"
|
|
||||||
]
|
|
@ -1,4 +1,4 @@
|
|||||||
{- SPDX-FileCopyrightText: 2021 Serokell <https://serokell.io>
|
{- SPDX-FileCopyrightText: 2022 Serokell <https://serokell.io>
|
||||||
-
|
-
|
||||||
- SPDX-License-Identifier: MPL-2.0
|
- SPDX-License-Identifier: MPL-2.0
|
||||||
-}
|
-}
|
||||||
|
@ -63,7 +63,7 @@ test_tooManyRequests = testGroup "429 response tests"
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
_ <- verifyReferenceWithProgress
|
_ <- verifyReferenceWithProgress
|
||||||
(Reference "" "http://127.0.0.1:5000/429" Nothing (Position Nothing))
|
(Reference "" "http://127.0.0.1:5000/429" Nothing (Position Nothing) RIExternal)
|
||||||
progressRef
|
progressRef
|
||||||
Progress{..} <- vrExternal <$> readIORef progressRef
|
Progress{..} <- vrExternal <$> readIORef progressRef
|
||||||
let ttc = ttTimeToCompletion <$> pTaskTimestamp
|
let ttc = ttTimeToCompletion <$> pTaskTimestamp
|
||||||
@ -88,7 +88,7 @@ test_tooManyRequests = testGroup "429 response tests"
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
_ <- verifyReferenceWithProgress
|
_ <- verifyReferenceWithProgress
|
||||||
(Reference "" "http://127.0.0.1:5000/429" Nothing (Position Nothing))
|
(Reference "" "http://127.0.0.1:5000/429" Nothing (Position Nothing) RIExternal)
|
||||||
progressRef
|
progressRef
|
||||||
Progress{..} <- vrExternal <$> readIORef progressRef
|
Progress{..} <- vrExternal <$> readIORef progressRef
|
||||||
let ttc = fromMaybe (sec 0) $ ttTimeToCompletion <$> pTaskTimestamp
|
let ttc = fromMaybe (sec 0) $ ttTimeToCompletion <$> pTaskTimestamp
|
||||||
@ -114,7 +114,7 @@ test_tooManyRequests = testGroup "429 response tests"
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
_ <- verifyReferenceWithProgress
|
_ <- verifyReferenceWithProgress
|
||||||
(Reference "" "http://127.0.0.1:5000/429" Nothing (Position Nothing))
|
(Reference "" "http://127.0.0.1:5000/429" Nothing (Position Nothing) RIExternal)
|
||||||
progressRef
|
progressRef
|
||||||
Progress{..} <- vrExternal <$> readIORef progressRef
|
Progress{..} <- vrExternal <$> readIORef progressRef
|
||||||
let ttc = ttTimeToCompletion <$> pTaskTimestamp
|
let ttc = ttTimeToCompletion <$> pTaskTimestamp
|
||||||
|
@ -17,6 +17,7 @@ import Xrefcheck.Core
|
|||||||
import Xrefcheck.Progress
|
import Xrefcheck.Progress
|
||||||
import Xrefcheck.Scan
|
import Xrefcheck.Scan
|
||||||
import Xrefcheck.Scanners.Markdown
|
import Xrefcheck.Scanners.Markdown
|
||||||
|
import Xrefcheck.System
|
||||||
import Xrefcheck.Util
|
import Xrefcheck.Util
|
||||||
|
|
||||||
test_slash :: TestTree
|
test_slash :: TestTree
|
||||||
@ -27,13 +28,13 @@ test_slash = testGroup "Trailing forward slash detection" $
|
|||||||
testCase ("All the files within the root \"" <>
|
testCase ("All the files within the root \"" <>
|
||||||
root <>
|
root <>
|
||||||
"\" should exist") $ do
|
"\" should exist") $ do
|
||||||
(ScanResult _ (RepoInfo repoInfo _)) <- allowRewrite False $ \rw ->
|
(ScanResult _ RepoInfo{..}) <- allowRewrite False $ \rw ->
|
||||||
scanRepo OnlyTracked rw format (cExclusions config & ecIgnoreL .~ []) root
|
scanRepo OnlyTracked rw format (cExclusions config & ecIgnoreL .~ []) root
|
||||||
nonExistentFiles <- lefts <$> forM (keys repoInfo) (\filePath -> do
|
nonExistentFiles <- lefts <$> forM (fst <$> toPairs riFiles) (\filePath -> do
|
||||||
predicate <- doesFileExist filePath
|
predicate <- doesFileExist . unCanonicalPath $ filePath
|
||||||
return $ if predicate
|
return $ if predicate
|
||||||
then Right ()
|
then Right ()
|
||||||
else Left filePath)
|
else Left . unCanonicalPath $ filePath)
|
||||||
whenJust (nonEmpty nonExistentFiles) $ \files ->
|
whenJust (nonEmpty nonExistentFiles) $ \files ->
|
||||||
assertFailure
|
assertFailure
|
||||||
[int||
|
[int||
|
||||||
|
@ -11,11 +11,14 @@ import Network.HTTP.Types (forbidden403, unauthorized401)
|
|||||||
import Web.Firefly (ToResponse (..), route, run)
|
import Web.Firefly (ToResponse (..), route, run)
|
||||||
|
|
||||||
import Xrefcheck.Core (FileInfo, Flavor)
|
import Xrefcheck.Core (FileInfo, Flavor)
|
||||||
import Xrefcheck.Scan (ScanError)
|
import Xrefcheck.Scan (ScanError, ScanStage (..))
|
||||||
import Xrefcheck.Scanners.Markdown (MarkdownConfig (MarkdownConfig, mcFlavor), markdownScanner)
|
import Xrefcheck.Scanners.Markdown (MarkdownConfig (MarkdownConfig, mcFlavor), markdownScanner)
|
||||||
|
import Xrefcheck.System (canonicalizePath)
|
||||||
|
|
||||||
parse :: Flavor -> FilePath -> IO (FileInfo, [ScanError])
|
parse :: Flavor -> FilePath -> IO (FileInfo, [ScanError 'Parse])
|
||||||
parse fl path = markdownScanner MarkdownConfig { mcFlavor = fl } path
|
parse fl path = do
|
||||||
|
canonicalPath <- canonicalizePath path
|
||||||
|
markdownScanner MarkdownConfig { mcFlavor = fl } canonicalPath
|
||||||
|
|
||||||
mockServer :: IO ()
|
mockServer :: IO ()
|
||||||
mockServer = run 3000 $ do
|
mockServer = run 3000 $ do
|
||||||
|
@ -12,7 +12,6 @@ module Test.Xrefcheck.UtilRequests
|
|||||||
import Universum
|
import Universum
|
||||||
|
|
||||||
import Control.Exception qualified as E
|
import Control.Exception qualified as E
|
||||||
import Data.Map qualified as M
|
|
||||||
import Text.Interpolation.Nyan
|
import Text.Interpolation.Nyan
|
||||||
|
|
||||||
import Control.Concurrent (forkIO, killThread)
|
import Control.Concurrent (forkIO, killThread)
|
||||||
@ -21,6 +20,7 @@ import Xrefcheck.Config
|
|||||||
import Xrefcheck.Core
|
import Xrefcheck.Core
|
||||||
import Xrefcheck.Progress
|
import Xrefcheck.Progress
|
||||||
import Xrefcheck.Scan
|
import Xrefcheck.Scan
|
||||||
|
import Xrefcheck.System (canonicalizePath)
|
||||||
import Xrefcheck.Util
|
import Xrefcheck.Util
|
||||||
import Xrefcheck.Verify
|
import Xrefcheck.Verify
|
||||||
|
|
||||||
@ -62,7 +62,7 @@ checkLinkAndProgressWithServer mock link progress vrExpectation =
|
|||||||
|
|
||||||
verifyLink :: Text -> IO (VerifyResult VerifyError, Progress Int)
|
verifyLink :: Text -> IO (VerifyResult VerifyError, Progress Int)
|
||||||
verifyLink link = do
|
verifyLink link = do
|
||||||
let reference = Reference "" link Nothing (Position Nothing)
|
let reference = Reference "" link Nothing (Position Nothing) RIExternal
|
||||||
progRef <- newIORef $ initVerifyProgress [reference]
|
progRef <- newIORef $ initVerifyProgress [reference]
|
||||||
result <- verifyReferenceWithProgress reference progRef
|
result <- verifyReferenceWithProgress reference progRef
|
||||||
p <- readIORef progRef
|
p <- readIORef progRef
|
||||||
@ -70,6 +70,8 @@ verifyLink link = do
|
|||||||
|
|
||||||
verifyReferenceWithProgress :: Reference -> IORef VerifyProgress -> IO (VerifyResult VerifyError)
|
verifyReferenceWithProgress :: Reference -> IORef VerifyProgress -> IO (VerifyResult VerifyError)
|
||||||
verifyReferenceWithProgress reference progRef = do
|
verifyReferenceWithProgress reference progRef = do
|
||||||
|
canonicalRoot <- canonicalizePath "."
|
||||||
|
file <- canonicalizePath ""
|
||||||
fmap wrlItem <$> verifyReference
|
fmap wrlItem <$> verifyReference
|
||||||
(defConfig GitHub & cExclusionsL . ecIgnoreExternalRefsToL .~ []) FullMode
|
(defConfig GitHub & cExclusionsL . ecIgnoreExternalRefsToL .~ []) FullMode
|
||||||
progRef (RepoInfo M.empty mempty) "." "" reference
|
progRef (RepoInfo mempty mempty canonicalRoot) file reference
|
||||||
|
@ -14,14 +14,14 @@ load '../helpers'
|
|||||||
assert_diff - <<EOF
|
assert_diff - <<EOF
|
||||||
=== Invalid references found ===
|
=== Invalid references found ===
|
||||||
|
|
||||||
➥ In file ambiguous-anchors/a.md
|
➥ In file a.md
|
||||||
bad reference (file-local) at src:16:1-43:
|
bad reference (file-local) at src:16:1-43:
|
||||||
- text: "ambiguous anchor in this file"
|
- text: "ambiguous anchor in this file"
|
||||||
- link: -
|
- link: -
|
||||||
- anchor: some-text
|
- anchor: some-text
|
||||||
|
|
||||||
Ambiguous reference to anchor 'some-text'
|
Ambiguous reference to anchor 'some-text'
|
||||||
In file ambiguous-anchors/a.md
|
In file a.md
|
||||||
It could refer to either:
|
It could refer to either:
|
||||||
- some-text (header I) at src:6:1-11
|
- some-text (header I) at src:6:1-11
|
||||||
- some-text (header I) at src:8:1-15
|
- some-text (header I) at src:8:1-15
|
||||||
@ -29,14 +29,14 @@ assert_diff - <<EOF
|
|||||||
Use of ambiguous anchors is discouraged because the target
|
Use of ambiguous anchors is discouraged because the target
|
||||||
can change silently while the document containing it evolves.
|
can change silently while the document containing it evolves.
|
||||||
|
|
||||||
➥ In file ambiguous-anchors/b.md
|
➥ In file b.md
|
||||||
bad reference (relative) at src:7:1-48:
|
bad reference (relative) at src:7:1-48:
|
||||||
- text: "ambiguous anchor in other file"
|
- text: "ambiguous anchor in other file"
|
||||||
- link: a.md
|
- link: a.md
|
||||||
- anchor: some-text
|
- anchor: some-text
|
||||||
|
|
||||||
Ambiguous reference to anchor 'some-text'
|
Ambiguous reference to anchor 'some-text'
|
||||||
In file ambiguous-anchors/a.md
|
In file a.md
|
||||||
It could refer to either:
|
It could refer to either:
|
||||||
- some-text (header I) at src:6:1-11
|
- some-text (header I) at src:6:1-11
|
||||||
- some-text (header I) at src:8:1-15
|
- some-text (header I) at src:8:1-15
|
||||||
@ -53,7 +53,7 @@ EOF
|
|||||||
assert_diff - <<EOF
|
assert_diff - <<EOF
|
||||||
=== Invalid references found ===
|
=== Invalid references found ===
|
||||||
|
|
||||||
➥ In file non-existing-anchors/a.md
|
➥ In file a.md
|
||||||
bad reference (file-local) at src:12:1-13:
|
bad reference (file-local) at src:12:1-13:
|
||||||
- text: "broken"
|
- text: "broken"
|
||||||
- link: -
|
- link: -
|
||||||
@ -63,7 +63,7 @@ assert_diff - <<EOF
|
|||||||
- h1 (header I) at src:6:1-4
|
- h1 (header I) at src:6:1-4
|
||||||
- h2 (header II) at src:8:1-5
|
- h2 (header II) at src:8:1-5
|
||||||
|
|
||||||
➥ In file non-existing-anchors/a.md
|
➥ In file a.md
|
||||||
bad reference (file-local) at src:14:1-18:
|
bad reference (file-local) at src:14:1-18:
|
||||||
- text: "broken"
|
- text: "broken"
|
||||||
- link: -
|
- link: -
|
||||||
@ -72,7 +72,7 @@ assert_diff - <<EOF
|
|||||||
Anchor 'heading' is not present, did you mean:
|
Anchor 'heading' is not present, did you mean:
|
||||||
- the-heading (header I) at src:10:1-13
|
- the-heading (header I) at src:10:1-13
|
||||||
|
|
||||||
➥ In file non-existing-anchors/a.md
|
➥ In file a.md
|
||||||
bad reference (file-local) at src:16:1-31:
|
bad reference (file-local) at src:16:1-31:
|
||||||
- text: "broken"
|
- text: "broken"
|
||||||
- link: -
|
- link: -
|
||||||
|
@ -54,7 +54,7 @@ load '../helpers'
|
|||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
./one/two/three
|
one/two/three
|
||||||
|
|
||||||
Invalid references dumped, 1 in total.
|
Invalid references dumped, 1 in total.
|
||||||
EOF
|
EOF
|
||||||
@ -73,7 +73,7 @@ EOF
|
|||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
./one/two/three
|
one/two/three
|
||||||
|
|
||||||
Invalid references dumped, 1 in total.
|
Invalid references dumped, 1 in total.
|
||||||
EOF
|
EOF
|
||||||
@ -92,7 +92,7 @@ EOF
|
|||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
./one/two/three
|
one/two/three
|
||||||
|
|
||||||
Invalid references dumped, 1 in total.
|
Invalid references dumped, 1 in total.
|
||||||
EOF
|
EOF
|
||||||
|
@ -1,12 +1,12 @@
|
|||||||
=== Invalid references found ===
|
=== Invalid references found ===
|
||||||
|
|
||||||
➥ In file broken-link-in-footnote/file-with-footnote-with-broken-link.md
|
➥ In file file-with-footnote-with-broken-link.md
|
||||||
bad reference (relative) at src:8:9-43:
|
bad reference (relative) at src:8:9-43:
|
||||||
- text: "bad link in footnote"
|
- text: "bad link in footnote"
|
||||||
- link: ./notExists
|
- link: ./notExists
|
||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
broken-link-in-footnote/notExists
|
notExists
|
||||||
|
|
||||||
Invalid references dumped, 1 in total.
|
Invalid references dumped, 1 in total.
|
||||||
|
@ -71,7 +71,7 @@ Scan errors dumped, 1 in total.
|
|||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
./referenced-file.md
|
referenced-file.md
|
||||||
|
|
||||||
Invalid references dumped, 1 in total.
|
Invalid references dumped, 1 in total.
|
||||||
EOF
|
EOF
|
||||||
|
@ -7,7 +7,7 @@
|
|||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
./one/a.md
|
one/a.md
|
||||||
|
|
||||||
➥ In file check-ignoreLocalRefsTo.md
|
➥ In file check-ignoreLocalRefsTo.md
|
||||||
bad reference (absolute) at src:9:1-26:
|
bad reference (absolute) at src:9:1-26:
|
||||||
@ -16,7 +16,7 @@
|
|||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
./two/b.md
|
two/b.md
|
||||||
|
|
||||||
➥ In file check-ignoreLocalRefsTo.md
|
➥ In file check-ignoreLocalRefsTo.md
|
||||||
bad reference (absolute) at src:11:1-39:
|
bad reference (absolute) at src:11:1-39:
|
||||||
@ -25,7 +25,7 @@
|
|||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
./three/c.md
|
three/c.md
|
||||||
|
|
||||||
➥ In file check-ignoreLocalRefsTo.md
|
➥ In file check-ignoreLocalRefsTo.md
|
||||||
bad reference (absolute) at src:13:1-51:
|
bad reference (absolute) at src:13:1-51:
|
||||||
@ -34,7 +34,7 @@
|
|||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
./three/four/d.md
|
three/four/d.md
|
||||||
|
|
||||||
➥ In file check-ignoreLocalRefsTo.md
|
➥ In file check-ignoreLocalRefsTo.md
|
||||||
bad reference (absolute) at src:15:1-59:
|
bad reference (absolute) at src:15:1-59:
|
||||||
@ -43,7 +43,7 @@
|
|||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
./three/five/e.md
|
three/five/e.md
|
||||||
|
|
||||||
➥ In file one/file.md
|
➥ In file one/file.md
|
||||||
bad reference (relative) at src:7:1-58:
|
bad reference (relative) at src:7:1-58:
|
||||||
@ -61,6 +61,6 @@
|
|||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
one/../two/b.md
|
two/b.md
|
||||||
|
|
||||||
Invalid references dumped, 7 in total.
|
Invalid references dumped, 7 in total.
|
||||||
|
@ -41,7 +41,7 @@ load '../helpers'
|
|||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
./no-file.md
|
no-file.md
|
||||||
|
|
||||||
Invalid references dumped, 1 in total.
|
Invalid references dumped, 1 in total.
|
||||||
EOF
|
EOF
|
||||||
|
@ -15,7 +15,7 @@
|
|||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
dir1/dir2/../a/b/c/unexisting-file.md
|
dir1/a/b/c/unexisting-file.md
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir1/dir2/d2f1.md
|
||||||
bad reference (relative) at src:28:1-31:
|
bad reference (relative) at src:28:1-31:
|
||||||
@ -24,7 +24,7 @@
|
|||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
dir1/dir2/D2F2.md/
|
dir1/dir2/D2F2.md
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir1/dir2/d2f1.md
|
||||||
bad reference (relative) at src:29:1-32:
|
bad reference (relative) at src:29:1-32:
|
||||||
@ -33,7 +33,7 @@
|
|||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
dir1/dir2/../DIR2
|
dir1/DIR2
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir1/dir2/d2f1.md
|
||||||
bad reference (relative) at src:31:1-38:
|
bad reference (relative) at src:31:1-38:
|
||||||
@ -59,7 +59,7 @@
|
|||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
./d1f1.md
|
d1f1.md
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir1/dir2/d2f1.md
|
||||||
bad reference (absolute) at src:43:1-27:
|
bad reference (absolute) at src:43:1-27:
|
||||||
@ -68,7 +68,7 @@
|
|||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
./dir2/d2f2.md
|
dir2/d2f2.md
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir1/dir2/d2f1.md
|
||||||
bad reference (absolute) at src:44:1-32:
|
bad reference (absolute) at src:44:1-32:
|
||||||
@ -77,7 +77,7 @@
|
|||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
././dir2/../d1f1.md
|
d1f1.md
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir1/dir2/d2f1.md
|
||||||
bad reference (absolute) at src:45:1-37:
|
bad reference (absolute) at src:45:1-37:
|
||||||
@ -86,7 +86,7 @@
|
|||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
././dir2/../d1f1.md/
|
d1f1.md
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir1/dir2/d2f1.md
|
||||||
bad reference (absolute) at src:46:1-55:
|
bad reference (absolute) at src:46:1-55:
|
||||||
@ -95,7 +95,7 @@
|
|||||||
- anchor: existing-anchor-d1f1
|
- anchor: existing-anchor-d1f1
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
././dir2/../d1f1.md
|
d1f1.md
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir1/dir2/d2f1.md
|
||||||
bad reference (absolute) at src:57:1-16:
|
bad reference (absolute) at src:57:1-16:
|
||||||
@ -104,7 +104,7 @@
|
|||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
Link targets a local file outside repository:
|
Link targets a local file outside repository:
|
||||||
./../../a.md
|
../../a.md
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir1/dir2/d2f1.md
|
||||||
bad reference (absolute) at src:58:1-18:
|
bad reference (absolute) at src:58:1-18:
|
||||||
@ -113,6 +113,6 @@
|
|||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
Link targets a local file outside repository:
|
Link targets a local file outside repository:
|
||||||
./b/../../b.md
|
b/../../b.md
|
||||||
|
|
||||||
Invalid references dumped, 13 in total.
|
Invalid references dumped, 13 in total.
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
=== Invalid references found ===
|
=== Invalid references found ===
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (file-local) at src:9:1-18:
|
bad reference (file-local) at src:9:1-18:
|
||||||
- text: "bad-cf-ref"
|
- text: "bad-cf-ref"
|
||||||
- link: -
|
- link: -
|
||||||
@ -8,34 +8,34 @@
|
|||||||
|
|
||||||
Anchor 'bad' is not present
|
Anchor 'bad' is not present
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (relative) at src:27:1-43:
|
bad reference (relative) at src:27:1-43:
|
||||||
- text: "bad-file-rel"
|
- text: "bad-file-rel"
|
||||||
- link: ../a/b/c/unexisting-file.md
|
- link: ../a/b/c/unexisting-file.md
|
||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
dir1/dir2/../a/b/c/unexisting-file.md
|
a/b/c/unexisting-file.md
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (relative) at src:28:1-31:
|
bad reference (relative) at src:28:1-31:
|
||||||
- text: "bad-casing-file-rel"
|
- text: "bad-casing-file-rel"
|
||||||
- link: D2F2.md/
|
- link: D2F2.md/
|
||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
dir1/dir2/D2F2.md/
|
dir2/D2F2.md
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (relative) at src:29:1-32:
|
bad reference (relative) at src:29:1-32:
|
||||||
- text: "bad-casing-folder-rel"
|
- text: "bad-casing-folder-rel"
|
||||||
- link: ../DIR2
|
- link: ../DIR2
|
||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
dir1/dir2/../DIR2
|
DIR2
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (relative) at src:31:1-38:
|
bad reference (relative) at src:31:1-38:
|
||||||
- text: "bad-anchor-rel-1"
|
- text: "bad-anchor-rel-1"
|
||||||
- link: d2f2.md
|
- link: d2f2.md
|
||||||
@ -43,103 +43,103 @@
|
|||||||
|
|
||||||
Anchor 'bad-anchor' is not present
|
Anchor 'bad-anchor' is not present
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (relative) at src:32:1-49:
|
bad reference (relative) at src:32:1-49:
|
||||||
- text: "bad-anchor-rel-2"
|
- text: "bad-anchor-rel-2"
|
||||||
- link: unexisting-file.md
|
- link: unexisting-file.md
|
||||||
- anchor: bad-anchor
|
- anchor: bad-anchor
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
dir1/dir2/unexisting-file.md
|
dir2/unexisting-file.md
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (absolute) at src:36:1-29:
|
bad reference (absolute) at src:36:1-29:
|
||||||
- text: "file-abs-1"
|
- text: "file-abs-1"
|
||||||
- link: /dir1/./d1f1.md
|
- link: /dir1/./d1f1.md
|
||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
dir1/dir1/./d1f1.md
|
dir1/d1f1.md
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (absolute) at src:37:1-21:
|
bad reference (absolute) at src:37:1-21:
|
||||||
- text: "folder-abs-1"
|
- text: "folder-abs-1"
|
||||||
- link: /dir1
|
- link: /dir1
|
||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
dir1/dir1
|
dir1
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (absolute) at src:38:1-30:
|
bad reference (absolute) at src:38:1-30:
|
||||||
- text: "folder-abs-2"
|
- text: "folder-abs-2"
|
||||||
- link: /dir1/dir2/../
|
- link: /dir1/dir2/../
|
||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
dir1/dir1/dir2/../
|
dir1
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (absolute) at src:39:1-58:
|
bad reference (absolute) at src:39:1-58:
|
||||||
- text: "anchor-abs-1"
|
- text: "anchor-abs-1"
|
||||||
- link: /dir1/../dir1/d1f1.md
|
- link: /dir1/../dir1/d1f1.md
|
||||||
- anchor: existing-anchor-d1f1
|
- anchor: existing-anchor-d1f1
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
dir1/dir1/../dir1/d1f1.md
|
dir1/d1f1.md
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (absolute) at src:40:1-73:
|
bad reference (absolute) at src:40:1-73:
|
||||||
- text: "anchor-abs-2"
|
- text: "anchor-abs-2"
|
||||||
- link: /dir1/dir2/../../dir1/./dir2/d2f2.md
|
- link: /dir1/dir2/../../dir1/./dir2/d2f2.md
|
||||||
- anchor: existing-anchor-d2f2
|
- anchor: existing-anchor-d2f2
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
dir1/dir1/dir2/../../dir1/./dir2/d2f2.md
|
dir1/dir2/d2f2.md
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (relative) at src:51:1-42:
|
bad reference (relative) at src:51:1-42:
|
||||||
- text: "path-through-top-dir"
|
- text: "path-through-top-dir"
|
||||||
- link: ../../dir1/d1f1.md
|
- link: ../../dir1/d1f1.md
|
||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
Link targets a local file outside repository:
|
Link targets a local file outside repository:
|
||||||
dir1/dir2/../../dir1/d1f1.md
|
dir2/../../dir1/d1f1.md
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (relative) at src:52:1-75:
|
bad reference (relative) at src:52:1-75:
|
||||||
- text: "path-through-top-dir-with-anchor"
|
- text: "path-through-top-dir-with-anchor"
|
||||||
- link: ../../dir1/d1f1.md
|
- link: ../../dir1/d1f1.md
|
||||||
- anchor: existing-anchor-d1f1
|
- anchor: existing-anchor-d1f1
|
||||||
|
|
||||||
Link targets a local file outside repository:
|
Link targets a local file outside repository:
|
||||||
dir1/dir2/../../dir1/d1f1.md
|
dir2/../../dir1/d1f1.md
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (relative) at src:53:1-26:
|
bad reference (relative) at src:53:1-26:
|
||||||
- text: "ref-to-d0"
|
- text: "ref-to-d0"
|
||||||
- link: ../../d0f1.md
|
- link: ../../d0f1.md
|
||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
Link targets a local file outside repository:
|
Link targets a local file outside repository:
|
||||||
dir1/dir2/../../d0f1.md
|
dir2/../../d0f1.md
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (absolute) at src:57:1-16:
|
bad reference (absolute) at src:57:1-16:
|
||||||
- text: "A"
|
- text: "A"
|
||||||
- link: /../../a.md
|
- link: /../../a.md
|
||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
Link targets a local file outside repository:
|
Link targets a local file outside repository:
|
||||||
dir1/../../a.md
|
../../a.md
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (absolute) at src:58:1-18:
|
bad reference (absolute) at src:58:1-18:
|
||||||
- text: "B"
|
- text: "B"
|
||||||
- link: /b/../../b.md
|
- link: /b/../../b.md
|
||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
Link targets a local file outside repository:
|
Link targets a local file outside repository:
|
||||||
dir1/b/../../b.md
|
b/../../b.md
|
||||||
|
|
||||||
Invalid references dumped, 16 in total.
|
Invalid references dumped, 16 in total.
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
=== Invalid references found ===
|
=== Invalid references found ===
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (file-local) at src:9:1-18:
|
bad reference (file-local) at src:9:1-18:
|
||||||
- text: "bad-cf-ref"
|
- text: "bad-cf-ref"
|
||||||
- link: -
|
- link: -
|
||||||
@ -8,25 +8,25 @@
|
|||||||
|
|
||||||
Anchor 'bad' is not present
|
Anchor 'bad' is not present
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (relative) at src:27:1-43:
|
bad reference (relative) at src:27:1-43:
|
||||||
- text: "bad-file-rel"
|
- text: "bad-file-rel"
|
||||||
- link: ../a/b/c/unexisting-file.md
|
- link: ../a/b/c/unexisting-file.md
|
||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
dir1/dir2/../a/b/c/unexisting-file.md
|
a/b/c/unexisting-file.md
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (relative) at src:28:1-31:
|
bad reference (relative) at src:28:1-31:
|
||||||
- text: "bad-casing-file-rel"
|
- text: "bad-casing-file-rel"
|
||||||
- link: D2F2.md/
|
- link: D2F2.md/
|
||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
dir1/dir2/D2F2.md/
|
dir2/D2F2.md
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (relative) at src:31:1-38:
|
bad reference (relative) at src:31:1-38:
|
||||||
- text: "bad-anchor-rel-1"
|
- text: "bad-anchor-rel-1"
|
||||||
- link: d2f2.md
|
- link: d2f2.md
|
||||||
@ -34,76 +34,76 @@
|
|||||||
|
|
||||||
Anchor 'bad-anchor' is not present
|
Anchor 'bad-anchor' is not present
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (relative) at src:32:1-49:
|
bad reference (relative) at src:32:1-49:
|
||||||
- text: "bad-anchor-rel-2"
|
- text: "bad-anchor-rel-2"
|
||||||
- link: unexisting-file.md
|
- link: unexisting-file.md
|
||||||
- anchor: bad-anchor
|
- anchor: bad-anchor
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
dir1/dir2/unexisting-file.md
|
dir2/unexisting-file.md
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (absolute) at src:36:1-29:
|
bad reference (absolute) at src:36:1-29:
|
||||||
- text: "file-abs-1"
|
- text: "file-abs-1"
|
||||||
- link: /dir1/./d1f1.md
|
- link: /dir1/./d1f1.md
|
||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
dir1/dir1/./d1f1.md
|
dir1/d1f1.md
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (absolute) at src:37:1-21:
|
bad reference (absolute) at src:37:1-21:
|
||||||
- text: "folder-abs-1"
|
- text: "folder-abs-1"
|
||||||
- link: /dir1
|
- link: /dir1
|
||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
dir1/dir1
|
dir1
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (absolute) at src:38:1-30:
|
bad reference (absolute) at src:38:1-30:
|
||||||
- text: "folder-abs-2"
|
- text: "folder-abs-2"
|
||||||
- link: /dir1/dir2/../
|
- link: /dir1/dir2/../
|
||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
dir1/dir1/dir2/../
|
dir1
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (absolute) at src:39:1-58:
|
bad reference (absolute) at src:39:1-58:
|
||||||
- text: "anchor-abs-1"
|
- text: "anchor-abs-1"
|
||||||
- link: /dir1/../dir1/d1f1.md
|
- link: /dir1/../dir1/d1f1.md
|
||||||
- anchor: existing-anchor-d1f1
|
- anchor: existing-anchor-d1f1
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
dir1/dir1/../dir1/d1f1.md
|
dir1/d1f1.md
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (absolute) at src:40:1-73:
|
bad reference (absolute) at src:40:1-73:
|
||||||
- text: "anchor-abs-2"
|
- text: "anchor-abs-2"
|
||||||
- link: /dir1/dir2/../../dir1/./dir2/d2f2.md
|
- link: /dir1/dir2/../../dir1/./dir2/d2f2.md
|
||||||
- anchor: existing-anchor-d2f2
|
- anchor: existing-anchor-d2f2
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
dir1/dir1/dir2/../../dir1/./dir2/d2f2.md
|
dir1/dir2/d2f2.md
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (relative) at src:51:1-42:
|
bad reference (relative) at src:51:1-42:
|
||||||
- text: "path-through-top-dir"
|
- text: "path-through-top-dir"
|
||||||
- link: ../../dir1/d1f1.md
|
- link: ../../dir1/d1f1.md
|
||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
Link targets a local file outside repository:
|
Link targets a local file outside repository:
|
||||||
dir1/dir2/../../dir1/d1f1.md
|
dir2/../../dir1/d1f1.md
|
||||||
|
|
||||||
➥ In file dir1/dir2/d2f1.md
|
➥ In file dir2/d2f1.md
|
||||||
bad reference (relative) at src:52:1-75:
|
bad reference (relative) at src:52:1-75:
|
||||||
- text: "path-through-top-dir-with-anchor"
|
- text: "path-through-top-dir-with-anchor"
|
||||||
- link: ../../dir1/d1f1.md
|
- link: ../../dir1/d1f1.md
|
||||||
- anchor: existing-anchor-d1f1
|
- anchor: existing-anchor-d1f1
|
||||||
|
|
||||||
Link targets a local file outside repository:
|
Link targets a local file outside repository:
|
||||||
dir1/dir2/../../dir1/d1f1.md
|
dir2/../../dir1/d1f1.md
|
||||||
|
|
||||||
Invalid references dumped, 12 in total.
|
Invalid references dumped, 12 in total.
|
||||||
|
@ -46,7 +46,7 @@ Scan errors dumped, 7 in total.
|
|||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
./no-file.md
|
no-file.md
|
||||||
|
|
||||||
➥ In file check-scan-errors.md
|
➥ In file check-scan-errors.md
|
||||||
bad reference (relative) at src:23:1-24:
|
bad reference (relative) at src:23:1-24:
|
||||||
@ -64,6 +64,6 @@ Scan errors dumped, 7 in total.
|
|||||||
- anchor: -
|
- anchor: -
|
||||||
|
|
||||||
File does not exist:
|
File does not exist:
|
||||||
./a.md
|
a.md
|
||||||
|
|
||||||
Invalid references dumped, 3 in total.
|
Invalid references dumped, 3 in total.
|
||||||
|
Loading…
Reference in New Issue
Block a user