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

-- | Generalised repo scanner and analyser.

module Xrefcheck.Scan
    ( Extension
    , ScanAction
    , FormatsSupport
    , RepoInfo (..)

    , gatherRepoInfo
    , specificFormatsSupport
    ) where

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 Xrefcheck.Config
import Xrefcheck.Core
import Xrefcheck.Progress
import Xrefcheck.Util ()

-- | File extension, dot included.
type Extension = String

-- | Way to parse a file.
type ScanAction = FilePath -> IO FileInfo

-- | All supported ways to parse a file.
type FormatsSupport = Extension -> Maybe ScanAction

specificFormatsSupport :: [([Extension], ScanAction)] -> FormatsSupport
specificFormatsSupport :: [([Extension], ScanAction)] -> FormatsSupport
specificFormatsSupport [([Extension], ScanAction)]
formats = \Extension
ext -> Extension -> Map Extension ScanAction -> Maybe ScanAction
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Extension
ext Map Extension ScanAction
formatsMap
  where
    formatsMap :: Map Extension ScanAction
formatsMap = [(Extension, ScanAction)] -> Map Extension ScanAction
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
        [ (Extension
extension, ScanAction
parser)
        | ([Extension]
extensions, ScanAction
parser) <- [([Extension], ScanAction)]
formats
        , Extension
extension <- [Extension]
extensions
        ]

gatherRepoInfo
    :: MonadIO m
    => Rewrite -> FormatsSupport -> TraversalConfig -> FilePath -> m RepoInfo
gatherRepoInfo :: Rewrite
-> FormatsSupport -> TraversalConfig -> Extension -> m RepoInfo
gatherRepoInfo Rewrite
rw FormatsSupport
formatsSupport TraversalConfig
config Extension
root = do
    Rewrite -> Text -> m ()
forall (m :: * -> *). MonadIO m => Rewrite -> Text -> m ()
putTextRewrite Rewrite
rw Text
"Scanning repository..."
    Extension
_ Tree.:/ DirTree (Maybe FileInfo)
repoTree <- IO (AnchoredDirTree (Maybe FileInfo))
-> m (AnchoredDirTree (Maybe FileInfo))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (AnchoredDirTree (Maybe FileInfo))
 -> m (AnchoredDirTree (Maybe FileInfo)))
-> IO (AnchoredDirTree (Maybe FileInfo))
-> m (AnchoredDirTree (Maybe FileInfo))
forall a b. (a -> b) -> a -> b
$ (Extension -> IO (Maybe FileInfo))
-> Extension -> IO (AnchoredDirTree (Maybe FileInfo))
forall a.
(Extension -> IO a) -> Extension -> IO (AnchoredDirTree a)
Tree.readDirectoryWithL Extension -> IO (Maybe FileInfo)
processFile Extension
rootNE
    let fileInfos :: [(Extension, FileInfo)]
fileInfos = ((Extension, FileInfo) -> Bool)
-> [(Extension, FileInfo)] -> [(Extension, FileInfo)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Extension
path, FileInfo
_) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Extension -> Bool
isIgnored Extension
path) ([(Extension, FileInfo)] -> [(Extension, FileInfo)])
-> [(Extension, FileInfo)] -> [(Extension, FileInfo)]
forall a b. (a -> b) -> a -> b
$
                    [(Extension, Maybe FileInfo)] -> [(Extension, FileInfo)]
forall a b. [(a, Maybe b)] -> [(a, b)]
dropSndMaybes ([(Extension, Maybe FileInfo)] -> [(Extension, FileInfo)])
-> (DirTree (Extension, Maybe FileInfo)
    -> [(Extension, Maybe FileInfo)])
-> DirTree (Extension, Maybe FileInfo)
-> [(Extension, FileInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirTree (Extension, Maybe FileInfo)
-> [(Extension, Maybe FileInfo)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (DirTree (Extension, Maybe FileInfo) -> [(Extension, FileInfo)])
-> DirTree (Extension, Maybe FileInfo) -> [(Extension, FileInfo)]
forall a b. (a -> b) -> a -> b
$
                    AnchoredDirTree (Maybe FileInfo)
-> DirTree (Extension, Maybe FileInfo)
forall a. AnchoredDirTree a -> DirTree (Extension, a)
Tree.zipPaths (AnchoredDirTree (Maybe FileInfo)
 -> DirTree (Extension, Maybe FileInfo))
-> (DirTree (Maybe FileInfo) -> AnchoredDirTree (Maybe FileInfo))
-> DirTree (Maybe FileInfo)
-> DirTree (Extension, Maybe FileInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Extension
dirOfRoot Extension
-> DirTree (Maybe FileInfo) -> AnchoredDirTree (Maybe FileInfo)
forall a. Extension -> DirTree a -> AnchoredDirTree a
Tree.:/) (DirTree (Maybe FileInfo) -> DirTree (Extension, Maybe FileInfo))
-> DirTree (Maybe FileInfo) -> DirTree (Extension, Maybe FileInfo)
forall a b. (a -> b) -> a -> b
$
                    Extension -> DirTree (Maybe FileInfo) -> DirTree (Maybe FileInfo)
filterExcludedDirs Extension
root DirTree (Maybe FileInfo)
repoTree
    RepoInfo -> m RepoInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (RepoInfo -> m RepoInfo) -> RepoInfo -> m RepoInfo
forall a b. (a -> b) -> a -> b
$ Map Extension FileInfo -> RepoInfo
RepoInfo ([(Extension, FileInfo)] -> Map Extension FileInfo
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Extension, FileInfo)]
fileInfos)
  where
    rootNE :: Extension
rootNE = if Extension -> Bool
forall t. Container t => t -> Bool
null Extension
root then Extension
"." else Extension
root
    dirOfRoot :: Extension
dirOfRoot = if Extension
root Extension -> Extension -> Bool
forall a. Eq a => a -> a -> Bool
== Extension
"" Bool -> Bool -> Bool
|| Extension
root Extension -> Extension -> Bool
forall a. Eq a => a -> a -> Bool
== Extension
"." then Extension
"" else Extension -> Extension
takeDirectory Extension
root
    processFile :: Extension -> IO (Maybe FileInfo)
processFile Extension
file = do
        let ext :: Extension
ext = Extension -> Extension
takeExtension Extension
file
        let mscanner :: Maybe ScanAction
mscanner = FormatsSupport
formatsSupport Extension
ext
        Maybe ScanAction
-> (ScanAction -> IO FileInfo) -> IO (Maybe FileInfo)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe ScanAction
mscanner ((ScanAction -> IO FileInfo) -> IO (Maybe FileInfo))
-> (ScanAction -> IO FileInfo) -> IO (Maybe FileInfo)
forall a b. (a -> b) -> a -> b
$ \ScanAction
scanFile ->
            ScanAction
scanFile Extension
file
    dropSndMaybes :: [(a, Maybe b)] -> [(a, b)]
dropSndMaybes [(a, Maybe b)]
l = [(a
a, b
b) | (a
a, Just b
b) <- [(a, Maybe b)]
l]

    ignored :: [Extension]
ignored = (Extension -> Extension) -> [Extension] -> [Extension]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Extension
root Extension -> Extension -> Extension
</>) (TraversalConfig -> [Extension]
tcIgnored TraversalConfig
config)
    isIgnored :: Extension -> Bool
isIgnored Extension
path = Extension
Element [Extension]
path Element [Extension] -> [Extension] -> Bool
forall t. (Container t, Eq (Element t)) => Element t -> t -> Bool
`elem` [Extension]
ignored
    filterExcludedDirs :: Extension -> DirTree (Maybe FileInfo) -> DirTree (Maybe FileInfo)
filterExcludedDirs Extension
cur = \case
        Tree.Dir Extension
name [DirTree (Maybe FileInfo)]
subfiles ->
            let subfiles' :: [DirTree (Maybe FileInfo)]
subfiles' =
                  if Extension -> Bool
isIgnored Extension
cur
                  then []
                  else (DirTree (Maybe FileInfo) -> DirTree (Maybe FileInfo))
-> [DirTree (Maybe FileInfo)] -> [DirTree (Maybe FileInfo)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map DirTree (Maybe FileInfo) -> DirTree (Maybe FileInfo)
visitRec [DirTree (Maybe FileInfo)]
subfiles
                visitRec :: DirTree (Maybe FileInfo) -> DirTree (Maybe FileInfo)
visitRec DirTree (Maybe FileInfo)
sub = Extension -> DirTree (Maybe FileInfo) -> DirTree (Maybe FileInfo)
filterExcludedDirs (Extension
cur Extension -> Extension -> Extension
</> DirTree (Maybe FileInfo) -> Extension
forall a. DirTree a -> Extension
Tree.name DirTree (Maybe FileInfo)
sub) DirTree (Maybe FileInfo)
sub
            in Extension -> [DirTree (Maybe FileInfo)] -> DirTree (Maybe FileInfo)
forall a. Extension -> [DirTree a] -> DirTree a
Tree.Dir Extension
name [DirTree (Maybe FileInfo)]
subfiles'
        file :: DirTree (Maybe FileInfo)
file@Tree.File{} -> DirTree (Maybe FileInfo)
file
        Tree.Failed Extension
_name IOException
err ->
            Extension -> DirTree (Maybe FileInfo)
forall a. Extension -> a
errorWithoutStackTrace (Extension -> DirTree (Maybe FileInfo))
-> Extension -> DirTree (Maybe FileInfo)
forall a b. (a -> b) -> a -> b
$ Extension
"Repository traversal failed: " Extension -> Extension -> Extension
forall a. Semigroup a => a -> a -> a
<> IOException -> Extension
forall b a. (Show a, IsString b) => a -> b
show IOException
err