xrefcheck 0.1.2 → 0.1.3
raw patch · 11 files changed
+547/−69 lines, 11 filesdep +HUnitdep +aeson-casingdep +file-embeddep −aeson-options
Dependencies added: HUnit, aeson-casing, file-embed, regex-tdfa, transformers
Dependencies removed: aeson-options
Files
- CHANGES.md +13/−0
- README.md +77/−3
- src-files/def-config.yaml +7/−0
- src/Xrefcheck/CLI.hs +34/−4
- src/Xrefcheck/Config.hs +40/−8
- src/Xrefcheck/Scanners/Markdown.hs +190/−46
- src/Xrefcheck/Util.hs +12/−0
- src/Xrefcheck/Verify.hs +13/−0
- tests/Test/Xrefcheck/IgnoreAnnotationsSpec.hs +55/−0
- tests/Test/Xrefcheck/IgnoreRegexSpec.hs +84/−0
- xrefcheck.cabal +22/−8
CHANGES.md view
@@ -7,6 +7,19 @@ Unreleased ========== ++0.1.3+=======++* [#58](https://github.com/serokell/xrefcheck/pull/58)+ + Switch to lts-17.3.+* [#53](https://github.com/serokell/xrefcheck/pull/53)+ + Make possible to include a regular expression in+ `ignoreRefs` parameter of config to ignore external+ references.+ + Add support of right in-place ignoring annotations+ such as `ignore file`, `ignore paragraph` and `ignore link`.+ 0.1.2 =======
README.md view
@@ -32,7 +32,7 @@ ### A comparison with other solutions -* [linky](https://github.com/mattias-p/linky) - a well-configurable verifier written in Rust, scans one file at a time and works good in pair with system utilities like `find`.+* [linky](https://github.com/mattias-p/linky) - a well-configurable verifier written in Rust, scans one specified file at a time and works good in pair with system utilities like `find`. This tool requires some configuring before it can be applied to a repository or added to CI. * [awesome_bot](https://github.com/dkhamsing/awesome_bot) - a solution written in Ruby that can be easily included in CI or integrated into GitHub. Its features include duplicated URLs detection, specifying allowed HTTP error codes and reporting generation.@@ -40,16 +40,17 @@ * [remark-validate-links](https://github.com/remarkjs/remark-validate-links) and [remark-lint-no-dead-urls](https://github.com/davidtheclark/remark-lint-no-dead-urls) - highly configurable Javascript solution for checking local and remote links resp. It is able to check multiple repositores at once if they are gathered in one folder. Being written on JavaScript, it is fairly slow on large repositories.-* [markdown-link-check](https://github.com/tcort/markdown-link-check) - another checker written in JavaScript, scans one file at a time.+* [markdown-link-check](https://github.com/tcort/markdown-link-check) - another checker written in JavaScript, scans one specific file at a time. Supports `mailto:` link resolution. * [url-checker](https://github.com/paramt/url-checker) - GitHub action which checks links in specified files.-* [broken-link-checker](https://github.com/stevenvachon/broken-link-checker) - advanced checker for `HTML` files.+* [linkcheck](https://github.com/filiph/linkcheck) - advanced site crawler, checks for `HTML` files. There are other solutions for this particular task which we don't mention here. ## Usage [↑](#xrefcheck) We provide the following ways for you to use xrefcheck: +- [GitHub action](https://github.com/marketplace/actions/xrefcheck) - [statically linked binaries](https://github.com/serokell/xrefcheck/releases) - [Docker image](https://hub.docker.com/r/serokell/xrefcheck) - [building from source](#build-instructions-)@@ -73,6 +74,79 @@ ```sh xrefcheck --help ```+++### Special functionality++<details>+ <summary>Ignoring external links</summary>++ If you want some external links to not be verified, you can use one of the following ways to ignore those links:++1. Add the regular expression that matches the ignoring link to the optional `ignoreRefs` parameter of your config file.++ For example:+ ```yaml+ ignoreRefs:+ - https://bad.reference.(org|com)(/?)+ ```+ allows to ignore both `https://bad.reference.org` and `https://bad.reference.com` with or without last "/".++2. Add right in-place annotation using one of the following ignoring modes (each mode is just a comment with a certain syntax).++ * Ignore the link:++ There are several ways to add this annotation:++ * Just add it like a regular text before the ignoring link.++ ```markdown+ Bad ['com' reference](https://bad.reference.com) <!-- xrefcheck: ignore link --> and bad ['org' reference](https://bad.reference.org)+ ```++ * Separate the ignoring link from the annotation and the following text with single new lines.++ ```markdown+ Bad ['com' reference](https://bad.reference.com) and bad <!-- xrefcheck: ignore link -->+ ['org'](https://bad.reference.org)+ reference+ ```++ Therefore only `https://bad.reference.org` will be ignored.++ * If the ignoring link is the first in a paragraph, then the annotation can also be added before a paragraph.++ ```markdown+ <!-- xrefcheck: ignore link -->+ [Bad 'org' reference](https://bad.reference.org)+ [Bad 'com' reference](https://bad.reference.com)+ ```++ It is still the same `https://bad.reference.org` will be ignored in this case.++ * Ignore the paragraph:++ ```markdown+ <!-- xrefcheck: ignore paragraph -->+ Bad ['org' reference](https://bad.reference.org)+ Bad ['com' reference](https://bad.reference.com)++ Bad ['io' reference](https://bad.reference.io)+ ```++ In this way, `https://bad.reference.org` and `https://bad.reference.com` will be ignored and `https://bad.reference.io` will still be verified.++ * Ignore the whole file:+ ```markdown+ <!-- a comment -->+ <!-- another comment -->++ <!-- xrefcheck: ignore file -->+ ...the rest of the file...+ ```++ Using this you can ignore the whole file.+ </details> ## Configuring
src-files/def-config.yaml view
@@ -13,6 +13,7 @@ # Stack files - .stack-work + # Verification parameters. verification: # On 'anchor not found' error, how much similar anchors should be displayed as@@ -49,3 +50,9 @@ - ../../issues/* - ../../merge_requests - ../../merge_requests/*++ # POSIX extended regular expressions that match external references+ # that have to be ignored (not verified).+ # It is an optional parameter, so it can be omitted.+ ignoreRefs:+ []
src/Xrefcheck/CLI.hs view
@@ -17,12 +17,14 @@ , getCommand ) where +import qualified Data.List as L import Data.Version (showVersion)-import Options.Applicative (Parser, ReadM, command, eitherReader, execParser, flag', fullDesc, help,- helper, hsubparser, info, infoOption, long, metavar, option, progDesc,+import Options.Applicative (Parser, ReadM, command, eitherReader, execParser, flag', footerDoc, fullDesc,+ help, helper, hsubparser, info, infoOption, long, metavar, option, progDesc, short, strOption, switch, value)-import Paths_xrefcheck (version)+import Options.Applicative.Help.Pretty (Doc, displayS, fill, fillSep, indent, renderPretty, text) +import Paths_xrefcheck (version) import Xrefcheck.Config import Xrefcheck.Core @@ -150,4 +152,32 @@ info (helper <*> versionOption <*> totalParser) $ fullDesc <> progDesc "Cross-references verifier for markdown documentation in \- \Git repositories."+ \Git repositories." <>+ (footerDoc $ pure ignoreModesMsg)++ignoreModesMsg :: Doc+ignoreModesMsg = text $ header <> body+ where+ header = "To ignore a link in your markdown, \+ \include \"<!-- xrefcheck: ignore <mode> -->\"\n\+ \comment with one of these modes:\n"+ body = displayS (renderPretty pageParam pageWidth doc) ""++ pageWidth = 80+ pageParam = 1++ doc = fillSep $ map formatDesc modeDescr++ modeDescr =+ [ (" \"link\"", L.words $ "Ignore the link right after the comment.")+ , (" \"paragraph\"", L.words $ "Ignore the whole paragraph after the comment.")+ , (" \"file\"", L.words $ "This mode can only be used at the top of markdown \+ \or right after comments at the top.")+ ]++ modeIndent = length ("\"paragraph\"" :: String) + 2+ descrIndent = 27 - modeIndent++ formatDesc (mode, descr) =+ (fill modeIndent $ text mode) <>+ (indent descrIndent $ fillSep $ map text descr)
src/Xrefcheck/Config.hs view
@@ -7,16 +7,21 @@ module Xrefcheck.Config where -import Data.Aeson.Options (defaultOptions)+import Control.Lens (makeLensesWith) import Data.Aeson.TH (deriveFromJSON) import Data.Yaml (FromJSON (..), decodeEither', prettyPrintParseException, withText) import Instances.TH.Lift ()-import qualified Language.Haskell.TH.Syntax as TH-import System.FilePath ((</>))-import TH.RelativePaths (qReadFileBS)+import Text.Regex.TDFA (CompOption (..), ExecOption (..), Regex)+import Text.Regex.TDFA.Text (compile)++import Data.FileEmbed (embedFile)+-- FIXME: Use </> from System.FilePath+-- </> from Posix is used only because we cross-compile to Windows and \ doesn't work on Linux+import System.FilePath.Posix ((</>)) import Time (KnownRatName, Second, Time, unitsP) import Xrefcheck.System (RelGlobPattern)+import Xrefcheck.Util (aesonConfigOption, postfixFields) -- | Overall config. data Config = Config@@ -38,8 +43,13 @@ -- ^ Files which we pretend do exist. , vcNotScanned :: [FilePath] -- ^ Prefixes of files, references in which we should not analyze.+ , vcIgnoreRefs :: Maybe [Regex]+ -- ^ Regular expressions that match external references we should not verify. } +makeLensesWith postfixFields ''Config+makeLensesWith postfixFields ''VerifyConfig+ ----------------------------------------------------------- -- Default config -----------------------------------------------------------@@ -50,7 +60,7 @@ -- would be lost. defConfigText :: ByteString defConfigText =- $(TH.lift =<< qReadFileBS ("src-files" </> "def-config.yaml"))+ $(embedFile ("src-files" </> "def-config.yaml")) defConfig :: HasCallStack => Config defConfig =@@ -61,10 +71,32 @@ -- Yaml instances ----------------------------------------------------------- -deriveFromJSON defaultOptions ''Config-deriveFromJSON defaultOptions ''TraversalConfig-deriveFromJSON defaultOptions ''VerifyConfig+deriveFromJSON aesonConfigOption ''Config+deriveFromJSON aesonConfigOption ''TraversalConfig+deriveFromJSON aesonConfigOption ''VerifyConfig instance KnownRatName unit => FromJSON (Time unit) where parseJSON = withText "time" $ maybe (fail "Unknown time") pure . unitsP . toString++instance FromJSON Regex where+ parseJSON = withText "regex" $ \val -> do+ let errOrRegex =+ compile defaultCompOption defaultExecOption val+ either (error . show) return errOrRegex++-- Default boolean values according to+-- https://hackage.haskell.org/package/regex-tdfa-1.3.1.0/docs/Text-Regex-TDFA.html#t:CompOption+defaultCompOption :: CompOption+defaultCompOption =+ CompOption+ { caseSensitive = True+ , multiline = True+ , rightAssoc = True+ , newSyntax = True+ , lastStarGreedy = False+ }++-- ExecOption value to improve speed+defaultExecOption :: ExecOption+defaultExecOption = ExecOption {captureGroups = False}
src/Xrefcheck/Scanners/Markdown.hs view
@@ -10,16 +10,18 @@ module Xrefcheck.Scanners.Markdown ( markdownScanner , markdownSupport+ , parseFileInfo ) where import CMarkGFM (Node (..), NodeType (..), PosInfo (..), commonmarkToNode) import Control.Lens ((%=))+import Control.Monad.Trans.Except (Except, runExcept, throwE) import qualified Data.ByteString.Lazy as BSL+import Data.Char (isSpace) import Data.Default (Default (..)) import qualified Data.Text as T import qualified Data.Text.Lazy as LT import Fmt (Buildable (..), blockListF, nameF, (+|), (|+))-import GHC.Conc (par) import Xrefcheck.Core import Xrefcheck.Scan@@ -49,54 +51,196 @@ CODE t -> t _ -> "" -nodeExtractInfo :: Node -> ExceptT Text Identity FileInfo-nodeExtractInfo docNode = fmap finaliseFileInfo $ execStateT (loop docNode) def- where- loop node@(Node pos ty subs) = case ty of- DOCUMENT ->- mapM_ loop subs- PARAGRAPH ->- mapM_ loop subs- HEADING lvl ->- let text = nodeExtractText node- aType = HeaderAnchor lvl- aName = headerToAnchor text- aPos = toPosition pos- in fiAnchors %= (Anchor{..} :)- LIST _ ->- mapM_ loop subs- ITEM ->- mapM_ loop subs- HTML_INLINE htmlText -> do- let mName = T.stripSuffix "\">" =<< T.stripPrefix "<a name=\"" htmlText- whenJust mName $ \aName -> do- let aType = HandAnchor- aPos = toPosition pos- fiAnchors %= (Anchor{..} :)- LINK url _ -> do- let rName = nodeExtractText node- rPos = toPosition pos- link = if null url then rName else url- let (rLink, rAnchor) = case T.splitOn "#" link of- [t] -> (t, Nothing)- t : ts -> (t, Just $ T.intercalate "#" ts)- [] -> error "impossible"- fiReferences %= (Reference{..} :)- _ -> pass+data IgnoreMode+ = Link+ | Paragraph+ | File+ deriving Eq -parseFileInfo :: FilePath -> LT.Text -> FileInfo-parseFileInfo path input =- let outcome = runIdentity . runExceptT $- nodeExtractInfo $ commonmarkToNode [] [] $ toStrict input- in case outcome of- Left err -> error $ "Failed to parse file " <> show path <>- ": " <> show err- Right res -> res+nodeExtractInfo :: Node -> Except Text FileInfo+nodeExtractInfo (Node _ _ docNodes) =+ if checkIgnoreFile docNodes+ then return def+ else finaliseFileInfo <$> extractionResult+ where+ extractionResult :: Except Text FileInfo+ extractionResult =+ execStateT (loop docNodes Nothing) def + loop :: [Node] -> Maybe IgnoreMode -> StateT FileInfo (Except Text) ()+ loop [] _ = pass+ loop (node@(Node pos ty subs) : nodes) toIgnore+ | toIgnore == Just File = returnError toIgnore "" pos+ | toIgnore == Just Link = do+ let (Node startPos _ _) = maybe defNode id $ safeHead subs+ let mNext = case ty of+ PARAGRAPH -> afterIgnoredLink subs <> Just nodes+ TEXT txt | null (dropWhile isSpace $ T.unpack txt) -> afterIgnoredLink nodes+ SOFTBREAK -> afterIgnoredLink nodes+ _ -> afterIgnoredLink (node : nodes)+ case mNext of+ Just next -> loop next Nothing+ Nothing -> returnError toIgnore "" startPos+ | toIgnore == Just Paragraph =+ case ty of+ PARAGRAPH -> loop nodes Nothing+ _ -> returnError toIgnore (prettyType ty) pos+ | otherwise =+ case ty of+ HTML_BLOCK _ -> processHtmlNode node pos nodes toIgnore+ HEADING lvl -> do+ let aType = HeaderAnchor lvl+ let aName = headerToAnchor $ nodeExtractText node+ let aPos = toPosition pos+ fiAnchors %= (Anchor{..} :)+ loop nodes toIgnore+ HTML_INLINE htmlText -> do+ let mName = T.stripSuffix "\">" =<< T.stripPrefix "<a name=\"" htmlText+ whenJust mName $ \aName -> do+ let aType = HandAnchor+ aPos = toPosition pos+ fiAnchors %= (Anchor{..} :)+ processHtmlNode node pos nodes toIgnore+ LINK url _ -> do+ let rName = nodeExtractText node+ rPos = toPosition pos+ link = if null url then rName else url+ let (rLink, rAnchor) = case T.splitOn "#" link of+ [t] -> (t, Nothing)+ t : ts -> (t, Just $ T.intercalate "#" ts)+ [] -> error "impossible"+ fiReferences %= (Reference{..} :)+ loop nodes toIgnore+ _ -> loop (subs ++ nodes) toIgnore++ defNode :: Node+ defNode = Node Nothing DOCUMENT [] -- hard-coded default Node++ getCommentContent :: Node -> Maybe Text+ getCommentContent node = do+ txt <- getHTMLText node+ T.stripSuffix "-->" =<< T.stripPrefix "<!--" (T.strip txt)+ where+ getHTMLText :: Node -> Maybe Text+ getHTMLText (Node _ (HTML_BLOCK txt) _) = Just txt+ getHTMLText (Node _ (HTML_INLINE txt) _) = Just txt+ getHTMLText _ = Nothing++ getXrefcheckContent :: Node -> Maybe Text+ getXrefcheckContent node =+ let notStripped = T.stripPrefix "xrefcheck:" . T.strip =<<+ getCommentContent node+ in T.strip <$> notStripped++ getIgnoreMode :: Node -> Maybe IgnoreMode+ getIgnoreMode node =+ let mContent = getXrefcheckContent node++ textToMode :: [Text] -> Maybe IgnoreMode+ textToMode ("ignore" : [x])+ | x == "link" = return Link+ | x == "paragraph" = return Paragraph+ | x == "file" = return File+ | otherwise = Nothing+ textToMode _ = Nothing+ in textToMode . words =<< mContent++ isComment :: Node -> Bool+ isComment = isJust . getCommentContent++ isIgnoreFile :: Node -> Bool+ isIgnoreFile = (Just File ==) . getIgnoreMode++ checkIgnoreFile :: [Node] -> Bool+ checkIgnoreFile nodes =+ let isSimpleComment :: Node -> Bool+ isSimpleComment node = isComment node && not (isIgnoreFile node)++ mIgnoreFile = safeHead $ dropWhile isSimpleComment nodes+ in maybe False isIgnoreFile mIgnoreFile++ isLink :: Node -> Bool+ isLink (Node _ (LINK _ _) _) = True+ isLink _ = False++ isText :: Node -> Bool+ isText (Node _ (TEXT _) _) = True+ isText _ = False++ afterIgnoredLink :: [Node] -> Maybe [Node]+ afterIgnoredLink (fNode : nodes)+ | isLink fNode = return nodes+ | sNode : nodes' <- nodes =+ if isText fNode && isLink sNode+ then return nodes'+ else Nothing+ | otherwise = Nothing+ afterIgnoredLink _ = Nothing++ prettyPos :: Maybe PosInfo -> Text+ prettyPos pos =+ let posToText :: Position -> Text+ posToText (Position mPos) = fromMaybe "" mPos+ in "(" <> (posToText $ toPosition pos) <> ")"++ prettyType :: NodeType -> Text+ prettyType ty =+ let mType = safeHead $ words $ show ty+ in maybe "" id mType++ fileMsg :: Text+ fileMsg =+ "\"ignore file\" must be at the top of \+ \markdown or right after comments at the top"++ linkMsg :: Text+ linkMsg = "expected a LINK after \"ignore link\" "++ paragraphMsg :: Text -> Text+ paragraphMsg txt = unwords+ [ "expected a PARAGRAPH after \+ \\"ignore paragraph\", but found"+ , txt+ , ""+ ]++ unrecognisedMsg :: Text -> Text+ unrecognisedMsg txt = unwords+ [ "unrecognised option"+ , "\"" <> txt <> "\""+ , "perhaps you meant \+ \<\"ignore link\"|\"ignore paragraph\"|\"ignore file\"> "+ ]++ returnError :: Maybe IgnoreMode -> Text -> Maybe PosInfo -> StateT FileInfo (Except Text) ()+ returnError mode txt pos =+ let errMsg = case mode of+ Just Link -> linkMsg+ Just Paragraph -> paragraphMsg txt+ Just File -> fileMsg+ Nothing -> unrecognisedMsg txt+ posInfo = prettyPos pos+ in lift $ throwE $ errMsg <> posInfo++ processHtmlNode :: Node -> Maybe PosInfo -> [Node] -> Maybe IgnoreMode -> StateT FileInfo (Except Text) ()+ processHtmlNode node pos nodes toIgnore = do+ let xrefcheckContent = getXrefcheckContent node+ case xrefcheckContent of+ Just content -> maybe (returnError Nothing content pos)+ (loop nodes . pure) $ getIgnoreMode node+ Nothing -> loop nodes toIgnore++parseFileInfo :: LT.Text -> Either Text FileInfo+parseFileInfo input = runExcept $ nodeExtractInfo $+ commonmarkToNode [] [] $ toStrict input+ markdownScanner :: ScanAction-markdownScanner path = liftIO $ do- res <- parseFileInfo path . decodeUtf8 <$> BSL.readFile path- force res `par` return res+markdownScanner path = do+ errOrInfo <- parseFileInfo . decodeUtf8 <$> BSL.readFile path+ case errOrInfo of+ Left errTxt -> do+ die $ "Error when scanning " <> path <> ": " <> T.unpack errTxt+ Right fileInfo -> return fileInfo markdownSupport :: ([Extension], ScanAction) markdownSupport = ([".md"], markdownScanner)
src/Xrefcheck/Util.hs view
@@ -8,8 +8,13 @@ module Xrefcheck.Util ( nameF' , paren+ , postfixFields+ , aesonConfigOption ) where +import Control.Lens (LensRules, lensField, lensRules, mappingNamer)+import qualified Data.Aeson as Aeson+import Data.Aeson.Casing (aesonPrefix, camelCase) import Fmt (Builder, build, fmt, nameF) import System.Console.Pretty (Pretty (..), Style (Faint)) @@ -24,3 +29,10 @@ paren a | a == "" = "" | otherwise = "(" <> a <> ")"++postfixFields :: LensRules+postfixFields = lensRules & lensField .~ mappingNamer (\n -> [n ++ "L"])++-- | Options that we use to derive JSON instances for config types.+aesonConfigOption :: Aeson.Options+aesonConfigOption = aesonPrefix camelCase
src/Xrefcheck/Verify.hs view
@@ -37,6 +37,7 @@ import System.Directory (canonicalizePath, doesDirectoryExist, doesFileExist) import System.FilePath (takeDirectory, (</>)) import qualified System.FilePath.Glob as Glob+import Text.Regex.TDFA.Text (Regex, regexec) import Text.URI (mkURI) import Time (RatioNat, Second, Time (..), ms, threadDelay, timeout) @@ -251,13 +252,25 @@ -> Text -> IO (VerifyResult VerifyError) checkExternalResource VerifyConfig{..} link+ | isIgnored = return mempty | doesReferLocalhost = return mempty | otherwise = fmap toVerifyRes $ do makeRequest HEAD 0.3 >>= \case Right () -> return $ Right () Left _ -> makeRequest GET 0.7 where+ isIgnored =+ let maybeIsIgnored = (doesMatchAnyRegex link) <$> vcIgnoreRefs+ in fromMaybe False maybeIsIgnored doesReferLocalhost = any (`T.isInfixOf` link) ["://localhost", "://127.0.0.1"]++ doesMatchAnyRegex :: Text -> ([Regex] -> Bool)+ doesMatchAnyRegex src = any $ \regex ->+ case regexec regex src of+ Right res -> case res of+ Just (before, match, after, _) -> null before && null after && not (null match)+ Nothing -> False+ Left _ -> False makeRequest :: _ => method -> RatioNat -> IO (Either VerifyError ()) makeRequest method timeoutFrac = runExceptT $ do
+ tests/Test/Xrefcheck/IgnoreAnnotationsSpec.hs view
@@ -0,0 +1,55 @@+{- SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>+ -+ - SPDX-License-Identifier: MPL-2.0+ -}++module Test.Xrefcheck.IgnoreAnnotationsSpec where++import qualified Data.ByteString.Lazy as BSL+import Test.Hspec (Spec, describe, it, shouldBe)++import Xrefcheck.Core+import Xrefcheck.Scanners.Markdown++spec :: Spec+spec = do+ describe "Parsing failures" $ do+ it "Check if parsing incorrect markdowns produce exceptions" $ do+ areIncorrect <- mapM isIncorrectMD failPaths+ or areIncorrect `shouldBe` True+ describe "\"ignore link\" mode" $ do+ it "Check \"ignore link\" performance" $ do+ fi <- getFI "tests/markdowns/with-annotations/ignore_link.md"+ (getRefs fi) `shouldBe` ["team", "team", "team", "hire-us", "how-we-work", "privacy"]+ describe "\"ignore paragraph\" mode" $ do+ it "Check \"ignore paragraph\" performance" $ do+ fi <- getFI "tests/markdowns/with-annotations/ignore_paragraph.md"+ (getRefs fi) `shouldBe` ["blog", "contacts"]+ describe "\"ignore file\" mode" $ do+ it "Check \"ignore file\" performance" $ do+ fi <- getFI "tests/markdowns/with-annotations/ignore_file.md"+ (getRefs fi) `shouldBe` []+ where+ failPaths :: [FilePath]+ failPaths =+ [ "tests/markdowns/with-annotations/no_link.md"+ , "tests/markdowns/with-annotations/no_paragraph.md"+ , "tests/markdowns/with-annotations/unexpected_ignore_file.md"+ , "tests/markdowns/with-annotations/unrecognised_option.md"+ ]++ parse :: FilePath -> IO (Either Text FileInfo)+ parse path = parseFileInfo . decodeUtf8 <$> BSL.readFile path++ getFI :: FilePath -> IO FileInfo+ getFI path =+ let errOrFI = parse path+ in either error id <$> errOrFI++ getRefs :: FileInfo -> [Text]+ getRefs fi = map rName $ fi ^. fiReferences++ isIncorrectMD :: FilePath -> IO Bool+ isIncorrectMD path = do+ errOrInfo <- parse path+ return $ isLeft errOrInfo
+ tests/Test/Xrefcheck/IgnoreRegexSpec.hs view
@@ -0,0 +1,84 @@+{- SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>+ -+ - SPDX-License-Identifier: MPL-2.0+ -}++module Test.Xrefcheck.IgnoreRegexSpec where++import Data.Yaml (decodeEither')+import Test.Hspec (Spec, describe, it)+import Test.HUnit (assertFailure)+import Text.Regex.TDFA (Regex)++import Xrefcheck.Config+import Xrefcheck.Core+import Xrefcheck.Progress (allowRewrite)+import Xrefcheck.Scan (gatherRepoInfo, specificFormatsSupport)+import Xrefcheck.Scanners.Markdown+import Xrefcheck.Verify+ (VerifyError, VerifyResult, WithReferenceLoc(..), verifyErrors, verifyRepo)++spec :: Spec+spec = do+ describe "Regular expressions performance" $ do+ let root = "tests/markdowns/without-annotations"+ let showProgressBar = False+ let formats = specificFormatsSupport [markdownSupport]+ let verifyMode = ExternalOnlyMode++ let linksTxt =+ [ "https://bad.((external.)?)reference(/?)"+ , "https://bad.reference.(org|com)"+ ]+ let regexs = linksToRegexs linksTxt+ let config = setIgnoreRefs regexs defConfig++ it "Check that only not matched links are verified" $ do+ repoInfo <- allowRewrite showProgressBar $ \rw ->+ gatherRepoInfo rw formats (config ^. cTraversalL) root++ verifyRes <- allowRewrite showProgressBar $ \rw ->+ verifyRepo rw (config ^. cVerificationL) verifyMode root repoInfo++ let brokenLinks = pickBrokenLinks verifyRes++ let matchedLinks =+ [ "https://bad.referenc/"+ , "https://bad.reference"+ , "https://bad.external.reference/"+ , "https://bad.external.reference"+ , "https://bad.reference.org"+ , "https://bad.reference.com"+ ]++ let notMatchedLinks =+ [ "https://non-existent.reference/"+ , "https://bad.externall.reference"+ , "https://bad.reference.io"+ ]++ forM_ matchedLinks $ \link -> do+ when (link `elem` brokenLinks) $+ assertFailure $ "Link \"" <> show link <>+ "\" is considered as broken but it should be ignored"++ forM_ notMatchedLinks $ \link -> do+ when (link `notElem` brokenLinks) $+ assertFailure $ "Link \"" <> show link <>+ "\" is not considered as broken but it is (and shouldn't be ignored)"++ where+ pickBrokenLinks :: VerifyResult (WithReferenceLoc VerifyError) -> [Text]+ pickBrokenLinks verifyRes =+ case verifyErrors verifyRes of+ Just neWithRefLoc -> map (rLink . wrlReference) $ toList neWithRefLoc+ Nothing -> []++ linksToRegexs :: [Text] -> Maybe [Regex]+ linksToRegexs links =+ let errOrRegexs = map (decodeEither' . encodeUtf8) links+ maybeRegexs = map (either (error . show) Just) errOrRegexs+ in sequence maybeRegexs++ setIgnoreRefs :: Maybe [Regex] -> Config -> Config+ setIgnoreRefs regexs = (cVerificationL . vcIgnoreRefsL) .~ regexs
xrefcheck.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: ab6af365f22152ef223e8a0ab2213ac72da2aa58d5211dc9d389c66e8515674f+-- hash: 70d0826ff0d9176a0e31e802b6bc0080babb13d5d147d903addf38da860567bb name: xrefcheck-version: 0.1.2+version: 0.1.3 description: Please see the README on GitHub at <https://github.com/serokell/xrefcheck#readme> homepage: https://github.com/serokell/xrefcheck#readme bug-reports: https://github.com/serokell/xrefcheck/issues@@ -45,11 +45,12 @@ hs-source-dirs: src default-extensions: AllowAmbiguousTypes BangPatterns ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveGeneric FlexibleContexts FlexibleInstances FunctionalDependencies GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeFamilies UndecidableInstances ViewPatterns TypeApplications TypeOperators- ghc-options: -Wall -Wincomplete-record-updates+ ghc-options: -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns build-depends: Glob+ , HUnit , aeson- , aeson-options+ , aeson-casing , async , base <4.15 , bytestring@@ -59,6 +60,7 @@ , deepseq , directory , directory-tree+ , file-embed , filepath , fmt , http-client@@ -69,6 +71,7 @@ , o-clock , optparse-applicative , pretty-terminal+ , regex-tdfa , req , roman-numerals , template-haskell@@ -76,6 +79,7 @@ , text-metrics , th-lift-instances , th-utilities+ , transformers , universum , with-utf8 , yaml@@ -94,11 +98,12 @@ hs-source-dirs: exec default-extensions: AllowAmbiguousTypes BangPatterns ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveGeneric FlexibleContexts FlexibleInstances FunctionalDependencies GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeFamilies UndecidableInstances ViewPatterns TypeApplications TypeOperators- ghc-options: -Wall -Wincomplete-record-updates -threaded -rtsopts -with-rtsopts=-N -O2+ ghc-options: -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns -threaded -rtsopts -with-rtsopts=-N -O2 build-depends: Glob+ , HUnit , aeson- , aeson-options+ , aeson-casing , async , base <4.15 , bytestring@@ -108,6 +113,7 @@ , deepseq , directory , directory-tree+ , file-embed , filepath , fmt , http-client@@ -118,6 +124,7 @@ , o-clock , optparse-applicative , pretty-terminal+ , regex-tdfa , req , roman-numerals , template-haskell@@ -125,6 +132,7 @@ , text-metrics , th-lift-instances , th-utilities+ , transformers , universum , with-utf8 , xrefcheck@@ -142,6 +150,8 @@ Spec Test.Xrefcheck.AnchorsSpec Test.Xrefcheck.ConfigSpec+ Test.Xrefcheck.IgnoreAnnotationsSpec+ Test.Xrefcheck.IgnoreRegexSpec Test.Xrefcheck.LocalSpec Paths_xrefcheck autogen-modules:@@ -149,14 +159,15 @@ hs-source-dirs: tests default-extensions: AllowAmbiguousTypes BangPatterns ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveGeneric FlexibleContexts FlexibleInstances FunctionalDependencies GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeFamilies UndecidableInstances ViewPatterns TypeApplications TypeOperators- ghc-options: -Wall -Wincomplete-record-updates+ ghc-options: -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns build-tool-depends: hspec-discover:hspec-discover build-depends: Glob+ , HUnit , QuickCheck , aeson- , aeson-options+ , aeson-casing , async , base <4.15 , bytestring@@ -166,6 +177,7 @@ , deepseq , directory , directory-tree+ , file-embed , filepath , fmt , hspec@@ -177,6 +189,7 @@ , o-clock , optparse-applicative , pretty-terminal+ , regex-tdfa , req , roman-numerals , template-haskell@@ -184,6 +197,7 @@ , text-metrics , th-lift-instances , th-utilities+ , transformers , universum , with-utf8 , xrefcheck