1--
2-- Copyright (c) 2012 Mark Dittmer - http://www.markdittmer.org
3-- Developed for a Google Summer of Code project - http://gsoc2012.markdittmer.org
4--
5{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-}
6
7module System.FSNotify.Path
8       ( findFiles
9       , findDirs
10       , findFilesAndDirs
11       , canonicalizeDirPath
12       , canonicalizePath
13       , hasThisExtension
14       ) where
15
16import Control.Monad
17import qualified Data.Text as T
18import Prelude hiding (FilePath)
19import qualified System.Directory as D
20import System.FilePath
21import System.PosixCompat.Files as PF
22
23getDirectoryContentsPath :: FilePath -> IO [FilePath]
24getDirectoryContentsPath path =
25  ((map (path </>)) . filter (not . dots) <$> D.getDirectoryContents path) >>= filterM exists
26  where
27    exists x = (||) <$> D.doesFileExist x <*> D.doesDirectoryExist x
28    dots "."  = True
29    dots ".." = True
30    dots _    = False
31
32fileDirContents :: FilePath -> IO ([FilePath], [FilePath])
33fileDirContents path = do
34  contents <- getDirectoryContentsPath path
35  stats <- mapM getFileStatus contents
36  let pairs = zip stats contents
37  let files = [ f | (s, f) <- pairs, PF.isRegularFile s]
38  let dirs = [ d | (s, d) <- pairs, PF.isDirectory s]
39  return (files, dirs)
40
41findAllFiles :: FilePath -> IO [FilePath]
42findAllFiles path = do
43  (files, dirs) <- fileDirContents path
44  nestedFiles <- mapM findAllFiles dirs
45  return (files ++ concat nestedFiles)
46
47findImmediateFiles, findImmediateDirs :: FilePath -> IO [FilePath]
48findImmediateFiles = fileDirContents >=> mapM D.canonicalizePath . fst
49findImmediateDirs  = fileDirContents >=> mapM D.canonicalizePath . snd
50
51findAllDirs :: FilePath -> IO [FilePath]
52findAllDirs path = do
53  dirs <- findImmediateDirs path
54  nestedDirs <- mapM findAllDirs dirs
55  return (dirs ++ concat nestedDirs)
56
57-- * Exported functions below this point
58
59findFiles :: Bool -> FilePath -> IO [FilePath]
60findFiles True path  = findAllFiles       =<< canonicalizeDirPath path
61findFiles False path = findImmediateFiles =<<  canonicalizeDirPath path
62
63findDirs :: Bool -> FilePath -> IO [FilePath]
64findDirs True path  = findAllDirs       =<< canonicalizeDirPath path
65findDirs False path = findImmediateDirs =<< canonicalizeDirPath path
66
67findFilesAndDirs :: Bool -> FilePath -> IO [FilePath]
68findFilesAndDirs False path = getDirectoryContentsPath =<< canonicalizeDirPath path
69findFilesAndDirs True path = do
70  (files, dirs) <- fileDirContents path
71  nestedFilesAndDirs <- concat <$> (mapM (findFilesAndDirs False) dirs)
72  return (files ++ dirs ++ nestedFilesAndDirs)
73
74-- | add a trailing slash to ensure the path indicates a directory
75addTrailingSlash :: FilePath -> FilePath
76addTrailingSlash = addTrailingPathSeparator
77
78canonicalizeDirPath :: FilePath -> IO FilePath
79canonicalizeDirPath path = addTrailingSlash `fmap` D.canonicalizePath path
80
81-- | bugfix older version of canonicalizePath (system-fileio <= 0.3.7) loses trailing slash
82canonicalizePath :: FilePath -> IO FilePath
83canonicalizePath path = let was_dir = null (takeFileName path) in
84  if not was_dir then D.canonicalizePath path
85  else canonicalizeDirPath path
86
87hasThisExtension :: FilePath -> T.Text -> Bool
88hasThisExtension p ext = takeExtension p == T.unpack ext
89