{- SPDX-FileCopyrightText: 2023 Serokell <https://serokell.io>
 -
 - SPDX-License-Identifier: MPL-2.0
 -}

-- | Scanner for gathering references to verify from symlinks.
--
-- A symlink's reference corresponds to the file it points to.
module Xrefcheck.Scanners.Symlink
  ( symlinkScanner
  , symlinkSupport
  ) where

import Universum

import Data.Reflection (Given)
import System.Directory (getSymbolicLinkTarget)

import Xrefcheck.Core
import Xrefcheck.Scan
import Xrefcheck.System

symlinkScanner :: Given PrintUnixPaths => ScanAction
symlinkScanner :: Given PrintUnixPaths => ScanAction
symlinkScanner FilePath
root RelPosixLink
relativePath = do
  let rootedPath :: FilePath
rootedPath = FilePath -> RelPosixLink -> FilePath
filePathFromRoot FilePath
root RelPosixLink
relativePath
      pathForPrinting :: FilePath
pathForPrinting = FilePath -> FilePath
Given PrintUnixPaths => FilePath -> FilePath
mkPathForPrinting FilePath
rootedPath
  Text
rLink <- RelPosixLink -> Text
unRelPosixLink (RelPosixLink -> Text)
-> (FilePath -> RelPosixLink) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> RelPosixLink
mkRelPosixLink
    (FilePath -> Text) -> IO FilePath -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
getSymbolicLinkTarget FilePath
rootedPath

  let rName :: Text
rName = Text
"Symbolic Link"
      rPos :: Position
rPos = Text -> Position
Position (FilePath -> Text
forall a. IsString a => FilePath -> a
fromString FilePath
pathForPrinting)
      rInfo :: ReferenceInfo
rInfo = Text -> ReferenceInfo
referenceInfo Text
rLink

  (FileInfo, [ScanError 'Parse]) -> IO (FileInfo, [ScanError 'Parse])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Reference] -> [Anchor] -> FileInfo
FileInfo [Reference {Text
rName :: Text
rName :: Text
rName, Position
rPos :: Position
rPos :: Position
rPos, ReferenceInfo
rInfo :: ReferenceInfo
rInfo :: ReferenceInfo
rInfo}] [], [])

symlinkSupport :: Given PrintUnixPaths => FileSupport
symlinkSupport :: Given PrintUnixPaths => FileSupport
symlinkSupport IsSymlink
isSymlink FilePath
_ = do
  IsSymlink -> Maybe ()
forall (f :: * -> *). Alternative f => IsSymlink -> f ()
guard IsSymlink
isSymlink
  ScanAction -> Maybe ScanAction
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScanAction
Given PrintUnixPaths => ScanAction
symlinkScanner