[#197] Some path canonicalization tests

src/Xrefcheck/System.hs

@@ -92,7 +92,12 @@ getDirsBetweenRootAndFile root@(UnsafeCanonicalPath rootPath) file =
 
 getRelativeChild :: CanonicalPath -> CanonicalPath -> Maybe FilePath
 getRelativeChild (UnsafeCanonicalPath root) (UnsafeCanonicalPath child) =
-  dropWhile FP.isPathSeparator <$> stripPrefix root child
+  prepare <$> stripPrefix root child
+  where
+    prepare :: FilePath -> FilePath
+    prepare path = case dropWhile FP.isPathSeparator path of
+      "" -> "./"
+      other -> other
 
 getRelativeOrAbsoluteChild :: CanonicalPath -> CanonicalPath -> FilePath
 getRelativeOrAbsoluteChild root child@(UnsafeCanonicalPath c) =

tests/Test/Xrefcheck/CanonicalPathSpec.hs

@@ -0,0 +1,47 @@
+{- SPDX-FileCopyrightText: 2022 Serokell <https://serokell.io>
+ -
+ - SPDX-License-Identifier: MPL-2.0
+ -}
+
+module Test.Xrefcheck.CanonicalPathSpec where
+
+import Universum
+
+import System.Directory (getCurrentDirectory)
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (testCase, (@?=))
+
+import Xrefcheck.System
+
+test_canonicalPath :: TestTree
+test_canonicalPath = testGroup "Path canonicalization"
+  [ testCase "Trailing separator" $ do
+      path <- canonicalizePath "./example/dir/"
+      current <- getCurrentDirectory >>= canonicalizePath
+      getRelativeOrAbsoluteChild current path @?= "example/dir",
+    testCase "Parent directory indirection" $ do
+      path <- canonicalizePath "dir1/../dir2"
+      current <- getCurrentDirectory >>= canonicalizePath
+      getRelativeOrAbsoluteChild current path @?= "dir2",
+    testCase "Through parent directory indirection" $ do
+      path <- canonicalizePath "dir1/../../../dir2"
+      current <- getCurrentDirectory >>= canonicalizePath
+      root <- current </ "../.."
+      getRelativeOrAbsoluteChild root path @?= "dir2",
+    testCase "Current directory indirection" $ do
+      path <- canonicalizePath "././dir1/./././dir2/././"
+      current <- getCurrentDirectory >>= canonicalizePath
+      getRelativeOrAbsoluteChild current path @?= "dir1/dir2",
+    testCase "Mixed indirections result in current directory" $ do
+      path <- canonicalizePath "././dir1/./.././dir2/./../"
+      current <- getCurrentDirectory >>= canonicalizePath
+      getRelativeOrAbsoluteChild current path @?= "./",
+    testCase "Child directory" $ do
+      path <- canonicalizePath "./dir1/dir2/"
+      current <- getCurrentDirectory >>= canonicalizePath
+      getRelativeChild current path @?= Just "dir1/dir2",
+    testCase "Not a child directory" $ do
+      root <- canonicalizePath "./dir1/dir2/"
+      path <- canonicalizePath "./dir1/dir3/"
+      getRelativeChild root path @?= Nothing
+  ]

tests/Test/Xrefcheck/RedirectRequestsSpec.hs

@@ -1,4 +1,4 @@
-{- SPDX-FileCopyrightText: 2021 Serokell <https://serokell.io>
+{- SPDX-FileCopyrightText: 2022 Serokell <https://serokell.io>
  -
  - SPDX-License-Identifier: MPL-2.0
  -}