diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -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 ======= diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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: diff --git a/exec/Main.hs b/exec/Main.hs --- a/exec/Main.hs +++ b/exec/Main.hs @@ -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) diff --git a/src-files/def-config.yaml b/src-files/def-config.yaml --- a/src-files/def-config.yaml +++ b/src-files/def-config.yaml @@ -1,4 +1,4 @@ -# SPDX-FileCopyrightText: 2019 Serokell +# SPDX-FileCopyrightText: 2019-2021 Serokell # # 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: diff --git a/src/Xrefcheck/CLI.hs b/src/Xrefcheck/CLI.hs --- a/src/Xrefcheck/CLI.hs +++ b/src/Xrefcheck/CLI.hs @@ -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) diff --git a/src/Xrefcheck/Config.hs b/src/Xrefcheck/Config.hs --- a/src/Xrefcheck/Config.hs +++ b/src/Xrefcheck/Config.hs @@ -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::@ 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 diff --git a/src/Xrefcheck/Core.hs b/src/Xrefcheck/Core.hs --- a/src/Xrefcheck/Core.hs +++ b/src/Xrefcheck/Core.hs @@ -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 -- "-" suffixes to duplications to make them referable unambiguously. diff --git a/src/Xrefcheck/Scan.hs b/src/Xrefcheck/Scan.hs --- a/src/Xrefcheck/Scan.hs +++ b/src/Xrefcheck/Scan.hs @@ -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 diff --git a/src/Xrefcheck/Scanners/Markdown.hs b/src/Xrefcheck/Scanners/Markdown.hs --- a/src/Xrefcheck/Scanners/Markdown.hs +++ b/src/Xrefcheck/Scanners/Markdown.hs @@ -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) diff --git a/src/Xrefcheck/Util.hs b/src/Xrefcheck/Util.hs --- a/src/Xrefcheck/Util.hs +++ b/src/Xrefcheck/Util.hs @@ -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 diff --git a/tests/Test/Xrefcheck/AnchorsSpec.hs b/tests/Test/Xrefcheck/AnchorsSpec.hs --- a/tests/Test/Xrefcheck/AnchorsSpec.hs +++ b/tests/Test/Xrefcheck/AnchorsSpec.hs @@ -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" diff --git a/tests/Test/Xrefcheck/ConfigSpec.hs b/tests/Test/Xrefcheck/ConfigSpec.hs --- a/tests/Test/Xrefcheck/ConfigSpec.hs +++ b/tests/Test/Xrefcheck/ConfigSpec.hs @@ -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) diff --git a/tests/Test/Xrefcheck/IgnoreAnnotationsSpec.hs b/tests/Test/Xrefcheck/IgnoreAnnotationsSpec.hs --- a/tests/Test/Xrefcheck/IgnoreAnnotationsSpec.hs +++ b/tests/Test/Xrefcheck/IgnoreAnnotationsSpec.hs @@ -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 = diff --git a/tests/Test/Xrefcheck/IgnoreRegexSpec.hs b/tests/Test/Xrefcheck/IgnoreRegexSpec.hs --- a/tests/Test/Xrefcheck/IgnoreRegexSpec.hs +++ b/tests/Test/Xrefcheck/IgnoreRegexSpec.hs @@ -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 -> diff --git a/xrefcheck.cabal b/xrefcheck.cabal --- a/xrefcheck.cabal +++ b/xrefcheck.cabal @@ -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 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