Merge pull request #82 from serokell/breakerzirconia/#75-roots-with-appended-slashes

[#75] Fix the root with an appended slash support

.github/pull_request_template.md

@@ -45,4 +45,4 @@ checkmark indicating that you are sure it is dealt with (be that by irrelevance)
 #### Stylistic guide (mandatory)
 
 - [ ] My commits comply with [the policy used in Serokell](https://www.notion.so/serokell/Where-and-how-to-commit-your-work-58f8973a4b3142c8abbd2e6fd5b3a08e).
-- [ ] My code complies with the [style guide](docs/code-style.md).
+- [ ] My code complies with the [style guide](/docs/code-style.md).

CHANGES.md

@@ -15,6 +15,8 @@ Unreleased
   + Added support for ftp links.
 * [#74](https://github.com/serokell/xrefcheck/pull/83)
   + Add the duplication detection & verification result caching algorithm for external references.
+* [#82](https://github.com/serokell/xrefcheck/pull/82)
+  + Fix the issue of having the lowest level context duplicated, caused by the root's trailing path separator.
 
 0.2.1
 ==========

src/Xrefcheck/Scan.hs

@@ -21,7 +21,7 @@ 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 System.FilePath (dropTrailingPathSeparator, takeDirectory, takeExtension, (</>))
 
 import Xrefcheck.Core
 import Xrefcheck.Progress
@@ -53,6 +53,21 @@ specificFormatsSupport formats = \ext -> M.lookup ext formatsMap
         , extension <- extensions
         ]
 
+-- | Returns the context location of the given path.
+-- This is done by removing the last component from the path.
+--
+-- > locationOf "./folder/file.md"  == "./folder"
+-- > locationOf "./folder/subfolder"  == "./folder"
+-- > locationOf "./folder/subfolder/"  == "./folder"
+-- > locationOf "./folder/subfolder/./"  == "./folder/subfolder"
+-- > locationOf "."  == ""
+-- > locationOf "/absolute/path"  == "/absolute"
+-- > locationOf "/"  == "/"
+locationOf :: FilePath -> FilePath
+locationOf fp
+  | fp == "" || fp == "." = ""
+  | otherwise = takeDirectory $ dropTrailingPathSeparator fp
+
 gatherRepoInfo
   :: MonadIO m
   => Rewrite -> FormatsSupport -> TraversalConfig -> FilePath -> m RepoInfo
@@ -61,12 +76,11 @@ gatherRepoInfo rw formatsSupport config root = do
   _ Tree.:/ repoTree <- liftIO $ Tree.readDirectoryWithL processFile rootNE
   let fileInfos = filter (\(path, _) -> not $ isIgnored path)
         $ dropSndMaybes . F.toList
-        $ Tree.zipPaths . (dirOfRoot Tree.:/)
+        $ Tree.zipPaths . (locationOf root Tree.:/)
         $ filterExcludedDirs root repoTree
   return $ RepoInfo (M.fromList fileInfos)
   where
     rootNE = if null root then "." else root
-    dirOfRoot = if root == "" || root == "." then "" else takeDirectory root
     processFile file = do
       let ext = takeExtension file
       let mscanner = formatsSupport ext

tests/Test/Xrefcheck/TrailingSlashSpec.hs

@@ -0,0 +1,48 @@
+{- SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>
+ -
+ - SPDX-License-Identifier: MPL-2.0
+ -}
+
+module Test.Xrefcheck.TrailingSlashSpec where
+
+import Fmt (blockListF, pretty, unlinesF)
+import System.Directory (doesFileExist)
+import Test.Hspec (Spec, describe, expectationFailure, it)
+
+import Xrefcheck.Config
+import Xrefcheck.Core
+import Xrefcheck.Progress
+import Xrefcheck.Scan
+import Xrefcheck.Scanners.Markdown
+
+spec :: Spec
+spec = do
+  describe "Trailing forward slash detection" $ do
+    let config = defConfig GitHub
+    let format = specificFormatsSupport [markdownSupport (scMarkdown (cScanners config))]
+    forM_ roots $ \root -> do
+      it ("All the files within the root \"" <>
+          root <>
+          "\" should exist") $ do
+        RepoInfo repoInfo <- allowRewrite False $ \rw ->
+          gatherRepoInfo rw format TraversalConfig{ tcIgnored = [] } root
+        nonExistentFiles <- lefts <$> forM (keys repoInfo) (\filePath -> do
+          predicate <- doesFileExist filePath
+          return $ if predicate
+                   then Right ()
+                   else Left filePath)
+        if null nonExistentFiles
+        then pass
+        else expectationFailure $ pretty $ unlinesF
+          [ "Expected all filepaths to be valid, but these filepaths do not exist:"
+          , blockListF nonExistentFiles
+          ]
+  where
+    roots :: [FilePath]
+    roots =
+      [ "tests/markdowns/without-annotations"
+      , "tests/markdowns/without-annotations/"
+      , "tests/markdowns/without-annotations/./"
+      , "tests/markdowns/without-annotations/all_checked.md"
+      , "tests/markdowns/without-annotations/./all_checked.md"
+      ]