serokell/xrefcheck
1
1
Fork 0
mirror of https://github.com/serokell/xrefcheck.git synced 2024-09-11 13:37:36 +03:00
Code Issues Projects Releases Wiki Activity

[#55] Generate config depending on the repo type

Browse Source 
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:
martoon 2021-02-25 18:48:51 +03:00
parent aac3d5aec7
commit 045f4146cf
No known key found for this signature in database
GPG Key ID: FF02288E36C0E4B0
11 changed files with 259 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
README.md
View File

@ -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
View File

@ -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)

1
package.yaml
View File

@ -83,6 +83,7 @@ dependencies:
- optparse-applicative
- regex-tdfa
- req
- regex-tdfa
- roman-numerals
- template-haskell
- text

26
src-files/def-config.yaml
View File

@ -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:

38
src/Xrefcheck/CLI.hs
View File

@ -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)

127
src/Xrefcheck/Config.hs
View File

@ -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

8
src/Xrefcheck/Core.hs
View File

@ -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

5
src/Xrefcheck/Util.hs
View File

@ -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

30
tests/Test/Xrefcheck/ConfigSpec.hs
View File

@ -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)

2
tests/Test/Xrefcheck/IgnoreRegexSpec.hs
View File

@ -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
View 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