xrefcheck 0.1.0.0 → 0.1.1

raw patch · 11 files changed

+89/−46 lines, 11 filesdep +with-utf8new-uploader

Dependencies added: with-utf8

Files

• CHANGES.md +8/−0
• README.md +0/−13
• exec/Main.hs +7/−5
• src-files/def-config.yaml +2/−2
• src/Xrefcheck/CLI.hs +29/−5
• src/Xrefcheck/Config.hs +5/−5
• src/Xrefcheck/Core.hs +1/−1
• src/Xrefcheck/Scan.hs +2/−2
• src/Xrefcheck/System.hs +27/−9
• src/Xrefcheck/Verify.hs +3/−2
• xrefcheck.cabal +5/−2

@@ -7,6 +7,14 @@ Unreleased ========== +0.1.1+=======++* [#19](https://github.com/serokell/xrefcheck/pull/24)+  + Make `ignored` in config consider only exact matches.+  + Improve virtual files consideration.+  + Add `ignored` CLI option.+ 0.1.0.0 ======= 

@@ -60,19 +60,6 @@ It is based on the [`haskell.nix`](https://input-output-hk.github.io/haskell.nix/) project. You can do that too if you wish. -<details>-  <summary>Details</summary>--There is a [bug](https://github.com/input-output-hk/haskell.nix/issues/335) which causes us to put some redundancy into Nix files:-1. [`nix/sources.json`](nix/sources.json) lists all such dependencies that we obtain using `git`.-It specifies concrete git revisions and SHA256 checksums.-2. [`xrefcheck.nix`](xrefcheck.nix) lists all such dependencies as well, but without revisions.--As a consequence, you may have to update these files when you update [`stack.yaml`](stack.yaml).-You can use [`niv update`](https://github.com/nmattia/niv#update) to update [`nix/sources.json`](nix/sources.json).--</details>- ## Usage [↑](#xrefcheck)  To find all broken links in a repository, run from within its folder:

@@ -8,6 +8,7 @@ import qualified Data.ByteString as BS import Data.Yaml (decodeFileEither, prettyPrintParseException) import Fmt (blockListF', build, fmt, fmtLn, indentF)+import Main.Utf8 (withUtf8) import System.Directory (doesFileExist)  import Xrefcheck.CLI@@ -38,11 +39,12 @@       Just configPath -> do         readConfig configPath -    repoInfo <- allowRewrite oShowProgressBar $ \rw ->-        gatherRepoInfo rw formats (cTraversal config) root+    repoInfo <- allowRewrite oShowProgressBar $ \rw -> do+        let fullConfig = addTraversalOptions (cTraversal config) oTraversalOptions+        gatherRepoInfo rw formats fullConfig root      when oVerbose $-        fmtLn $ "Repository data:\n\n" <> indentF 2 (build repoInfo)+        fmtLn $ "=== Repository data ===\n\n" <> indentF 2 (build repoInfo)      verifyRes <- allowRewrite oShowProgressBar $ \rw ->         verifyRepo rw (cVerification config) oMode root repoInfo@@ -50,7 +52,7 @@         Nothing ->             fmtLn "All repository links are valid."         Just (toList -> errs) -> do-            fmt $ "Invalid references found:\n\n" <>+            fmt $ "=== Invalid references found ===\n\n" <>                   indentF 2 (blockListF' "➥ " build errs)             fmtLn $ "Invalid references dumped, " <> build (length errs) <> " in total."             exitFailure@@ -68,7 +70,7 @@       >>= either (error . toText . prettyPrintParseException) pure  main :: IO ()-main = do+main = withUtf8 $ do     command <- getCommand     case command of       DefaultCommand options ->

@@ -4,7 +4,7 @@  # Parameters of repository traversal. traversal:-  # Folders which we pretend do not exist+  # Files and folders which we pretend do not exist   # (so they are neither analyzed nor can be referenced).   ignored:     # Git files@@ -23,7 +23,7 @@   # declaring "Response timeout".   externalRefCheckTimeout: 10s -  # File prefixes, references in which should not be analyzed.+  # Prefixes of files, references in which should not be analyzed.   notScanned:     # GitHub-specific files     - .github/pull_request_template.md

@@ -11,6 +11,8 @@     , shouldCheckExternal     , Command (..)     , Options (..)+    , TraversalOptions (..)+    , addTraversalOptions     , defaultConfigPaths     , getCommand     ) where@@ -21,6 +23,7 @@                             short, strOption, switch, value) import Paths_xrefcheck (version) +import Xrefcheck.Config import Xrefcheck.Core  modeReadM :: ReadM VerifyMode@@ -43,13 +46,25 @@   | DumpConfig FilePath  data Options = Options-    { oConfigPath      :: Maybe FilePath-    , oRoot            :: FilePath-    , oMode            :: VerifyMode-    , oVerbose         :: Bool-    , oShowProgressBar :: Bool+    { oConfigPath       :: Maybe FilePath+    , oRoot             :: FilePath+    , oMode             :: VerifyMode+    , oVerbose          :: Bool+    , oShowProgressBar  :: Bool+    , oTraversalOptions :: TraversalOptions     } +data TraversalOptions = TraversalOptions+    { toIgnored :: [FilePath]+    }++addTraversalOptions :: TraversalConfig -> TraversalOptions -> TraversalConfig+addTraversalOptions TraversalConfig{..} (TraversalOptions ignored) =+  TraversalConfig+  { tcIgnored = tcIgnored ++ ignored+  , ..+  }+ -- | Where to try to seek configuration if specific path is not set. defaultConfigPaths :: [FilePath] defaultConfigPaths = ["./xrefcheck.yaml", "./.xrefcheck.yaml"]@@ -87,7 +102,16 @@     oShowProgressBar <- fmap not . switch $         long "no-progress" <>         help "Do not display progress bar during verification."+    oTraversalOptions <- traversalOptionsParser     return Options{..}++traversalOptionsParser :: Parser TraversalOptions+traversalOptionsParser = do+    toIgnored <- many . strOption $+        long "ignored" <>+        metavar "FILEPATH" <>+        help "Files and folders which we pretend do not exist."+    return TraversalOptions{..}  dumpConfigOptions :: Parser FilePath dumpConfigOptions = hsubparser $

@@ -12,11 +12,11 @@ import Data.Yaml (FromJSON (..), decodeEither', prettyPrintParseException, withText) import Instances.TH.Lift () import qualified Language.Haskell.TH.Syntax as TH-import System.FilePath.Posix ((</>))+import System.FilePath ((</>)) import TH.RelativePaths (qReadFileBS) import Time (KnownRatName, Second, Time, unitsP) -import Xrefcheck.System (CanonicalizedGlobPattern)+import Xrefcheck.System (RelGlobPattern)  -- | Overall config. data Config = Config@@ -27,17 +27,17 @@ -- | Config of repositry traversal. data TraversalConfig = TraversalConfig     { tcIgnored   :: [FilePath]-      -- ^ Folders, files in which we completely ignore.+      -- ^ Files and folders, files in which we completely ignore.     }  -- | Config of verification. data VerifyConfig = VerifyConfig     { vcAnchorSimilarityThreshold :: Double     , vcExternalRefCheckTimeout   :: Time Second-    , vcVirtualFiles              :: [CanonicalizedGlobPattern]+    , vcVirtualFiles              :: [RelGlobPattern]       -- ^ Files which we pretend do exist.     , vcNotScanned                :: [FilePath]-      -- ^ Folders, references in files of which we should not analyze.+      -- ^ Prefixes of files, references in which we should not analyze.     }  -----------------------------------------------------------

@@ -19,7 +19,7 @@ import qualified Data.Text as T import Fmt (Buildable (..), blockListF, blockListF', nameF, (+|), (|+)) import System.Console.Pretty (Color (..), Style (..), color, style)-import System.FilePath.Posix (isPathSeparator, pathSeparator)+import System.FilePath (isPathSeparator, pathSeparator) import Text.Numeral.Roman (toRoman)  import Xrefcheck.Progress

@@ -19,7 +19,7 @@ import qualified Data.Map as M import GHC.Err (errorWithoutStackTrace) import qualified System.Directory.Tree as Tree-import System.FilePath.Posix (takeDirectory, takeExtension, (</>))+import System.FilePath (takeDirectory, takeExtension, (</>))  import Xrefcheck.Config import Xrefcheck.Core@@ -66,7 +66,7 @@     dropSndMaybes l = [(a, b) | (a, Just b) <- l]      ignored = map (root </>) (tcIgnored config)-    isIgnored path = any (`isPrefixOf` path) ignored+    isIgnored path = path `elem` ignored     filterExcludedDirs cur = \case         Tree.Dir name subfiles ->             let subfiles' =

@@ -5,12 +5,14 @@  module Xrefcheck.System     ( readingSystem-    , CanonicalizedGlobPattern (..)+    , RelGlobPattern (..)+    , bindGlobPattern     ) where  import Data.Aeson (FromJSON (..), withText) import GHC.IO.Unsafe (unsafePerformIO) import System.Directory (canonicalizePath)+import System.FilePath ((</>)) import qualified System.FilePath.Glob as Glob  -- | We can quite safely treat surrounding filesystem as frozen,@@ -18,12 +20,28 @@ readingSystem :: IO a -> a readingSystem = unsafePerformIO --- | Glob pattern with 'canonicalizePath' applied O_o.-newtype CanonicalizedGlobPattern = CanonicalizedGlobPattern Glob.Pattern+-- | Glob pattern relative to repository root.+newtype RelGlobPattern = RelGlobPattern FilePath -instance FromJSON CanonicalizedGlobPattern where-    parseJSON = withText "Repo-rooted glob pattern" $ \path -> do-        let !cpath = readingSystem $ canonicalizePath (toString path)-        cpat <- Glob.tryCompileWith Glob.compDefault cpath-                & either fail pure-        return $ CanonicalizedGlobPattern cpat+bindGlobPattern :: FilePath -> RelGlobPattern -> Glob.Pattern+bindGlobPattern root (RelGlobPattern relPat) = readingSystem $ do+  -- TODO [#26] try to avoid using canonicalization+  absPat <- canonicalizePath (root </> relPat)+  case Glob.tryCompileWith globCompileOptions absPat of+    Left err ->+      error $ "Glob pattern compilation failed after canonicalization: " <>+              toText err+    Right pat ->+      return pat++instance FromJSON RelGlobPattern where+    parseJSON = withText "Repo-relative glob pattern" $ \path -> do+        let spath = toString path+        -- Checking path is sane+        _ <- Glob.tryCompileWith globCompileOptions spath+             & either fail pure+        return (RelGlobPattern spath)++-- | Glob compilation options we use.+globCompileOptions :: Glob.CompOptions+globCompileOptions = Glob.compDefault

@@ -35,8 +35,8 @@ import Network.HTTP.Types.Status (Status, statusCode, statusMessage) import System.Console.Pretty (Style (..), style) import System.Directory (canonicalizePath, doesDirectoryExist, doesFileExist)+import System.FilePath (takeDirectory, (</>)) import qualified System.FilePath.Glob as Glob-import System.FilePath.Posix (takeDirectory, (</>)) import Time (RatioNat, Second, Time (..), ms, threadDelay, timeout)  import Xrefcheck.Config@@ -207,7 +207,8 @@         let cfile = readingSystem $ canonicalizePath file         let isVirtual = or                 [ Glob.match pat cfile-                | CanonicalizedGlobPattern pat <- vcVirtualFiles ]+                | virtualFile <- vcVirtualFiles+                , let pat = bindGlobPattern root virtualFile ]          unless (fileExists || dirExists || isVirtual) $             throwError (FileDoesNotExist file)

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 7e709817763e8a6ce4c21d58175267e5326dd39a1902a4685e2379a2c1442a84+-- hash: 2aee7eb48869c4fb44e2f3cb3933ad8ed8d0e95278c77d8b2069067dba641091  name:           xrefcheck-version:        0.1.0.0+version:        0.1.1 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@@ -76,6 +76,7 @@     , text-metrics     , th-lift-instances     , th-utilities+    , with-utf8     , yaml   default-language: Haskell2010 @@ -119,6 +120,7 @@     , text-metrics     , th-lift-instances     , th-utilities+    , with-utf8     , xrefcheck     , yaml   default-language: Haskell2010@@ -171,6 +173,7 @@     , text-metrics     , th-lift-instances     , th-utilities+    , with-utf8     , xrefcheck     , yaml   default-language: Haskell2010