mirror of
https://github.com/serokell/xrefcheck.git
synced 2024-09-11 13:37:36 +03:00
[#55] Generate config depending on the repo type
Problem: now when we include repository type into the config, it seems to make sense to generate config differently depending on the repository type. Especially taking into account that currently in some fields we mix GitHub and GitLab -specific contents. Solution: Leave placeholders in the default config and later fill them from the code depending on the required repository type. Add a mandatory repository type parameter to `dump-config` CLI command. Along with a test checking for config validity, add a golden test on the produced config so that we could assess how sane it looks like.
This commit is contained in:
parent
aac3d5aec7
commit
045f4146cf
@ -153,7 +153,7 @@ xrefcheck --help
|
||||
Configuration template (with all options explained) can be dumped with:
|
||||
|
||||
```sh
|
||||
xrefcheck dump-config
|
||||
xrefcheck dump-config -t GitHub
|
||||
```
|
||||
|
||||
Currently supported options include:
|
||||
|
11
exec/Main.hs
11
exec/Main.hs
@ -13,6 +13,7 @@ import System.Directory (doesFileExist)
|
||||
|
||||
import Xrefcheck.CLI
|
||||
import Xrefcheck.Config
|
||||
import Xrefcheck.Core
|
||||
import Xrefcheck.Progress
|
||||
import Xrefcheck.Scan
|
||||
import Xrefcheck.Scanners
|
||||
@ -33,8 +34,10 @@ defaultAction Options{..} = do
|
||||
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
|
||||
@ -79,5 +82,5 @@ main = withUtf8 $ do
|
||||
case command of
|
||||
DefaultCommand options ->
|
||||
defaultAction options
|
||||
DumpConfig path ->
|
||||
BS.writeFile path defConfigText
|
||||
DumpConfig repoType path ->
|
||||
BS.writeFile path (defConfigText repoType)
|
||||
|
@ -83,6 +83,7 @@ dependencies:
|
||||
- optparse-applicative
|
||||
- regex-tdfa
|
||||
- req
|
||||
- regex-tdfa
|
||||
- roman-numerals
|
||||
- template-haskell
|
||||
- text
|
||||
|
@ -1,4 +1,4 @@
|
||||
# SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>
|
||||
# SPDX-FileCopyrightText: 2019-2021 Serokell <https://serokell.io>
|
||||
#
|
||||
# SPDX-License-Identifier: Unlicense
|
||||
|
||||
@ -26,30 +26,12 @@ verification:
|
||||
|
||||
# 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).
|
||||
@ -64,4 +46,4 @@ scanners:
|
||||
# Flavor of markdown, e.g. GitHub-flavor.
|
||||
#
|
||||
# This affects which anchors are generated for headers.
|
||||
flavor: GitHub
|
||||
flavor: :PLACEHOLDER:flavor:
|
||||
|
@ -17,7 +17,9 @@ module Xrefcheck.CLI
|
||||
, 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,
|
||||
@ -45,7 +47,7 @@ modeReadM = eitherReader $ \s ->
|
||||
|
||||
data Command
|
||||
= DefaultCommand Options
|
||||
| DumpConfig FilePath
|
||||
| DumpConfig Flavor FilePath
|
||||
|
||||
data Options = Options
|
||||
{ oConfigPath :: Maybe FilePath
|
||||
@ -71,6 +73,24 @@ addTraversalOptions TraversalConfig{..} (TraversalOptions ignored) =
|
||||
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 @@ traversalOptionsParser = do
|
||||
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 @@ dumpConfigOptions = hsubparser $
|
||||
totalParser :: Parser Command
|
||||
totalParser = asum
|
||||
[ DefaultCommand <$> optionsParser
|
||||
, DumpConfig <$> dumpConfigOptions
|
||||
, dumpConfigOptions
|
||||
]
|
||||
|
||||
versionOption :: Parser (a -> a)
|
||||
|
@ -7,12 +7,19 @@
|
||||
|
||||
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
|
||||
|
||||
-- FIXME: Use </> from System.FilePath
|
||||
-- </> from Posix is used only because we cross-compile to Windows and \ doesn't work on Linux
|
||||
@ -20,10 +27,11 @@ 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
|
||||
@ -56,18 +64,119 @@ makeLensesWith postfixFields ''VerifyConfig
|
||||
-- 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
|
||||
@ -84,7 +193,7 @@ instance KnownRatName unit => FromJSON (Time unit) where
|
||||
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
|
||||
|
@ -38,6 +38,14 @@ data Flavor
|
||||
| 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
|
||||
|
@ -9,6 +9,7 @@ module Xrefcheck.Util
|
||||
( nameF'
|
||||
, paren
|
||||
, postfixFields
|
||||
, (-:)
|
||||
, aesonConfigOption
|
||||
) where
|
||||
|
||||
@ -33,6 +34,10 @@ paren a
|
||||
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
|
||||
aesonConfigOption = aesonPrefix camelCase
|
||||
|
@ -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)
|
||||
|
@ -30,7 +30,7 @@ spec = do
|
||||
, "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 ->
|
||||
|
55
tests/configs/github-config.yaml
Normal file
55
tests/configs/github-config.yaml
Normal file
@ -0,0 +1,55 @@
|
||||
# SPDX-FileCopyrightText: 2019-2021 Serokell <https://serokell.io>
|
||||
#
|
||||
# SPDX-License-Identifier: Unlicense
|
||||
|
||||
# Parameters of repository traversal.
|
||||
traversal:
|
||||
# Files and folders which we pretend do not exist
|
||||
# (so they are neither analyzed nor can be referenced).
|
||||
ignored:
|
||||
# Git files
|
||||
- .git
|
||||
|
||||
# Stack files
|
||||
- .stack-work
|
||||
|
||||
|
||||
# Verification parameters.
|
||||
verification:
|
||||
# On 'anchor not found' error, how much similar anchors should be displayed as
|
||||
# hint. Number should be between 0 and 1, larger value means stricter filter.
|
||||
anchorSimilarityThreshold: 0.5
|
||||
|
||||
# When checking external references, how long to wait on request before
|
||||
# declaring "Response timeout".
|
||||
externalRefCheckTimeout: 10s
|
||||
|
||||
# Prefixes of files, references in which should not be analyzed.
|
||||
notScanned:
|
||||
- .github/pull_request_template.md
|
||||
- .github/issue_template.md
|
||||
- .github/PULL_REQUEST_TEMPLATE
|
||||
- .github/ISSUE_TEMPLATE
|
||||
|
||||
# Glob patterns describing the files which do not physically exist in the
|
||||
# repository but should be treated as existing nevertheless.
|
||||
virtualFiles:
|
||||
- ../../../issues
|
||||
- ../../../issues/*
|
||||
- ../../../pulls
|
||||
- ../../../pulls/*
|
||||
|
||||
# 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: GitHub
|
Loading…
Reference in New Issue
Block a user