From 82bf9966154162d188a6cc6c378e71f57dfea276 Mon Sep 17 00:00:00 2001 From: Anton Sorokin Date: Tue, 25 Oct 2022 21:37:28 +0300 Subject: [PATCH] [#201] Use nyan-interpolation for building error messages Problem: We often need to create large strings, and we use different fmt tools for this (by-hand concatenation, unlinesF, etc). Sometimes it is unclear or too heavy, and it always can be called error-prone Solution: use `int` quasiquoter to build large strings and have nice-looking and easy-to-read code --- package.yaml | 2 + src/Xrefcheck/CLI.hs | 37 +++--- src/Xrefcheck/Command.hs | 37 ++++-- src/Xrefcheck/Config.hs | 13 ++- src/Xrefcheck/Config/Default.hs | 2 - src/Xrefcheck/Core.hs | 47 ++++---- src/Xrefcheck/Orphans.hs | 12 +- src/Xrefcheck/Scan.hs | 29 +++-- src/Xrefcheck/Scanners/Markdown.hs | 13 ++- src/Xrefcheck/System.hs | 17 +-- src/Xrefcheck/Verify.hs | 110 ++++++++++++------ stack.yaml | 5 + stack.yaml.lock | 26 +++++ tests/Test/Xrefcheck/URIParsingSpec.hs | 2 - .../check-anchors/ambiguous-anchors/a.md | 16 +++ .../check-anchors/ambiguous-anchors/b.md | 7 ++ tests/golden/check-anchors/check-anchors.bats | 98 ++++++++++++++++ .../check-anchors/non-existing-anchors/a.md | 16 +++ .../check-autolinks/check-autolinks.bats | 3 +- tests/golden/check-images/expected.gold | 3 +- 20 files changed, 371 insertions(+), 124 deletions(-) create mode 100644 tests/golden/check-anchors/ambiguous-anchors/a.md create mode 100644 tests/golden/check-anchors/ambiguous-anchors/b.md create mode 100644 tests/golden/check-anchors/check-anchors.bats create mode 100644 tests/golden/check-anchors/non-existing-anchors/a.md diff --git a/package.yaml b/package.yaml index 26278a17..625c5d66 100644 --- a/package.yaml +++ b/package.yaml @@ -39,6 +39,7 @@ default-extensions: - NamedFieldPuns - NoImplicitPrelude - OverloadedStrings + - QuasiQuotes - RankNTypes - RecordWildCards - ScopedTypeVariables @@ -111,6 +112,7 @@ library: - uri-bytestring - yaml - reflection + - nyan-interpolation executables: xrefcheck: diff --git a/src/Xrefcheck/CLI.hs b/src/Xrefcheck/CLI.hs index 24d15057..48cef339 100644 --- a/src/Xrefcheck/CLI.hs +++ b/src/Xrefcheck/CLI.hs @@ -32,6 +32,7 @@ import Options.Applicative progDesc, short, strOption, switch, value) import Options.Applicative.Help.Pretty (Doc, displayS, fill, fillSep, indent, renderPretty, text) import Options.Applicative.Help.Pretty qualified as Pretty +import Text.Interpolation.Nyan import Paths_xrefcheck (version) import Xrefcheck.Config (NetworkingConfig, NetworkingConfig' (..)) @@ -44,10 +45,12 @@ modeReadM :: ReadM VerifyMode modeReadM = eitherReader $ \s -> case find (\mi -> miName mi == s) modes of Just mi -> Right $ miMode mi - Nothing -> Left . mconcat $ intersperse "\n" - [ "Unknown mode " <> show s <> "." - , "Allowed values: " <> mconcat (intersperse ", " $ map (show . miName) modes) - ] + Nothing -> Left + [int|| + Unknown mode #s{s}. + Allowed values: #{intercalate ", " $ map (show . miName) modes}. + |] + data ModeInfo = ModeInfo { miName :: String @@ -126,8 +129,10 @@ repoTypeReadM = eitherReader $ \name -> 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) + [int|| + Unknown repository type: #s{name} + Expected one of: #{intercalate ", " $ map show allRepoTypes}. + |] allRepoTypes = allFlavors optionsParser :: Parser Options @@ -136,11 +141,13 @@ optionsParser = do short 'c' <> long "config" <> metavar "FILEPATH" <> - help ("Path to configuration file. \ - \If not specified, tries to read config from one of " <> - (mconcat . intersperse ", " $ map show defaultConfigPaths) <> ". \ - \If none of these files exist, default configuration is used." - ) + help + [int|| + Path to configuration file. \ + If not specified, tries to read config from one of \ + #{intercalate ", " $ map show defaultConfigPaths}. \ + If none of these files exist, default configuration is used. + |] oRoot <- filepathOption $ short 'r' <> long "root" <> @@ -208,14 +215,16 @@ dumpConfigOptions = hsubparser $ where parser = DumpConfig <$> repoTypeOption <*> outputOption - allRepoTypes = "(" <> intercalate " | " (map (show @String) allFlavors) <> ")" - repoTypeOption = option repoTypeReadM $ short 't' <> long "type" <> metavar "REPOSITORY TYPE" <> - help ("Git repository type. Can be " <> allRepoTypes <> ". Case insensitive.") + help [int|| + Git repository type. \ + Can be (#{intercalate " | " $ map show allFlavors}). \ + Case insensitive. + |] outputOption = filepathOption $ diff --git a/src/Xrefcheck/Command.hs b/src/Xrefcheck/Command.hs index 41ac1e99..992821e6 100644 --- a/src/Xrefcheck/Command.hs +++ b/src/Xrefcheck/Command.hs @@ -14,6 +14,7 @@ import Data.Yaml (decodeFileEither, prettyPrintParseException) import Fmt (blockListF', build, fmt, fmtLn, indentF) import System.Console.Pretty (supportsPretty) import System.Directory (doesFileExist) +import Text.Interpolation.Nyan import Xrefcheck.CLI (Options (..), addExclusionOptions, addNetworkingOptions, defaultConfigPaths) import Xrefcheck.Config @@ -57,8 +58,10 @@ defaultAction Options{..} = do Just configPath -> readConfig configPath Nothing -> do hPutStrLn @Text stderr - "Configuration file not found, using default config \ - \for GitHub repositories\n" + [int|| + Configuration file not found, using default config \ + for GitHub repositories + |] pure $ defConfig GitHub withinCI <- askWithinCI @@ -69,7 +72,11 @@ defaultAction Options{..} = do scanRepo rw (formats $ cScanners config) fullConfig oRoot when oVerbose $ - fmtLn $ "=== Repository data ===\n\n" <> indentF 2 (build repoInfo) + fmt [int|| + === Repository data === + + #{indentF 2 (build repoInfo)} + |] unless (null scanErrs) . reportScanErrs $ sortBy (compare `on` seFile) scanErrs @@ -86,12 +93,18 @@ defaultAction Options{..} = do reportVerifyErrs verifyErrs exitFailure where - reportScanErrs errs = do - void . fmt $ "=== Scan errors found ===\n\n" <> - indentF 2 (blockListF' "➥ " build errs) - fmtLn $ "Scan errors dumped, " <> build (length errs) <> " in total." - - reportVerifyErrs errs = do - void . fmt $ "=== Invalid references found ===\n\n" <> - indentF 2 (blockListF' "➥ " build errs) - fmtLn $ "Invalid references dumped, " <> build (length errs) <> " in total." + reportScanErrs errs = fmt + [int|| + === Scan errors found === + + #{indentF 2 (blockListF' "➥ " build errs)}\ + Scan errors dumped, #{length errs} in total. + |] + + reportVerifyErrs errs = fmt + [int|| + === Invalid references found === + + #{indentF 2 (blockListF' "➥ " build errs)}\ + Invalid references dumped, #{length errs} in total. + |] diff --git a/src/Xrefcheck/Config.hs b/src/Xrefcheck/Config.hs index 335938f6..f1c099c5 100644 --- a/src/Xrefcheck/Config.hs +++ b/src/Xrefcheck/Config.hs @@ -20,6 +20,7 @@ import Data.Yaml (FromJSON (..), decodeEither', prettyPrintParseException, withT import Instances.TH.Lift () import Text.Regex.TDFA qualified as R import Text.Regex.TDFA.ByteString () +import Text.Interpolation.Nyan import Time (KnownRatName, Second, Time (..), unitsP) @@ -133,15 +134,19 @@ fillHoles allReplacements rawConfig = case getReplacement key of Left replacement -> [leadingSpaces, replacement] Right _ -> error $ - "Key " <> showBs key <> " requires replacement with an item, \ - \but list was given" + [int|| + 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" + [int|| + Key #{showBs key} requires replacement with a list, \ + but an item was given" + |] Right [] -> ["[]"] Right replacements@(_ : _) -> diff --git a/src/Xrefcheck/Config/Default.hs b/src/Xrefcheck/Config/Default.hs index 45c06e97..180091e7 100644 --- a/src/Xrefcheck/Config/Default.hs +++ b/src/Xrefcheck/Config/Default.hs @@ -3,8 +3,6 @@ - SPDX-License-Identifier: MPL-2.0 -} -{-# LANGUAGE QuasiQuotes #-} - module Xrefcheck.Config.Default where import Universum diff --git a/src/Xrefcheck/Core.hs b/src/Xrefcheck/Core.hs index 3c618285..59304491 100644 --- a/src/Xrefcheck/Core.hs +++ b/src/Xrefcheck/Core.hs @@ -15,17 +15,18 @@ import Control.Lens (makeLenses) import Data.Aeson (FromJSON (..), withText) import Data.Char (isAlphaNum) import Data.Char qualified as C +import Data.DList (DList) +import Data.DList qualified as DList import Data.Default (Default (..)) import Data.List qualified as L import Data.Map qualified as M import Data.Reflection (Given) import Data.Text qualified as T -import Fmt (Buildable (..), blockListF, blockListF', nameF, (+|), (|+)) +import Fmt (Buildable (..), blockListF, blockListF', indentF) import System.FilePath (isPathSeparator, pathSeparator) +import Text.Interpolation.Nyan import Time (Second, Time) -import Data.DList (DList) -import Data.DList qualified as DList import Xrefcheck.Progress import Xrefcheck.Util @@ -142,14 +143,12 @@ instance NFData FileInfo instance Given ColorMode => Buildable Reference where build Reference{..} = - nameF ("reference " +| paren (build loc) |+ " " +| rPos |+ "") $ - blockListF - [ "text: " <> show rName - , "link: " <> build rLink - , "anchor: " <> build (rAnchor ?: styleIfNeeded Faint "-") - ] - where - loc = locationType rLink + [int|| + reference #{paren . build $ locationType rLink} #{rPos}: + - text: #s{rName} + - link: #{rLink} + - anchor: #{rAnchor ?: styleIfNeeded Faint "-"} + |] instance Given ColorMode => Buildable AnchorType where build = styleIfNeeded Faint . \case @@ -167,23 +166,29 @@ instance Given ColorMode => Buildable AnchorType where n -> error "Bad header level: " <> show n instance Given ColorMode => Buildable Anchor where - build (Anchor t a p) = a |+ " (" +| t |+ ") " +| p |+ "" + build Anchor{..} = + [int|| + #{aName} (#{aType}) #{aPos} + |] instance Given ColorMode => Buildable FileInfo where - build FileInfo{..} = blockListF - [ nameF "references" $ blockListF _fiReferences - , nameF "anchors" $ blockListF _fiAnchors - ] + build FileInfo{..} = + [int|| + - references: + #{indentF 4 $ blockListF _fiReferences}\ + - anchors: + #{indentF 4 $ blockListF _fiAnchors}\ + |] instance Given ColorMode => Buildable RepoInfo where build (RepoInfo m _) = blockListF' "⮚" buildFileReport (mapMaybe sequence $ M.toList m) where - buildFileReport (name, info) = mconcat - [ colorIfNeeded Cyan $ fromString name <> ":\n" - , build info - , "\n" - ] + buildFileReport (name, info) = + [int|| + #{colorIfNeeded Cyan $ name}: + #{info} + |] ----------------------------------------------------------- -- Analysing diff --git a/src/Xrefcheck/Orphans.hs b/src/Xrefcheck/Orphans.hs index b9ccfcf2..d0cb3dde 100644 --- a/src/Xrefcheck/Orphans.hs +++ b/src/Xrefcheck/Orphans.hs @@ -13,9 +13,10 @@ import Universum import Data.ByteString.Char8 qualified as C -import Fmt (Buildable (..), unlinesF, (+|), (|+)) +import Fmt (Buildable (..)) import Network.FTP.Client (FTPException (..), FTPMessage (..), FTPResponse (..), ResponseStatus (..)) +import Text.Interpolation.Nyan import Text.URI (RText, unRText) import URI.ByteString (SchemaError (..), URIParseError (..)) @@ -33,10 +34,11 @@ instance Buildable FTPMessage where ) instance Buildable FTPResponse where - build FTPResponse{..} = unlinesF - [ frStatus |+ " (" +| frCode |+ "):" - , build frMessage - ] + build FTPResponse{..} = + [int|| + #{frStatus} (#{frCode}): + #{frMessage} + |] instance Buildable FTPException where build (BadProtocolResponseException _) = "Raw FTP exception" diff --git a/src/Xrefcheck/Scan.hs b/src/Xrefcheck/Scan.hs index f223a05f..d95958ef 100644 --- a/src/Xrefcheck/Scan.hs +++ b/src/Xrefcheck/Scan.hs @@ -34,11 +34,12 @@ import Data.Aeson (FromJSON (..), genericParseJSON, withText) import Data.List qualified as L import Data.Map qualified as M import Data.Reflection (Given) -import Fmt (Buildable (..), nameF, (+|), (|+)) +import Fmt (Buildable (..)) import System.Directory (doesDirectoryExist) import System.FilePath (dropTrailingPathSeparator, equalFilePath, splitDirectories, takeDirectory, takeExtension, ()) import System.Process (cwd, readCreateProcess, shell) +import Text.Interpolation.Nyan import Text.Regex.TDFA.Common (CompOption (..), ExecOption (..), Regex) import Text.Regex.TDFA.Text qualified as R @@ -93,10 +94,14 @@ data ScanError = ScanError } deriving stock (Show, Eq) instance Given ColorMode => Buildable ScanError where - build ScanError{..} = - "In file " +| styleIfNeeded Faint (styleIfNeeded Bold seFile) |+ "\n" - +| nameF ("scan error " +| sePosition |+ "") mempty |+ "\n⛀ " - +| seDescription |+ "\n\n\n" + build ScanError{..} = [int|| + In file #{styleIfNeeded Faint (styleIfNeeded Bold seFile)} + scan error #{sePosition}: + + ⛀ #{seDescription} + + + |] data ScanErrorDescription = LinkErr @@ -107,13 +112,13 @@ data ScanErrorDescription instance Buildable ScanErrorDescription where build = \case - LinkErr -> "Expected a LINK after \"ignore link\" annotation" - FileErr -> "Annotation \"ignore all\" must be at the top of \ - \markdown or right after comments at the top" - ParagraphErr txt -> "Expected a PARAGRAPH after \ - \\"ignore paragraph\" annotation, but found " +| txt |+ "" - UnrecognisedErr txt -> "Unrecognised option \"" +| txt |+ "\" perhaps you meant \ - \<\"ignore link\"|\"ignore paragraph\"|\"ignore all\"> " + LinkErr -> [int||Expected a LINK after "ignore link" annotation|] + FileErr -> [int||Annotation "ignore all" must be at the top of \ + markdown or right after comments at the top|] + ParagraphErr txt -> [int||Expected a PARAGRAPH after \ + "ignore paragraph" annotation, but found #{txt}|] + UnrecognisedErr txt -> [int||Unrecognised option "#{txt}" perhaps you meant \ + <"ignore link"|"ignore paragraph"|"ignore all">|] specificFormatsSupport :: [([Extension], ScanAction)] -> FormatsSupport specificFormatsSupport formats = \ext -> M.lookup ext formatsMap diff --git a/src/Xrefcheck/Scanners/Markdown.hs b/src/Xrefcheck/Scanners/Markdown.hs index 5bd0f83c..33b0fdd3 100644 --- a/src/Xrefcheck/Scanners/Markdown.hs +++ b/src/Xrefcheck/Scanners/Markdown.hs @@ -29,7 +29,8 @@ import Data.DList qualified as DList import Data.Default (def) import Data.Text qualified as T import Data.Text.Lazy qualified as LT -import Fmt (Buildable (..), blockListF, nameF, (+|), (|+)) +import Fmt (Buildable (..), blockListF, nameF) +import Text.Interpolation.Nyan import Text.HTML.TagSoup import Xrefcheck.Core @@ -56,11 +57,13 @@ toPosition = Position . \case Nothing -> Nothing Just PosInfo{..} | startLine == endLine -> Just $ - startLine |+ ":" +| startColumn |+ "-" +| endColumn |+ "" + [int|s| + #{startLine}:#{startColumn}-#{endColumn} + |] | otherwise -> Just $ - "" +| - startLine |+ ":" +| startColumn |+ " - " +| - endLine |+ ":" +| endColumn |+ "" + [int|s| + #{startLine}:#{startColumn}-#{endLine}:#{endColumn} + |] -- | Extract text from the topmost node. nodeExtractText :: Node -> Text diff --git a/src/Xrefcheck/System.hs b/src/Xrefcheck/System.hs index 29dbc235..d3fbad71 100644 --- a/src/Xrefcheck/System.hs +++ b/src/Xrefcheck/System.hs @@ -24,6 +24,8 @@ import System.Environment (lookupEnv) import System.FilePath (isRelative, ()) import System.FilePath.Glob (CompOptions (errorRecovery)) import System.FilePath.Glob qualified as Glob +import Text.Interpolation.Nyan + import Xrefcheck.Util (normaliseWithNoTrailing) -- | We can quite safely treat surrounding filesystem as frozen, @@ -51,13 +53,14 @@ mkGlobPattern path = do case Glob.tryCompileWith globCompileOptions spath of Right _ -> return (RelGlobPattern spath) Left err -> Left - $ "Glob pattern compilation failed.\n" - <> "Error message is:\n" - <> err - <> "\nThe syntax for glob patterns is described here:\n" - <> "https://hackage.haskell.org/package/Glob/docs/System-FilePath-Glob.html#v:compile" - <> "\nSpecial characters in file names can be escaped using square brackets" - <> ", e.g. -> [<]a[>]." + [int|| + Glob pattern compilation failed. + Error message is: + #{err} + The syntax for glob patterns is described here: + https://hackage.haskell.org/package/Glob/docs/System-FilePath-Glob.html#v:compile + Special characters in file names can be escaped using square brackets, e.g. -> [<]a[>]. + |] normaliseGlobPattern :: RelGlobPattern -> RelGlobPattern normaliseGlobPattern = RelGlobPattern . normaliseWithNoTrailing . coerce diff --git a/src/Xrefcheck/Verify.hs b/src/Xrefcheck/Verify.hs index a322b62b..cf70618d 100644 --- a/src/Xrefcheck/Verify.hs +++ b/src/Xrefcheck/Verify.hs @@ -45,7 +45,7 @@ import Data.Text.Metrics (damerauLevenshteinNorm) import Data.Time (UTCTime, defaultTimeLocale, formatTime, readPTime, rfc822DateFormat) import Data.Time.Clock.POSIX (getPOSIXTime) import Data.Traversable (for) -import Fmt (Buildable (..), blockListF', indentF, listF, maybeF, nameF, unlinesF, (+|), (|+)) +import Fmt (Buildable (..), indentF, listF, maybeF, nameF, blockListF) import GHC.Exts qualified as Exts import GHC.Read (Read (readPrec)) import Network.FTP.Client @@ -59,6 +59,7 @@ import Network.HTTP.Types.Header (hRetryAfter) import Network.HTTP.Types.Status (Status, statusCode, statusMessage) import System.FilePath (equalFilePath, joinPath, makeRelative, normalise, splitDirectories, takeDirectory, ()) +import Text.Interpolation.Nyan import Text.ParserCombinators.ReadPrec qualified as ReadPrec (lift) import Text.Regex.TDFA.Text (Regex, regexec) import Text.URI (Authority (..), ParseExceptionBs, URI (..), mkURIBs) @@ -113,10 +114,12 @@ data WithReferenceLoc a = WithReferenceLoc } instance (Given ColorMode, Buildable a) => Buildable (WithReferenceLoc a) where - build WithReferenceLoc{..} = - "In file " +| styleIfNeeded Faint (styleIfNeeded Bold wrlFile) |+ "\nbad " - +| wrlReference |+ "\n" - +| wrlItem |+ "\n\n" + build WithReferenceLoc{..} = [int|| + In file #{styleIfNeeded Faint (styleIfNeeded Bold wrlFile)} + bad #{wrlReference} + #{wrlItem} + + |] data VerifyError = LocalFileDoesNotExist FilePath @@ -138,65 +141,96 @@ data VerifyError instance Given ColorMode => Buildable VerifyError where build = \case LocalFileDoesNotExist file -> - "⛀ File does not exist:\n " +| file |+ "\n" + [int|| + ⛀ File does not exist: + #{file} + |] LocalFileOutsideRepo file -> - "⛀ Link targets a local file outside repository:\n " +| file |+ "\n" - - AnchorDoesNotExist anchor similar -> - "⛀ Anchor '" +| anchor |+ "' is not present" +| - anchorHints similar + [int|| + ⛀ Link targets a local file outside repository: + #{file} + |] + + AnchorDoesNotExist anchor similar + | null similar -> + [int|| + ⛀ Anchor '#{anchor}' is not present + |] + | otherwise -> + [int|| + ⛀ Anchor '#{anchor}' is not present, did you mean: + #{indentF 4 $ blockListF similar} + |] AmbiguousAnchorRef file anchor fileAnchors -> - "⛀ Ambiguous reference to anchor '" +| anchor |+ "'\n " +| - "In file " +| file |+ "\n " +| - "Similar anchors are:\n" +| - blockListF' " -" build fileAnchors |+ "" +| - " Use of such anchors is discouraged because referenced object\n\ - \ can change silently whereas the document containing it evolves.\n" + [int|| + ⛀ Ambiguous reference to anchor '#{anchor}' + In file #{file} + It could refer to either: + #{indentF 4 $ blockListF fileAnchors} + Use of ambiguous anchors is discouraged because the target + can change silently while the document containing it evolves. + |] ExternalResourceInvalidUri err -> - "⛂ Invalid URI (" +| err |+ ")\n" + [int|| + ⛂ Invalid URI (#{err}) + |] ExternalResourceUriConversionError err -> - unlinesF - [ "⛂ Invalid URI" - , indentF 4 . build $ displayException err - ] + [int|| + ⛂ Invalid URI + #{indentF 4 . build $ displayException err} + |] ExternalResourceInvalidUrl Nothing -> - "⛂ Invalid URL\n" + [int|| + ⛂ Invalid URL + |] ExternalResourceInvalidUrl (Just message) -> - "⛂ Invalid URL (" +| message |+ ")\n" + [int|| + ⛂ Invalid URL (#{message}) + |] ExternalResourceUnknownProtocol -> - "⛂ Bad url (expected 'http','https', 'ftp' or 'ftps')\n" + [int|| + ⛂ Bad url (expected 'http','https', 'ftp' or 'ftps') + |] ExternalHttpResourceUnavailable status -> - "⛂ Resource unavailable (" +| statusCode status |+ " " +| - decodeUtf8 @Text (statusMessage status) |+ ")\n" + [int|| + ⛂ Resource unavailable (#{statusCode status} #{decodeUtf8 @Text (statusMessage status)}) + |] ExternalHttpTooManyRequests retryAfter -> - "⛂ Resource unavailable (429 Too Many Requests; retry after " +| - maybeF retryAfter |+ ")\n" + [int|| + ⛂ Resource unavailable (429 Too Many Requests; retry after #{maybeF retryAfter}) + |] ExternalFtpResourceUnavailable response -> - "⛂ Resource unavailable:\n" +| response |+ "\n" + [int|| + ⛂ Resource unavailable: + #{response} + |] ExternalFtpException err -> - "⛂ FTP exception (" +| err |+ ")\n" + [int|| + ⛂ FTP exception (#{err}) + |] FtpEntryDoesNotExist entry -> - "⛂ File or directory does not exist:\n" +| entry |+ "\n" + [int|| + ⛂ File or directory does not exist: + #{entry} + |] ExternalResourceSomeError err -> - "⛂ " +| build err |+ "\n\n" - where - anchorHints = \case - [] -> "\n" - [h] -> ",\n did you mean " +| h |+ "?\n" - hs -> ", did you mean:\n" +| blockListF' " -" build hs + [int|| + ⛂ #{err} + + |] data RetryAfter = Date UTCTime | Seconds (Time Second) deriving stock (Show, Eq) diff --git a/stack.yaml b/stack.yaml index 6c07845e..96ad5d37 100644 --- a/stack.yaml +++ b/stack.yaml @@ -12,3 +12,8 @@ packages: extra-deps: - firefly-0.2.1.0@sha256:e9d73486464c3e223ec457e02b30ddd5b550fdbf6292b268c64581e2b07d888b,1519 - cmark-gfm-0.2.5 +- git: https://github.com/serokell/nyan-interpolation + commit: 5e158057b167275d2150454e2bb731cfe686ea7a + subdirs: + - full + - core diff --git a/stack.yaml.lock b/stack.yaml.lock index 20523980..529c4204 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -18,6 +18,32 @@ packages: size: 4556 original: hackage: cmark-gfm-0.2.5 +- completed: + commit: 5e158057b167275d2150454e2bb731cfe686ea7a + git: https://github.com/serokell/nyan-interpolation + name: nyan-interpolation + pantry-tree: + sha256: ede424e6010640f31a223865f2136570ca1870b5ae5ffeeebfc499c4f7043482 + size: 714 + subdir: full + version: '0.9' + original: + commit: 5e158057b167275d2150454e2bb731cfe686ea7a + git: https://github.com/serokell/nyan-interpolation + subdir: full +- completed: + commit: 5e158057b167275d2150454e2bb731cfe686ea7a + git: https://github.com/serokell/nyan-interpolation + name: nyan-interpolation-core + pantry-tree: + sha256: 59d1c732629b06d0035229dccce484d6b4c3078d6bb3e493317afddc9be233df + size: 1516 + subdir: core + version: '0.9' + original: + commit: 5e158057b167275d2150454e2bb731cfe686ea7a + git: https://github.com/serokell/nyan-interpolation + subdir: core snapshots: - completed: sha256: ef98d70e4018bf01feb00ccdcd33ab26d056dbb71b38057c78fdd0d1ec671c85 diff --git a/tests/Test/Xrefcheck/URIParsingSpec.hs b/tests/Test/Xrefcheck/URIParsingSpec.hs index 29fdac7a..c7ac2a7b 100644 --- a/tests/Test/Xrefcheck/URIParsingSpec.hs +++ b/tests/Test/Xrefcheck/URIParsingSpec.hs @@ -3,8 +3,6 @@ - SPDX-License-Identifier: MPL-2.0 -} -{-# LANGUAGE QuasiQuotes #-} - module Test.Xrefcheck.URIParsingSpec where import Universum diff --git a/tests/golden/check-anchors/ambiguous-anchors/a.md b/tests/golden/check-anchors/ambiguous-anchors/a.md new file mode 100644 index 00000000..4498bdeb --- /dev/null +++ b/tests/golden/check-anchors/ambiguous-anchors/a.md @@ -0,0 +1,16 @@ + +# Some text + +# Some **text** + +# some-text-longer + +## some-text + +# Other text + +[ambiguous anchor in this file](#some-text) diff --git a/tests/golden/check-anchors/ambiguous-anchors/b.md b/tests/golden/check-anchors/ambiguous-anchors/b.md new file mode 100644 index 00000000..140453da --- /dev/null +++ b/tests/golden/check-anchors/ambiguous-anchors/b.md @@ -0,0 +1,7 @@ + +[valid](a.md#other-text) +[ambiguous anchor in other file](a.md#some-text) diff --git a/tests/golden/check-anchors/check-anchors.bats b/tests/golden/check-anchors/check-anchors.bats new file mode 100644 index 00000000..a7fc1987 --- /dev/null +++ b/tests/golden/check-anchors/check-anchors.bats @@ -0,0 +1,98 @@ +#!/usr/bin/env bats + +# SPDX-FileCopyrightText: 2022 Serokell +# +# SPDX-License-Identifier: MPL-2.0 + +load '../helpers/bats-support/load' +load '../helpers/bats-assert/load' +load '../helpers/bats-file/load' +load '../helpers' + +@test "We report ambiguous anchor references" { + to_temp xrefcheck -r ambiguous-anchors +assert_diff - < + - + - SPDX-License-Identifier: MPL-2.0 + --> +# h1 + +## h2 + +# The heading + +[broken](#h3) + +[broken](#heading) + +[broken](#really-unique-anchor) diff --git a/tests/golden/check-autolinks/check-autolinks.bats b/tests/golden/check-autolinks/check-autolinks.bats index 98d9a022..585f39f4 100644 --- a/tests/golden/check-autolinks/check-autolinks.bats +++ b/tests/golden/check-autolinks/check-autolinks.bats @@ -24,7 +24,8 @@ assert_diff - <