--

-- Copyright (c) 2012 Mark Dittmer - http://www.markdittmer.org

-- Developed for a Google Summer of Code project - http://gsoc2012.markdittmer.org

--

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE CPP #-}

module System.FSNotify.Path (
  findFiles
  , findFilesAndDirs
  , canonicalizeDirPath
  , canonicalizePath
  , hasThisExtension
  ) where

import Control.Monad
import qualified Data.Text as T
import Prelude hiding (FilePath)
import qualified System.Directory as D
import System.FilePath
import System.PosixCompat.Files as PF

getDirectoryContentsPath :: FilePath -> IO [FilePath]
getDirectoryContentsPath :: String -> IO [String]
getDirectoryContentsPath String
path =
  (((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
path String -> String -> String
</>)) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
dots) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
D.getDirectoryContents String
path) IO [String] -> ([String] -> IO [String]) -> IO [String]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
exists
  where
#if MIN_VERSION_directory(1, 2, 7)
    exists :: String -> IO Bool
exists String
x = String -> IO Bool
D.doesPathExist String
x
#else
    exists x = (||) <$> D.doesFileExist x <*> D.doesDirectoryExist x
#endif
    dots :: String -> Bool
dots String
"."  = Bool
True
    dots String
".." = Bool
True
    dots String
_    = Bool
False

fileDirContents :: FilePath -> IO ([FilePath], [FilePath])
fileDirContents :: String -> IO ([String], [String])
fileDirContents String
path = do
  [String]
contents <- String -> IO [String]
getDirectoryContentsPath String
path
  [FileStatus]
stats <- (String -> IO FileStatus) -> [String] -> IO [FileStatus]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> IO FileStatus
getFileStatus [String]
contents
  let pairs :: [(FileStatus, String)]
pairs = [FileStatus] -> [String] -> [(FileStatus, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FileStatus]
stats [String]
contents
  let files :: [String]
files = [ String
f | (FileStatus
s, String
f) <- [(FileStatus, String)]
pairs, FileStatus -> Bool
PF.isRegularFile FileStatus
s]
  let dirs :: [String]
dirs = [ String
d | (FileStatus
s, String
d) <- [(FileStatus, String)]
pairs, FileStatus -> Bool
PF.isDirectory FileStatus
s]
  ([String], [String]) -> IO ([String], [String])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
files, [String]
dirs)

findAllFiles :: FilePath -> IO [FilePath]
findAllFiles :: String -> IO [String]
findAllFiles String
path = do
  ([String]
files, [String]
dirs) <- String -> IO ([String], [String])
fileDirContents String
path
  [[String]]
nestedFiles <- (String -> IO [String]) -> [String] -> IO [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> IO [String]
findAllFiles [String]
dirs
  [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
files [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
nestedFiles)

findImmediateFiles :: FilePath -> IO [FilePath]
findImmediateFiles :: String -> IO [String]
findImmediateFiles = String -> IO ([String], [String])
fileDirContents (String -> IO ([String], [String]))
-> (([String], [String]) -> IO [String]) -> String -> IO [String]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (String -> IO String) -> [String] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> IO String
D.canonicalizePath ([String] -> IO [String])
-> (([String], [String]) -> [String])
-> ([String], [String])
-> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String], [String]) -> [String]
forall a b. (a, b) -> a
fst

-- * Exported functions below this point


findFiles :: Bool -> FilePath -> IO [FilePath]
findFiles :: Bool -> String -> IO [String]
findFiles Bool
True String
path  = String -> IO [String]
findAllFiles       (String -> IO [String]) -> IO String -> IO [String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO String
canonicalizeDirPath String
path
findFiles Bool
False String
path = String -> IO [String]
findImmediateFiles (String -> IO [String]) -> IO String -> IO [String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<  String -> IO String
canonicalizeDirPath String
path

findFilesAndDirs :: Bool -> FilePath -> IO [FilePath]
findFilesAndDirs :: Bool -> String -> IO [String]
findFilesAndDirs Bool
False String
path = String -> IO [String]
getDirectoryContentsPath (String -> IO [String]) -> IO String -> IO [String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO String
canonicalizeDirPath String
path
findFilesAndDirs Bool
True String
path = do
  ([String]
files, [String]
dirs) <- String -> IO ([String], [String])
fileDirContents String
path
  [String]
nestedFilesAndDirs <- [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> IO [[String]] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO [String]) -> [String] -> IO [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Bool -> String -> IO [String]
findFilesAndDirs Bool
False) [String]
dirs
  [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
files [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
dirs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
nestedFilesAndDirs)

-- | add a trailing slash to ensure the path indicates a directory

addTrailingSlash :: FilePath -> FilePath
addTrailingSlash :: String -> String
addTrailingSlash = String -> String
addTrailingPathSeparator

canonicalizeDirPath :: FilePath -> IO FilePath
canonicalizeDirPath :: String -> IO String
canonicalizeDirPath String
path = String -> String
addTrailingSlash (String -> String) -> IO String -> IO String
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO String
D.canonicalizePath String
path

-- | bugfix older version of canonicalizePath (system-fileio <= 0.3.7) loses trailing slash

canonicalizePath :: FilePath -> IO FilePath
canonicalizePath :: String -> IO String
canonicalizePath String
path = let was_dir :: Bool
was_dir = String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> String
takeFileName String
path) in
  if Bool -> Bool
not Bool
was_dir then String -> IO String
D.canonicalizePath String
path
  else String -> IO String
canonicalizeDirPath String
path

hasThisExtension :: FilePath -> T.Text -> Bool
hasThisExtension :: String -> Text -> Bool
hasThisExtension String
p Text
ext = String -> String
takeExtension String
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> String
T.unpack Text
ext