[#239][#249] Further filepath refactor

Problem: After refactoring the FilePath usages in the codebase to have a canonical representation of them, we noticed that further improvements could be applied, such as clarifying whether the path is system dependent and avoiding absolute file system paths. Solution: We now use POSIX relative paths during the analysis, and system dependent ones for reading file contents in the scan phase.
serokell · Jan 20, 2023 · 1dd9cb4 · 1dd9cb4
1 parent 999518b
commit 1dd9cb4
Show file tree

Hide file tree

Showing 26 changed files with 428 additions and 467 deletions.
diff --git a/src/Xrefcheck/CLI.hs b/src/Xrefcheck/CLI.hs
@@ -39,7 +39,7 @@ import Paths_xrefcheck (version)
 import Xrefcheck.Config (NetworkingConfig, NetworkingConfig' (..))
 import Xrefcheck.Core
 import Xrefcheck.Scan
-import Xrefcheck.System (RelGlobPattern, mkGlobPattern)
+import Xrefcheck.System (RelGlobPattern, mkRelGlobPattern)
 import Xrefcheck.Util (ColorMode (WithColors, WithoutColors))
 
 modeReadM :: ReadM VerifyMode
@@ -126,7 +126,7 @@ filepathOption :: Mod OptionFields FilePath -> Parser FilePath
 filepathOption = strOption
 
 globOption :: Mod OptionFields RelGlobPattern -> Parser RelGlobPattern
-globOption = option $ eitherReader mkGlobPattern
+globOption = option $ eitherReader mkRelGlobPattern
 
 repoTypeReadM :: ReadM RepoType
 repoTypeReadM = eitherReader $ \name ->

diff --git a/src/Xrefcheck/Core.hs b/src/Xrefcheck/Core.hs
@@ -17,7 +17,6 @@ import Data.Char (isAlphaNum)
 import Data.Char qualified as C
 import Data.DList (DList)
 import Data.DList qualified as DList
-import Data.List qualified as L
 import Data.Map qualified as M
 import Data.Reflection (Given)
 import Data.Text qualified as T
@@ -71,66 +70,58 @@ instance Given ColorMode => Buildable Position where
 
 -- | Full info about a reference.
 data Reference = Reference
-  { rName   :: Text
+  { rName :: Text
     -- ^ Text displayed as reference.
-  , rLink   :: Text
-    -- ^ File or site reference points to.
-  , rAnchor :: Maybe Text
-    -- ^ Section or custom anchor tag.
-  , rPos    :: Position
+  , rPos :: Position
     -- ^ Position in source file.
-  , rInfo   :: ReferenceInfo
-    -- ^ More info about the link.
+  , rInfo :: ReferenceInfo
+    -- ^ More info about the reference.
   } deriving stock (Show, Generic)
 
 -- | Info about the reference.
 data ReferenceInfo
-  = RIExternal
-    -- ^ Reference to a file at outer site, e.g @[d](http://www.google.com/doodles)@
-  | RIOtherProtocol
-    -- ^ Entry not to be processed, e.g. @mailto:e-mail@
-  | RIFileLocal
-    -- ^ Reference to this file, e.g. @[a](#header)@
-  | RIFileAbsolute
-    -- ^ Reference to a file absolute to the root, e.g. @[c](/folder/file#header)@
-  | RIFileRelative
-    -- ^ Reference to a file relative to given one, e.g. @[b](folder/file#header)@
+  = RIExternal ExternalLink
+  | RIFile ReferenceInfoFile
+  deriving stock (Show, Generic)
+
+data ReferenceInfoFile = ReferenceInfoFile
+  { rifAnchor :: Maybe Text
+    -- ^ Section or custom anchor tag.
+  , rifLink :: FileLink
+    -- ^ More info about the link.
+  } deriving stock (Show, Generic)
+
+data ExternalLink
+  = ELUrl Text
+    -- ^ Reference to a file at outer site, e.g @[d](http://www.google.com/doodles)@.
+  | ELOther Text
+    -- ^ Entry not to be processed, e.g. @mailto:e-mail@.
+  deriving stock (Show, Generic)
+
+data FileLink
+  = FLAbsolute Text
+    -- ^ Reference to a file relative to the repository root.
+  | FLRelative Text
+    -- ^ Reference to a file relative to given one.
+  | FLLocal
+    -- ^ Reference to this file.
   deriving stock (Show, Generic)
 
 pattern PathSep :: Char
 pattern PathSep <- (isPathSeparator -> True)
 
 -- | Compute the 'ReferenceInfo' corresponding to a given link.
-referenceInfo :: Text -> ReferenceInfo
-referenceInfo link = case toString link of
-  [] -> RIFileLocal
-  PathSep : _             -> RIFileAbsolute
-  '.' : PathSep : _       -> RIFileRelative
-  '.' : '.' : PathSep : _ -> RIFileRelative
-  _ | hasUrlProtocol -> RIExternal
-    | hasProtocol -> RIOtherProtocol
-    | otherwise -> RIFileRelative
+referenceInfo :: Text -> Maybe Text -> ReferenceInfo
+referenceInfo link anchor
+  | null link = RIFile $ ReferenceInfoFile anchor FLLocal
+  | hasUrlProtocol = RIExternal $ ELUrl $ maybe link ((link <> "#") <>) anchor
+  | hasProtocol = RIExternal $ ELOther $ maybe link ((link <> "#") <>) anchor
+  | otherwise = case T.uncons link of
+      Just (PathSep, path) -> RIFile $ ReferenceInfoFile anchor $ FLAbsolute path
+      _ -> RIFile $ ReferenceInfoFile anchor $ FLRelative link
   where
     hasUrlProtocol = "://" `T.isInfixOf` T.take 10 link
-    hasProtocol = ":"   `T.isInfixOf` T.take 10 link
-
--- | Whether this is a link to external resource.
-isExternal :: ReferenceInfo -> Bool
-isExternal = \case
-  RIFileLocal -> False
-  RIFileRelative -> False
-  RIFileAbsolute -> False
-  RIExternal -> True
-  RIOtherProtocol -> False
-
--- | Whether this is a link to repo-local resource.
-isLocal :: ReferenceInfo -> Bool
-isLocal = \case
-  RIFileLocal -> True
-  RIFileRelative -> True
-  RIFileAbsolute -> True
-  RIExternal -> False
-  RIOtherProtocol -> False
+    hasProtocol = ":" `T.isInfixOf` T.take 10 link
 
 -- | Context of anchor.
 data AnchorType
@@ -184,7 +175,7 @@ data ScanPolicy
 data FileStatus
   = Scanned FileInfo
   | NotScannable
-  -- ^ Files that are not supported by our scanners
+  -- ^ Files that are not supported by our scanners.
   | NotAddedToGit
   -- ^ We are not scanning files that are not added to git
   -- unless --include-untracked CLI option was enabled, but we're
@@ -198,51 +189,73 @@ data DirectoryStatus
 
 -- | All tracked files and directories.
 data RepoInfo = RepoInfo
-  { riFiles :: Map CanonicalPath FileStatus
+  { riFiles :: Map RelPosixLink FileStatus
     -- ^ Files from the repo with `FileInfo` attached to files that we've scanned.
-  , riDirectories :: Map CanonicalPath DirectoryStatus
+  , riDirectories :: Map RelPosixLink DirectoryStatus
     -- ^ Directories containing those files.
-  , riRoot :: CanonicalPath
-    -- ^ Repository root.
   }
 
 -- Search for a file in the repository.
-lookupFile :: CanonicalPath -> RepoInfo -> Maybe FileStatus
+lookupFile :: RelPosixLink -> RepoInfo -> Maybe FileStatus
 lookupFile path RepoInfo{..} =
   M.lookup path riFiles
 
 -- Search for a directory in the repository.
-lookupDirectory :: CanonicalPath -> RepoInfo -> Maybe DirectoryStatus
+lookupDirectory :: RelPosixLink -> RepoInfo -> Maybe DirectoryStatus
 lookupDirectory path RepoInfo{..} =
   M.lookup path riDirectories
 
 -----------------------------------------------------------
 -- Instances
 -----------------------------------------------------------
 
-instance NFData Position
-instance NFData Reference
 instance NFData ReferenceInfo
-instance NFData AnchorType
 instance NFData Anchor
+instance NFData AnchorType
+instance NFData ExternalLink
 instance NFData FileInfo
+instance NFData FileLink
+instance NFData Position
+instance NFData Reference
+instance NFData ReferenceInfoFile
 
 instance Given ColorMode => Buildable Reference where
   build Reference{..} =
-    [int||
-    reference #{paren . build $ rInfo} #{rPos}:
-      - text: #s{rName}
-      - link: #{if null rLink then "-" else rLink}
-      - anchor: #{rAnchor ?: styleIfNeeded Faint "-"}
-    |]
-
-instance Given ColorMode => Buildable ReferenceInfo where
-  build = \case
-    RIFileLocal -> colorIfNeeded Green "file-local"
-    RIFileRelative -> colorIfNeeded Yellow "relative"
-    RIFileAbsolute -> colorIfNeeded Blue "absolute"
-    RIExternal -> colorIfNeeded Red "external"
-    RIOtherProtocol -> ""
+    case rInfo of
+      RIFile ReferenceInfoFile{..} ->
+        case rifLink of
+          FLLocal ->
+            [int||
+            reference #{paren $ colorIfNeeded Green "file-local"} #{rPos}:
+              - text: #s{rName}
+              - anchor: #{rifAnchor ?: styleIfNeeded Faint "-"}
+            |]
+          FLRelative link ->
+            [int||
+            reference #{paren $ colorIfNeeded Yellow "relative"} #{rPos}:
+              - text: #s{rName}
+              - link: #{if null link then "-" else link}
+              - anchor: #{rifAnchor ?: styleIfNeeded Faint "-"}
+            |]
+          FLAbsolute link ->
+            [int||
+            reference #{paren $ colorIfNeeded Yellow "absolute"} #{rPos}:
+              - text: #s{rName}
+              - link: #{if null link then "-" else "/" <> link}
+              - anchor: #{rifAnchor ?: styleIfNeeded Faint "-"}
+            |]
+      RIExternal (ELUrl url) ->
+        [int||
+        reference #{paren $ colorIfNeeded Red "external"} #{rPos}:
+          - text: #s{rName}
+          - link: #{if null url then "-" else url}
+        |]
+      RIExternal (ELOther url) ->
+        [int||
+        reference (other) #{rPos}:
+          - text: #s{rName}
+          - link: #{if null url then "-" else url}
+        |]
 
 instance Given ColorMode => Buildable AnchorType where
   build = styleIfNeeded Faint . \case
@@ -279,10 +292,10 @@ instance Given ColorMode => Buildable RepoInfo where
     | Just scanned <- nonEmpty [(name, info) | (name, Scanned info) <- toPairs riFiles]
     = interpolateUnlinesF $ buildFileReport <$> scanned
     where
-      buildFileReport :: (CanonicalPath, FileInfo) -> Builder
+      buildFileReport :: (RelPosixLink, FileInfo) -> Builder
       buildFileReport (name, info) =
         [int||
-        #{ colorIfNeeded Cyan $ getPosixRelativeOrAbsoluteChild riRoot name }:
+        #{ colorIfNeeded Cyan name }:
         #{ interpolateIndentF 2 $ build info }
         |]
   build _ = "No scannable files found."
@@ -363,11 +376,15 @@ data VerifyProgress = VerifyProgress
 
 initVerifyProgress :: [Reference] -> VerifyProgress
 initVerifyProgress references = VerifyProgress
-  { vrLocal = initProgress (length localRefs)
-  , vrExternal = initProgress (length (ordNub $ map rLink extRefs))
+  { vrLocal = initProgress . length . filter isNothing $ extLinks
+  , vrExternal = initProgress . length . ordNub . catMaybes $ extLinks
   }
   where
-    (extRefs, localRefs) = L.partition (isExternal . rInfo) references
+    extLinks = flip fmap references $ \ref ->
+      case rInfo ref of
+        RIExternal (ELUrl url) ->
+          Just url
+        _ -> Nothing
 
 showAnalyseProgress :: Given ColorMode => VerifyMode -> Time Second -> VerifyProgress -> Text
 showAnalyseProgress mode posixTime VerifyProgress{..} =