{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ViewPatterns      #-}

{-|
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
  ( -- * Type Aliases
    CreateDirectoryFn
  , DoesFileExistFn
  , FindFilesFn
  , FindFilesByExtsFn
  , FindFilesByTypesFn
  , GetCurrentDirectoryFn
  , ListFilesFn
  , LoadFileFn
    -- * Polymorphic Record
  , FileSystem(..)
  , mkFileSystem
    -- * Traversing the File System
  , findFiles
  , findFilesByExts
  , findFilesByTypes
  , listFiles
  , loadFile
    -- * 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


--------------------------------  TYPE ALIASES  --------------------------------

-- | Type of a function that creates new empty directory on the given path.
type CreateDirectoryFn m
  =  FilePath
  -- ^ path of new directory
  -> m ()
  -- ^ /IO/ action result


-- | Type of a function that returns 'True' if the argument file exists and is
-- not a directory, and 'False' otherwise.
type DoesFileExistFn m
  =  FilePath
  -- ^ path to check
  -> m Bool
  -- ^ whether the given path is existing file


-- | Type of a function that recursively finds files on given path whose
-- filename matches the predicate.
type FindFilesFn m
  =  FilePath
  -- ^ path to search
  -> (FilePath -> Bool)
  -- ^ predicate to match filename
  -> m [FilePath]
  -- ^ found files


-- | Type of a function that recursively finds files on given path by file
-- extensions.
type FindFilesByExtsFn m
  =  FilePath
  -- ^ path to search
  -> [Text]
  -- ^ list of file extensions (without dot)
  -> m [FilePath]
  -- ^ list of found files


-- | Type of a function that recursively find files on given path by their
-- file types.
type FindFilesByTypesFn m
  =  CtHeadersConfig
  -- ^ configuration of license headers
  -> [FileType]
  -- ^ list of file types
  -> FilePath
  -- ^ path to search
  -> m [FilePath]
  -- ^ list of found files


-- | Type of a function that obtains the current working directory as an
-- absolute path.
type GetCurrentDirectoryFn m = m FilePath


-- | Type of a function that recursively find all files on given path. If file
-- reference is passed instead of directory, such file path is returned.
type ListFilesFn m
  =  FilePath
  -- ^ path to search
  -> m [FilePath]
  -- ^ list of found files

-- | Type of a function that loads file content in UTF8 encoding.
type LoadFileFn m
  =  FilePath
  -- ^ file path
  -> m Text
  -- ^ file content

-----------------------------  POLYMORPHIC RECORD  -----------------------------

-- | /Polymorphic record/ composed of file system /IO/ function types, allowing
-- to abstract over concrete implementation. Whenever you need to use effectful
-- functions from this module, consider using this record instead of using them
-- directly, as it allows you to use different records for production code and
-- for testing, which is not as easy if you wire some of the provided functions
-- directly.
data FileSystem m = FileSystem
  { FileSystem m -> CreateDirectoryFn m
fsCreateDirectory     :: CreateDirectoryFn m
  -- ^ Function that creates new empty directory on the given path.
  , FileSystem m -> DoesFileExistFn m
fsDoesFileExist       :: DoesFileExistFn m
  -- ^ Function that returns 'True' if the argument file exists and is not
  -- a directory, and 'False' otherwise.
  , FileSystem m -> FindFilesFn m
fsFindFiles           :: FindFilesFn m
  -- ^ Function that recursively finds files on given path whose filename
  -- matches the predicate.
  , FileSystem m -> FindFilesByExtsFn m
fsFindFilesByExts     :: FindFilesByExtsFn m
  -- ^ Function that recursively finds files on given path by file extensions.
  , FileSystem m -> FindFilesByTypesFn m
fsFindFilesByTypes    :: FindFilesByTypesFn m
  -- ^ Function that recursively find files on given path by their file types.
  , FileSystem m -> GetCurrentDirectoryFn m
fsGetCurrentDirectory :: GetCurrentDirectoryFn m
  -- ^ Function that obtains the current working directory as an absolute path.
  , FileSystem m -> ListFilesFn m
fsListFiles           :: ListFilesFn m
  -- ^ Function that recursively find all files on given path. If file reference
  -- is passed instead of directory, such file path is returned.
  , FileSystem m -> LoadFileFn m
fsLoadFile            :: LoadFileFn m
  -- ^ Function that loads file content in UTF8 encoding.
  }


-- | Creates new 'FileSystem' that performs actual disk /IO/ operations.
mkFileSystem :: MonadIO m => FileSystem m
mkFileSystem :: FileSystem m
mkFileSystem = FileSystem :: forall (m :: * -> *).
CreateDirectoryFn m
-> DoesFileExistFn m
-> FindFilesFn m
-> FindFilesByExtsFn m
-> FindFilesByTypesFn m
-> GetCurrentDirectoryFn m
-> ListFilesFn m
-> LoadFileFn m
-> FileSystem m
FileSystem { fsCreateDirectory :: CreateDirectoryFn m
fsCreateDirectory     = CreateDirectoryFn m
forall (m :: * -> *). MonadIO m => FilePath -> m ()
createDirectory
                          , fsDoesFileExist :: DoesFileExistFn m
fsDoesFileExist       = DoesFileExistFn m
forall (m :: * -> *). MonadIO m => FilePath -> m Bool
doesFileExist
                          , fsFindFiles :: FindFilesFn m
fsFindFiles           = FindFilesFn m
forall (m :: * -> *). MonadIO m => FindFilesFn m
findFiles
                          , fsFindFilesByExts :: FindFilesByExtsFn m
fsFindFilesByExts     = FindFilesByExtsFn m
forall (m :: * -> *). MonadIO m => FindFilesByExtsFn m
findFilesByExts
                          , fsFindFilesByTypes :: FindFilesByTypesFn m
fsFindFilesByTypes    = FindFilesByTypesFn m
forall (m :: * -> *). MonadIO m => FindFilesByTypesFn m
findFilesByTypes
                          , fsGetCurrentDirectory :: GetCurrentDirectoryFn m
fsGetCurrentDirectory = GetCurrentDirectoryFn m
forall (m :: * -> *). MonadIO m => m FilePath
getCurrentDirectory
                          , fsListFiles :: ListFilesFn m
fsListFiles           = ListFilesFn m
forall (m :: * -> *). MonadIO m => ListFilesFn m
listFiles
                          , fsLoadFile :: LoadFileFn m
fsLoadFile            = LoadFileFn m
forall (m :: * -> *). MonadIO m => LoadFileFn m
loadFile
                          }


------------------------------  PUBLIC FUNCTIONS  ------------------------------

-- | Recursively finds files on given path whose filename matches the predicate.
findFiles :: MonadIO m => FindFilesFn m
findFiles :: FindFilesFn m
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) (ListFilesFn m
forall (m :: * -> *). MonadIO m => ListFilesFn m
listFiles FilePath
path)


-- | Recursively finds files on given path by file extensions.
findFilesByExts :: MonadIO m => FindFilesByExtsFn m
findFilesByExts :: FindFilesByExtsFn m
findFilesByExts FilePath
path [Text]
exts = FindFilesFn m
forall (m :: * -> *). MonadIO m => FindFilesFn m
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 => FindFilesByTypesFn m
findFilesByTypes :: FindFilesByTypesFn m
findFilesByTypes CtHeadersConfig
headersConfig [FileType]
types FilePath
path =
  FindFilesByExtsFn m
forall (m :: * -> *). MonadIO m => FindFilesByExtsFn m
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 => ListFilesFn m
listFiles :: ListFilesFn m
listFiles FilePath
fileOrDir = do
  Bool
isDir <- FilePath -> m Bool
forall (m :: * -> *). MonadIO m => FilePath -> m Bool
doesDirectoryExist FilePath
fileOrDir
  if Bool
isDir then ListFilesFn m
forall (m :: * -> *). MonadIO m => ListFilesFn m
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 => ListFilesFn m
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 => ListFilesFn m
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
              -- ^ path from which to extract file extension
              -> Maybe Text
              -- ^ extracted file extension
fileExtension :: FilePath -> Maybe Text
fileExtension (FilePath -> FilePath
takeExtension -> 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
fileExtension FilePath
_                           = Maybe Text
forall a. Maybe a
Nothing


-- | Loads file content in UTF8 encoding.
loadFile :: MonadIO m => LoadFileFn m
loadFile :: LoadFileFn m
loadFile = LoadFileFn m
forall (m :: * -> *). MonadIO m => LoadFileFn m
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