packages feed

xrefcheck 0.1.3 → 0.2

raw patch · 15 files changed

+486/−103 lines, 15 filesnew-uploader

Files

CHANGES.md view
@@ -7,6 +7,12 @@ Unreleased ========== +0.2+==========+* [#57](https://github.com/serokell/xrefcheck/pull/57)+  + Added `flavor` field to config.+    Also see [config sample](tests/configs/github-config.yaml).+  + Config generated with `dump-config` CLI command now depends on the provided repository type.  0.1.3 =======
README.md view
@@ -153,7 +153,7 @@ Configuration template (with all options explained) can be dumped with:  ```sh-xrefcheck dump-config+xrefcheck dump-config -t GitHub ```  Currently supported options include:
exec/Main.hs view
@@ -13,15 +13,16 @@  import Xrefcheck.CLI import Xrefcheck.Config+import Xrefcheck.Core import Xrefcheck.Progress import Xrefcheck.Scan import Xrefcheck.Scanners import Xrefcheck.System import Xrefcheck.Verify -formats :: FormatsSupport-formats = specificFormatsSupport-    [ markdownSupport+formats :: ScannersConfig -> FormatsSupport+formats ScannersConfig{..} = specificFormatsSupport+    [ markdownSupport scMarkdown     ]  defaultAction :: Options -> IO ()@@ -33,8 +34,10 @@         mConfigPath <- findFirstExistingFile defaultConfigPaths         case mConfigPath of           Nothing -> do-            hPutStrLn @Text stderr "Configuration file not found, using default config\n"-            pure defConfig+            hPutStrLn @Text stderr+              "Configuration file not found, using default config \+              \for GitHub repositories\n"+            pure $ defConfig GitHub           Just configPath ->             readConfig configPath       Just configPath -> do@@ -45,7 +48,7 @@      repoInfo <- allowRewrite showProgressBar $ \rw -> do         let fullConfig = addTraversalOptions (cTraversal config) oTraversalOptions-        gatherRepoInfo rw formats fullConfig root+        gatherRepoInfo rw (formats $ cScanners config) fullConfig root      when oVerbose $         fmtLn $ "=== Repository data ===\n\n" <> indentF 2 (build repoInfo)@@ -79,5 +82,5 @@     case command of       DefaultCommand options ->         defaultAction options-      DumpConfig path ->-        BS.writeFile path defConfigText+      DumpConfig repoType path ->+        BS.writeFile path (defConfigText repoType)
src-files/def-config.yaml view
@@ -1,4 +1,4 @@-# SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>+# SPDX-FileCopyrightText: 2019-2021 Serokell <https://serokell.io> # # SPDX-License-Identifier: Unlicense @@ -26,33 +26,24 @@    # Prefixes of files, references in which should not be analyzed.   notScanned:-    # GitHub-specific files-    - .github/pull_request_template.md-    - .github/issue_template.md-    - .github/PULL_REQUEST_TEMPLATE-    - .github/ISSUE_TEMPLATE--    # GitLab-specific files-    - .gitlab/merge_request_templates/-    - .gitlab/issue_templates/+    - :PLACEHOLDER:notScanned:    # Glob patterns describing the files which do not physically exist in the   # repository but should be treated as existing nevertheless.   virtualFiles:-    # GitHub pages-    - ../../../issues-    - ../../../issues/*-    - ../../../pulls-    - ../../../pulls/*--    # GitLab pages-    - ../../issues-    - ../../issues/*-    - ../../merge_requests-    - ../../merge_requests/*+    - :PLACEHOLDER:virtualFiles:    # 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:     []++# Parameters of scanners for various file types.+scanners:++  markdown:+    # Flavor of markdown, e.g. GitHub-flavor.+    #+    # This affects which anchors are generated for headers.+    flavor: :PLACEHOLDER:flavor:
src/Xrefcheck/CLI.hs view
@@ -17,16 +17,18 @@     , getCommand     ) where +import qualified Data.Char as C import qualified Data.List as L+import qualified Data.Text as T import Data.Version (showVersion)-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 Options.Applicative+  (Parser, ReadM, command, eitherReader, execParser, flag', footerDoc, fullDesc, help, helper,+  hsubparser, info, infoOption, long, metavar, option, progDesc, short, strOption, switch, value) import Options.Applicative.Help.Pretty (Doc, displayS, fill, fillSep, indent, renderPretty, text)  import Paths_xrefcheck (version)-import Xrefcheck.Config import Xrefcheck.Core+import Xrefcheck.Scan  modeReadM :: ReadM VerifyMode modeReadM = eitherReader $ \s ->@@ -45,7 +47,7 @@  data Command   = DefaultCommand Options-  | DumpConfig FilePath+  | DumpConfig Flavor FilePath  data Options = Options     { oConfigPath       :: Maybe FilePath@@ -71,6 +73,24 @@ defaultConfigPaths :: [FilePath] defaultConfigPaths = ["./xrefcheck.yaml", "./.xrefcheck.yaml"] +-- | Strictly speaking, what config we will dump depends on the repository type:+-- this affects Markdown flavor, things excluded by default, e.t.c.+--+-- But at the moment there is one-to-one correspondence between repository types+-- and flavors, so we write a type alias here.+type RepoType = Flavor++repoTypeReadM :: ReadM RepoType+repoTypeReadM = eitherReader $ \name ->+  maybeToRight (failureText name) $ L.lookup (map C.toLower name) allRepoTypesNamed+  where+    allRepoTypesNamed =+      allRepoTypes <&> \ty -> (toString $ T.toLower (show ty), ty)+    failureText name =+      "Unknown repository type: " <> show name <> "\n\+      \Expected one of: " <> mconcat (intersperse ", " $ map show allRepoTypes)+    allRepoTypes = allFlavors+ optionsParser :: Parser Options optionsParser = do     oConfigPath <- optional . strOption $@@ -122,13 +142,23 @@         help "Files and folders which we pretend do not exist."     return TraversalOptions{..} -dumpConfigOptions :: Parser FilePath+dumpConfigOptions :: Parser Command dumpConfigOptions = hsubparser $   command "dump-config" $     info parser $     progDesc "Dump default configuration into a file."   where-    parser = strOption $+    parser = DumpConfig <$> repoTypeOption <*> outputOption++    repoTypeOption =+      option repoTypeReadM $+      short 't' <>+      long "type" <>+      metavar "REPOSITORY TYPE" <>+      help "Git repository type."++    outputOption =+      strOption $       short 'o' <>       long "output" <>       metavar "FILEPATH" <>@@ -138,7 +168,7 @@ totalParser :: Parser Command totalParser = asum   [ DefaultCommand <$> optionsParser-  , DumpConfig <$> dumpConfigOptions+  , dumpConfigOptions   ]  versionOption :: Parser (a -> a)
src/Xrefcheck/Config.hs view
@@ -7,32 +7,37 @@  module Xrefcheck.Config where +import qualified Unsafe++import Control.Exception (assert) import Control.Lens (makeLensesWith) import Data.Aeson.TH (deriveFromJSON)+import qualified Data.ByteString as BS+import qualified Data.Map as Map import Data.Yaml (FromJSON (..), decodeEither', prettyPrintParseException, withText) import Instances.TH.Lift () import Text.Regex.TDFA (CompOption (..), ExecOption (..), Regex)-import Text.Regex.TDFA.Text (compile)+import qualified Text.Regex.TDFA as R+import Text.Regex.TDFA.ByteString ()+import qualified Text.Regex.TDFA.Text as R -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 Data.FileEmbed (embedFile) import System.FilePath.Posix ((</>)) import Time (KnownRatName, Second, Time, unitsP) +import Xrefcheck.Core+import Xrefcheck.Scan+import Xrefcheck.Scanners.Markdown import Xrefcheck.System (RelGlobPattern)-import Xrefcheck.Util (aesonConfigOption, postfixFields)+import Xrefcheck.Util (aesonConfigOption, postfixFields, (-:))  -- | Overall config. data Config = Config     { cTraversal    :: TraversalConfig     , cVerification :: VerifyConfig-    }---- | Config of repositry traversal.-data TraversalConfig = TraversalConfig-    { tcIgnored   :: [FilePath]-      -- ^ Files and folders, files in which we completely ignore.+    , cScanners     :: ScannersConfig     }  -- | Config of verification.@@ -47,6 +52,11 @@       -- ^ Regular expressions that match external references we should not verify.     } +-- | Configs for all the supported scanners.+data ScannersConfig = ScannersConfig+    { scMarkdown :: MarkdownConfig+    }+ makeLensesWith postfixFields ''Config makeLensesWith postfixFields ''VerifyConfig @@ -54,25 +64,126 @@ -- Default config ----------------------------------------------------------- +defConfigUnfilled :: ByteString+defConfigUnfilled =+  $(embedFile ("src-files" </> "def-config.yaml"))++-- | Picks raw config with @:PLACEHOLDER:<key>:@ and fills the specified fields+-- in it, picking a replacement suitable for the given key. Only strings and lists+-- of strings can be filled this way.+--+-- This will fail if any placeholder is left unreplaced, however extra keys in+-- the provided replacement won't cause any warnings or failures.+fillHoles+  :: HasCallStack+  => [(ByteString, Either ByteString [ByteString])] -> ByteString -> ByteString+fillHoles allReplacements rawConfig =+  let holesLocs = R.getAllMatches $ holeLineRegex `R.match` rawConfig+  in mconcat $ replaceHoles 0 holesLocs+  where+    showBs :: ByteString -> Text+    showBs = show @_ @Text . decodeUtf8++    holeLineRegex :: R.Regex+    holeLineRegex = R.makeRegex ("[ -]+:PLACEHOLDER:[^:]+:" :: Text)++    replacementsMap = Map.fromList allReplacements+    getReplacement key =+      Map.lookup key replacementsMap+      ?: error ("Replacement for key " <> showBs key <> " is not specified")++    pickConfigSubstring :: Int -> Int -> ByteString+    pickConfigSubstring from len = BS.take len $ BS.drop from rawConfig++    replaceHoles :: Int -> [(R.MatchOffset, R.MatchLength)] -> [ByteString]+    replaceHoles processedLen [] = one $ BS.drop processedLen rawConfig+    replaceHoles processedLen ((off, len) : locs) =+      -- in our case matches here should not overlap+      assert (off > processedLen) $+        pickConfigSubstring processedLen (off - processedLen) :+        replaceHole (pickConfigSubstring off len) +++        replaceHoles (off + len) locs++    holeItemRegex :: R.Regex+    holeItemRegex = R.makeRegex ("(^|:)([ ]*):PLACEHOLDER:([^:]+):" :: Text)++    holeListRegex :: R.Regex+    holeListRegex = R.makeRegex ("^([ ]*-[ ]*):PLACEHOLDER:([^:]+):" :: Text)++    replaceHole :: ByteString -> [ByteString]+    replaceHole holeLine = if+      | Just [_wholeMatch, _beginning, leadingSpaces, key] <-+        R.getAllTextSubmatches <$> (holeItemRegex `R.matchM` holeLine) ->+          case getReplacement key of+            Left replacement -> [leadingSpaces, replacement]+            Right _ -> error $+              "Key " <> showBs key <> " requires replacement with an item, \+              \but list was given"++      | Just [_wholeMatch, leadingChars, key] <-+        R.getAllTextSubmatches <$> (holeListRegex `R.matchM` holeLine) ->+          case getReplacement key of+            Left _ -> error $+              "Key " <> showBs key <> " requires replacement with a list, \+              \but an item was given"+            Right [] ->+              ["[]"]+            Right replacements@(_ : _) ->+              Unsafe.init $ do+                replacement <- replacements+                [leadingChars, replacement, "\n"]++      | otherwise ->+          error $ "Unrecognized placeholder pattern " <> showBs holeLine+ -- | Default config in textual representation. -- -- Sometimes you cannot just use 'defConfig' because clarifying comments -- would be lost.-defConfigText :: ByteString-defConfigText =-  $(embedFile ("src-files" </> "def-config.yaml"))+defConfigText :: Flavor -> ByteString+defConfigText flavor =+  flip fillHoles defConfigUnfilled+    [+      "flavor" -: Left (show flavor) -defConfig :: HasCallStack => Config-defConfig =+    , "notScanned" -: Right $ case flavor of+        GitHub ->+          [ ".github/pull_request_template.md"+          , ".github/issue_template.md"+          , ".github/PULL_REQUEST_TEMPLATE"+          , ".github/ISSUE_TEMPLATE"+          ]+        GitLab ->+          [ ".gitlab/merge_request_templates/"+          , ".gitlab/issue_templates/"+          ]++    , "virtualFiles" -: Right $ case flavor of+        GitHub ->+          [ "../../../issues"+          , "../../../issues/*"+          , "../../../pulls"+          , "../../../pulls/*"+          ]+        GitLab ->+          [ "../../issues"+          , "../../issues/*"+          , "../../merge_requests"+          , "../../merge_requests/*"+          ]+    ]++defConfig :: HasCallStack => Flavor -> Config+defConfig flavor =   either (error . toText . prettyPrintParseException) id $-  decodeEither' defConfigText+  decodeEither' (defConfigText flavor)  ----------------------------------------------------------- -- Yaml instances -----------------------------------------------------------  deriveFromJSON aesonConfigOption ''Config-deriveFromJSON aesonConfigOption ''TraversalConfig+deriveFromJSON aesonConfigOption ''ScannersConfig deriveFromJSON aesonConfigOption ''VerifyConfig  instance KnownRatName unit => FromJSON (Time unit) where@@ -82,7 +193,7 @@ instance FromJSON Regex where     parseJSON = withText "regex" $ \val -> do         let errOrRegex =-                compile defaultCompOption defaultExecOption val+                R.compile defaultCompOption defaultExecOption val         either (error . show) return errOrRegex  -- Default boolean values according to
src/Xrefcheck/Core.hs view
@@ -10,6 +10,7 @@ module Xrefcheck.Core where  import Control.Lens (makeLenses, (%=))+import Data.Aeson (FromJSON (..), withText) import Data.Char (isAlphaNum) import qualified Data.Char as C import Data.Default (Default (..))@@ -28,6 +29,30 @@ -- Types ----------------------------------------------------------- +-- | Markdown flavor.+--+-- Unfortunatelly, CMark renderers used on different sites slightly differ,+-- we have to account for that.+data Flavor+  = GitHub+  | GitLab+  deriving (Show)++allFlavors :: [Flavor]+allFlavors = [GitHub, GitLab]+  where+    _exhaustivenessCheck = \case+      GitHub -> ()+      GitLab -> ()+      -- if you update this, also update the list above++instance FromJSON Flavor where+  parseJSON = withText "flavor" $ \txt ->+    case T.toLower txt of+      "github" -> pure GitHub+      "gitlab" -> pure GitLab+      _ -> fail $ "Unknown flavor " <> show txt+ -- | Description of element position in source file. -- We keep this in text because scanners for different formats use different -- representation of this thing, and it actually appears in reports only.@@ -210,19 +235,33 @@  -- | Convert section header name to an anchor refering it. -- Conversion rules: https://docs.gitlab.com/ee/user/markdown.html#header-ids-and-links-headerToAnchor :: Text -> Text-headerToAnchor t = t+headerToAnchor :: Flavor -> Text -> Text+headerToAnchor flavor = \t -> t     & T.toLower-    & T.replace "+" tmp-    & T.replace " " tmp-    & joinSyms tmp-    & T.replace (tmp <> "-") "-"-    & T.replace ("-" <> tmp) "-"-    & T.replace tmp "-"-    & T.filter (\c -> isAlphaNum c || c == '_' || c == '-')+    & mergeSpecialSymbols   where-    joinSyms sym = T.intercalate sym . filter (not . null) . T.splitOn sym-    tmp = "\0"+    joinSubsequentChars sym = toText . go . toString+      where+      go = \case+        (c1 : c2 : s)+          | c1 == c2 && c1 == sym -> go (c1 : s)+        (c : s) -> c : go s+        [] -> []++    mergeSpecialSymbols = case flavor of+      GitLab -> \t -> t+        & T.replace " " "-"+        & T.filter (\c -> isAlphaNum c || c == '_' || c == '-')+        & joinSubsequentChars '-'+      GitHub ->+        -- GitHub case is tricky, it can produce many hythens in a row, e.g.+        -- "A - B" -> "a---b"+        let tmp = '\0'; tmpT = T.singleton tmp+        in \t -> t+        & T.replace " " tmpT+        & joinSubsequentChars tmp+        & T.replace tmpT "-"+        & T.filter (\c -> isAlphaNum c || c == '_' || c == '-')  -- | When there are several anchors with the same name, github automatically attaches -- "-<number>" suffixes to duplications to make them referable unambiguously.
src/Xrefcheck/Scan.hs view
@@ -6,7 +6,8 @@ -- | Generalised repo scanner and analyser.  module Xrefcheck.Scan-    ( Extension+    ( TraversalConfig (..)+    , Extension     , ScanAction     , FormatsSupport     , RepoInfo (..)@@ -15,16 +16,24 @@     , specificFormatsSupport     ) where +import Data.Aeson.TH (deriveFromJSON) import qualified Data.Foldable as F import qualified Data.Map as M import GHC.Err (errorWithoutStackTrace) import qualified System.Directory.Tree as Tree import System.FilePath (takeDirectory, takeExtension, (</>)) -import Xrefcheck.Config import Xrefcheck.Core import Xrefcheck.Progress-import Xrefcheck.Util ()+import Xrefcheck.Util (aesonConfigOption)++-- | Config of repositry traversal.+data TraversalConfig = TraversalConfig+    { tcIgnored   :: [FilePath]+      -- ^ Files and folders, files in which we completely ignore.+    }++deriveFromJSON aesonConfigOption ''TraversalConfig  -- | File extension, dot included. type Extension = String
src/Xrefcheck/Scanners/Markdown.hs view
@@ -8,7 +8,9 @@ -- | Markdown documents markdownScanner.  module Xrefcheck.Scanners.Markdown-    ( markdownScanner+    ( MarkdownConfig (..)+    , defGithubMdConfig+    , markdownScanner     , markdownSupport     , parseFileInfo     ) where@@ -16,6 +18,7 @@ import CMarkGFM (Node (..), NodeType (..), PosInfo (..), commonmarkToNode) import Control.Lens ((%=)) import Control.Monad.Trans.Except (Except, runExcept, throwE)+import Data.Aeson.TH (deriveFromJSON) import qualified Data.ByteString.Lazy as BSL import Data.Char (isSpace) import Data.Default (Default (..))@@ -25,7 +28,19 @@  import Xrefcheck.Core import Xrefcheck.Scan+import Xrefcheck.Util +data MarkdownConfig = MarkdownConfig+  { mcFlavor :: Flavor+  }++deriveFromJSON aesonConfigOption ''MarkdownConfig++defGithubMdConfig :: MarkdownConfig+defGithubMdConfig = MarkdownConfig+  { mcFlavor = GitHub+  }+ instance Buildable Node where     build (Node _mpos ty subs) = nameF (show ty) $ blockListF subs @@ -57,8 +72,8 @@     | File     deriving Eq -nodeExtractInfo :: Node -> Except Text FileInfo-nodeExtractInfo (Node _ _ docNodes) =+nodeExtractInfo :: MarkdownConfig -> Node -> Except Text FileInfo+nodeExtractInfo config (Node _ _ docNodes) =     if checkIgnoreFile docNodes     then return def     else finaliseFileInfo <$> extractionResult@@ -90,7 +105,8 @@                     HTML_BLOCK _ -> processHtmlNode node pos nodes toIgnore                     HEADING lvl -> do                         let aType = HeaderAnchor lvl-                        let aName = headerToAnchor $ nodeExtractText node+                        let aName = headerToAnchor (mcFlavor config) $+                                    nodeExtractText node                         let aPos = toPosition pos                         fiAnchors %= (Anchor{..} :)                         loop nodes toIgnore@@ -230,17 +246,17 @@                     (loop nodes . pure) $ getIgnoreMode node                 Nothing -> loop nodes toIgnore -parseFileInfo :: LT.Text -> Either Text FileInfo-parseFileInfo input = runExcept $ nodeExtractInfo $+parseFileInfo :: MarkdownConfig -> LT.Text -> Either Text FileInfo+parseFileInfo config input = runExcept $ nodeExtractInfo config $     commonmarkToNode [] [] $ toStrict input -markdownScanner :: ScanAction-markdownScanner path = do-    errOrInfo <- parseFileInfo . decodeUtf8 <$> BSL.readFile path+markdownScanner :: MarkdownConfig -> ScanAction+markdownScanner config path = do+    errOrInfo <- parseFileInfo config . 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)+markdownSupport :: MarkdownConfig -> ([Extension], ScanAction)+markdownSupport config = ([".md"], markdownScanner config)
src/Xrefcheck/Util.hs view
@@ -9,6 +9,7 @@     ( nameF'     , paren     , postfixFields+    , (-:)     , aesonConfigOption     ) where @@ -32,6 +33,10 @@  postfixFields :: LensRules postfixFields = lensRules & lensField .~ mappingNamer (\n -> [n ++ "L"])++infixr 0 -:+(-:) :: a -> b -> (a, b)+(-:) = (,)  -- | Options that we use to derive JSON instances for config types. aesonConfigOption :: Aeson.Options
tests/Test/Xrefcheck/AnchorsSpec.hs view
@@ -8,12 +8,20 @@ import Test.Hspec (Spec, describe, it) import Test.QuickCheck ((===)) -import Xrefcheck.Core (headerToAnchor)+import Xrefcheck.Core (Flavor (..), headerToAnchor) +checkHeaderConversions+  :: HasCallStack+  => Flavor -> [(Text, Text)] -> Spec+checkHeaderConversions fl suites =+  describe (show fl) $+    forM_ suites $ \(a, b) ->+      it (show a <> " == " <> show b) $ headerToAnchor fl a === b+ spec :: Spec spec = do-    describe "Header-to-anchor conversion" $-        mapM_ (\(a, b) -> it (show a <> " == " <> show b) $ headerToAnchor a === b) $+    describe "Header-to-anchor conversion" $ do+      checkHeaderConversions GitHub         [ ( "Some header"           , "some-header"           )@@ -26,6 +34,9 @@         , ( "a ## b"           , "a--b"           )+        , ( "a - b"+          , "a---b"+          )         , ( "a * b"           , "a--b"           )@@ -35,14 +46,77 @@         , ( "a \\ b"           , "a--b"           )+        , ( "a + b"+          , "a--b"+          )+        , ( "a+b"+          , "ab"+          )+        , ( "a & b"+          , "a--b"+          )+        , ( "a &b"+          , "a-b"+          )+        , ( "a - -- - b"+          , "a--------b"+          )+        , ( "a -+--|- b"+          , "a------b"+          )         , ( "Some *italic* text"           , "some-italic-text"           )-        , ( "Some-text-with--many----hyphens"-          , "some-text-with--many----hyphens"+        , ( "-Some-text-with--many----hyphens-"+          , "-some-text-with--many----hyphens-"           )+        , ( "- A -"+          , "--a--"+          )         , ( "Some-+++++--mess++-mda"           , "some---mess-mda"+          )+        , ( ":white_check_mark: Checklist for your Pull Request"+          , "white_check_mark-checklist-for-your-pull-request"+          )+        ]++      checkHeaderConversions GitLab+        [ ( "a # b"+          , "a-b"+          )+        , ( "a - b"+          , "a-b"+          )+        , ( "a -- b"+          , "a-b"+          )+        , ( "a & b"+          , "a-b"+          )+        , ( "a + b"+          , "a-b"+          )+        , ( "a+b"+          , "ab"+          )+        , ( "a - -- - b"+          , "a-b"+          )+        , ( "a -+--|- b"+          , "a-b"+          )+        , ( "Some *italic* text"+          , "some-italic-text"+          )+        , ( "-Some-text-with--many----hyphens-"+          , "-some-text-with-many-hyphens-"+          )+        , ( "- A -"+          , "-a-"+          )+        , ( "Some-+++++--mess++-mda"+          , "some-mess-mda"           )         , ( ":white_check_mark: Checklist for your Pull Request"           , "white_check_mark-checklist-for-your-pull-request"
tests/Test/Xrefcheck/ConfigSpec.hs view
@@ -5,12 +5,32 @@  module Test.Xrefcheck.ConfigSpec where -import Test.Hspec (Spec, it)-import Test.QuickCheck (ioProperty, once)+import qualified Data.ByteString as BS+import Test.Hspec (Spec, before, describe, it)+import Test.QuickCheck (counterexample, ioProperty, once)  import Xrefcheck.Config+import Xrefcheck.Core  spec :: Spec-spec =-  it "Default config is valid" $-    once . ioProperty $ evaluateWHNF_ @_ @Config defConfig+spec = do+  describe "Default config is valid" $+    forM_ allFlavors $ \flavor ->+      it (show flavor) $+        once . ioProperty $ evaluateWHNF_ @_ @Config (defConfig flavor)++  describe "Filled default config matches the expected format" $+    before (BS.readFile "tests/configs/github-config.yaml") $+      -- The config we match against can be regenerated with+      -- stack exec xrefcheck -- dump-config -t GitHub -o tests/configs/github-config.yaml+      it "Config matches" $+        \config ->+          counterexample+            (toString $ unwords+             [ "Config does not match the expected format."+             , "Run"+             , "`stack exec xrefcheck -- dump-config -t GitHub -o tests/configs/github-config.yaml`"+             , "and verify changes"+             ]+            )+            (config == defConfigText GitHub)
tests/Test/Xrefcheck/IgnoreAnnotationsSpec.hs view
@@ -39,7 +39,8 @@             ]          parse :: FilePath -> IO (Either Text FileInfo)-        parse path = parseFileInfo . decodeUtf8 <$> BSL.readFile path+        parse path =+            parseFileInfo defGithubMdConfig . decodeUtf8 <$> BSL.readFile path          getFI :: FilePath -> IO FileInfo         getFI path =
tests/Test/Xrefcheck/IgnoreRegexSpec.hs view
@@ -6,8 +6,8 @@ module Test.Xrefcheck.IgnoreRegexSpec where  import Data.Yaml (decodeEither')-import Test.Hspec (Spec, describe, it) import Test.HUnit (assertFailure)+import Test.Hspec (Spec, describe, it) import Text.Regex.TDFA (Regex)  import Xrefcheck.Config@@ -15,15 +15,14 @@ import Xrefcheck.Progress (allowRewrite) import Xrefcheck.Scan (gatherRepoInfo, specificFormatsSupport) import Xrefcheck.Scanners.Markdown-import Xrefcheck.Verify-    (VerifyError, VerifyResult, WithReferenceLoc(..), verifyErrors, verifyRepo)+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 formats = specificFormatsSupport [markdownSupport defGithubMdConfig]         let verifyMode = ExternalOnlyMode          let linksTxt =@@ -31,7 +30,7 @@                 , "https://bad.reference.(org|com)"                 ]         let regexs = linksToRegexs linksTxt-        let config = setIgnoreRefs regexs defConfig+        let config = setIgnoreRefs regexs (defConfig GitHub)          it "Check that only not matched links are verified" $ do             repoInfo <- allowRewrite showProgressBar $ \rw ->
xrefcheck.cabal view
@@ -1,13 +1,11 @@ cabal-version: 2.0 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.35.0. -- -- see: https://github.com/sol/hpack------ hash: 70d0826ff0d9176a0e31e802b6bc0080babb13d5d147d903addf38da860567bb  name:           xrefcheck-version:        0.1.3+version:        0.2 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@@ -44,7 +42,34 @@       Paths_xrefcheck   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+  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 -Wincomplete-uni-patterns   build-depends:       Glob@@ -97,7 +122,34 @@       Paths_xrefcheck   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+  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 -Wincomplete-uni-patterns -threaded -rtsopts -with-rtsopts=-N -O2   build-depends:       Glob@@ -158,7 +210,34 @@       Paths_xrefcheck   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+  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 -Wincomplete-uni-patterns   build-tool-depends:       hspec-discover:hspec-discover