{-# LANGUAGE NoImplicitPrelude #-}

{-|
Module      : Headroom.FileSystem
Description : Operations related to files and file system
Copyright   : (c) 2019-2020 Vaclav Svejcar
License     : BSD-3-Clause
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

Module providing functions for working with the local file system, its file and
directories.
-}

module Headroom.FileSystem
  ( -- * Traversing the File System
    findFiles
  , findFilesByExts
  , findFilesByTypes
  , listFiles
  , loadFile
    -- * Working with Files/Directories
  , doesFileExist
  , getCurrentDirectory
  , createDirectory
    -- * Working with Files Metadata
  , fileExtension
    -- * Other
  , excludePaths
  )
where

import           Headroom.Configuration.Types   ( CtHeadersConfig )
import           Headroom.Data.Regex            ( Regex
                                                , match
                                                )
import           Headroom.FileType              ( listExtensions )
import           Headroom.FileType.Types        ( FileType )
import           RIO
import           RIO.Directory                  ( createDirectory
                                                , doesDirectoryExist
                                                , doesFileExist
                                                , getCurrentDirectory
                                                , getDirectoryContents
                                                )
import           RIO.FilePath                   ( isExtensionOf
                                                , takeExtension
                                                , (</>)
                                                )
import qualified RIO.List                      as L
import qualified RIO.Text                      as T



-- | Recursively finds files on given path whose filename matches the predicate.
findFiles :: MonadIO m
          => FilePath
          -- ^ path to search
          -> (FilePath -> Bool)
          -- ^ predicate to match filename
          -> m [FilePath]
          -- ^ found files
findFiles :: FilePath -> (FilePath -> Bool) -> m [FilePath]
findFiles FilePath
path FilePath -> Bool
predicate = ([FilePath] -> [FilePath]) -> m [FilePath] -> m [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
predicate) (FilePath -> m [FilePath]
forall (m :: * -> *). MonadIO m => FilePath -> m [FilePath]
listFiles FilePath
path)


-- | Recursively finds files on given path by file extensions.
findFilesByExts :: MonadIO m
                => FilePath
                -- ^ path to search
                -> [Text]
                -- ^ list of file extensions (without dot)
                -> m [FilePath]
                -- ^ list of found files
findFilesByExts :: FilePath -> [Text] -> m [FilePath]
findFilesByExts FilePath
path [Text]
exts = FilePath -> (FilePath -> Bool) -> m [FilePath]
forall (m :: * -> *).
MonadIO m =>
FilePath -> (FilePath -> Bool) -> m [FilePath]
findFiles FilePath
path FilePath -> Bool
predicate
  where predicate :: FilePath -> Bool
predicate FilePath
p = (FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FilePath -> FilePath -> Bool
`isExtensionOf` FilePath
p) ((Text -> FilePath) -> [Text] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FilePath
T.unpack [Text]
exts)


-- | Recursively find files on given path by their file types.
findFilesByTypes :: MonadIO m
                 => CtHeadersConfig
                 -- ^ configuration of license headers
                 -> [FileType]
                 -- ^ list of file types
                 -> FilePath
                 -- ^ path to search
                 -> m [FilePath]
                 -- ^ list of found files
findFilesByTypes :: CtHeadersConfig -> [FileType] -> FilePath -> m [FilePath]
findFilesByTypes CtHeadersConfig
headersConfig [FileType]
types FilePath
path =
  FilePath -> [Text] -> m [FilePath]
forall (m :: * -> *).
MonadIO m =>
FilePath -> [Text] -> m [FilePath]
findFilesByExts FilePath
path ([FileType]
types [FileType] -> (FileType -> [Text]) -> [Text]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CtHeadersConfig -> FileType -> [Text]
listExtensions CtHeadersConfig
headersConfig)


-- | Recursively find all files on given path. If file reference is passed
-- instead of directory, such file path is returned.
listFiles :: MonadIO m
          => FilePath
          -- ^ path to search
          -> m [FilePath]
          -- ^ list of found files
listFiles :: FilePath -> m [FilePath]
listFiles FilePath
fileOrDir = do
  Bool
isDir <- FilePath -> m Bool
forall (m :: * -> *). MonadIO m => FilePath -> m Bool
doesDirectoryExist FilePath
fileOrDir
  if Bool
isDir then FilePath -> m [FilePath]
forall (m :: * -> *). MonadIO m => FilePath -> m [FilePath]
listDirectory FilePath
fileOrDir else [FilePath] -> m [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath
fileOrDir]
 where
  listDirectory :: FilePath -> m [FilePath]
listDirectory FilePath
dir = do
    [FilePath]
names <- FilePath -> m [FilePath]
forall (m :: * -> *). MonadIO m => FilePath -> m [FilePath]
getDirectoryContents FilePath
dir
    let filteredNames :: [FilePath]
filteredNames = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath
".", FilePath
".."]) [FilePath]
names
    [[FilePath]]
paths <- [FilePath] -> (FilePath -> m [FilePath]) -> m [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
filteredNames ((FilePath -> m [FilePath]) -> m [[FilePath]])
-> (FilePath -> m [FilePath]) -> m [[FilePath]]
forall a b. (a -> b) -> a -> b
$ \FilePath
name -> do
      let path :: FilePath
path = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
name
      Bool
isDirectory <- FilePath -> m Bool
forall (m :: * -> *). MonadIO m => FilePath -> m Bool
doesDirectoryExist FilePath
path
      if Bool
isDirectory then FilePath -> m [FilePath]
forall (m :: * -> *). MonadIO m => FilePath -> m [FilePath]
listFiles FilePath
path else [FilePath] -> m [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath
path]
    [FilePath] -> m [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> m [FilePath]) -> [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath]]
paths


-- | Returns file extension for given path (if file), or nothing otherwise.
--
-- >>> fileExtension "path/to/some/file.txt"
-- Just "txt"
fileExtension :: FilePath -> Maybe Text
fileExtension :: FilePath -> Maybe Text
fileExtension FilePath
path = case FilePath -> FilePath
takeExtension FilePath
path of
  Char
'.' : FilePath
xs -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
xs
  FilePath
_        -> Maybe Text
forall a. Maybe a
Nothing


-- | Loads file content in UTF8 encoding.
loadFile :: MonadIO m
         => FilePath
         -- ^ file path
         -> m Text
         -- ^ file content
loadFile :: FilePath -> m Text
loadFile = FilePath -> m Text
forall (m :: * -> *). MonadIO m => FilePath -> m Text
readFileUtf8


-- | Takes list of patterns and file paths and returns list of file paths where
-- those matching the given patterns are excluded.
--
-- >>> import Headroom.Data.Regex (re)
-- >>> :set -XQuasiQuotes
-- >>> excludePaths [[re|\.hidden|], [re|zzz|]] ["foo/.hidden", "test/bar", "x/zzz/e"]
-- ["test/bar"]
excludePaths :: [Regex]
             -- ^ patterns describing paths to exclude
             -> [FilePath]
             -- ^ list of file paths
             -> [FilePath]
             -- ^ resulting list of file paths
excludePaths :: [Regex] -> [FilePath] -> [FilePath]
excludePaths [Regex]
_        []    = []
excludePaths []       [FilePath]
paths = [FilePath]
paths
excludePaths [Regex]
patterns [FilePath]
paths = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
L.filter FilePath -> Bool
excluded [FilePath]
paths
  where excluded :: FilePath -> Bool
excluded FilePath
item = (Regex -> Bool) -> [Regex] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Regex
p -> Maybe [Text] -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe [Text] -> Bool) -> Maybe [Text] -> Bool
forall a b. (a -> b) -> a -> b
$ Regex -> Text -> Maybe [Text]
match Regex
p (FilePath -> Text
T.pack FilePath
item)) [Regex]
patterns