1{-# LANGUAGE CPP #-}
2{-# LANGUAGE OverloadedStrings #-}
3-- | File finding utiliites for Shelly
4-- The basic 'find' takes a dir and gives back a list of files.
5-- If you don't just want a list, use the folding variants like 'findFold'.
6-- If you want to avoid traversing certain directories, use the directory filtering variants like 'findDirFilter'
7module Shelly.Find
8 (
9   find, findWhen, findFold, findDirFilter, findDirFilterWhen, findFoldDirFilter
10 ) where
11
12import Prelude hiding (FilePath)
13import Shelly.Base
14import Control.Monad (foldM)
15#if !MIN_VERSION_base(4,13,0)
16import Data.Monoid (mappend)
17#endif
18import System.PosixCompat.Files( getSymbolicLinkStatus, isSymbolicLink )
19import Filesystem (isDirectory)
20import Filesystem.Path.CurrentOS (encodeString)
21
22-- | List directory recursively (like the POSIX utility "find").
23-- listing is relative if the path given is relative.
24-- If you want to filter out some results or fold over them you can do that with the returned files.
25-- A more efficient approach is to use one of the other find functions.
26find :: FilePath -> Sh [FilePath]
27find = findFold (\paths fp -> return $ paths ++ [fp]) []
28
29-- | 'find' that filters the found files as it finds.
30-- Files must satisfy the given filter to be returned in the result.
31findWhen :: (FilePath -> Sh Bool) -> FilePath -> Sh [FilePath]
32findWhen = findDirFilterWhen (const $ return True)
33
34-- | Fold an arbitrary folding function over files froma a 'find'.
35-- Like 'findWhen' but use a more general fold rather than a filter.
36findFold :: (a -> FilePath -> Sh a) -> a -> FilePath -> Sh a
37findFold folder startValue = findFoldDirFilter folder startValue (const $ return True)
38
39-- | 'find' that filters out directories as it finds
40-- Filtering out directories can make a find much more efficient by avoiding entire trees of files.
41findDirFilter :: (FilePath -> Sh Bool) -> FilePath -> Sh [FilePath]
42findDirFilter filt = findDirFilterWhen filt (const $ return True)
43
44-- | similar 'findWhen', but also filter out directories
45-- Alternatively, similar to 'findDirFilter', but also filter out files
46-- Filtering out directories makes the find much more efficient
47findDirFilterWhen :: (FilePath -> Sh Bool) -- ^ directory filter
48                  -> (FilePath -> Sh Bool) -- ^ file filter
49                  -> FilePath -- ^ directory
50                  -> Sh [FilePath]
51findDirFilterWhen dirFilt fileFilter = findFoldDirFilter filterIt [] dirFilt
52  where
53    filterIt paths fp = do
54      yes <- fileFilter fp
55      return $ if yes then paths ++ [fp] else paths
56
57-- | like 'findDirFilterWhen' but use a folding function rather than a filter
58-- The most general finder: you likely want a more specific one
59findFoldDirFilter :: (a -> FilePath -> Sh a) -> a -> (FilePath -> Sh Bool) -> FilePath -> Sh a
60findFoldDirFilter folder startValue dirFilter dir = do
61  absDir <- absPath dir
62  trace ("find " `mappend` toTextIgnore absDir)
63  filt <- dirFilter absDir
64  if not filt then return startValue
65    -- use possible relative path, not absolute so that listing will remain relative
66    else do
67      (rPaths, aPaths) <- lsRelAbs dir
68      foldM traverse' startValue (zip rPaths aPaths)
69  where
70    traverse' acc (relativePath, absolutePath) = do
71      -- optimization: don't use Shelly API since our path is already good
72      isDir <- liftIO $ isDirectory absolutePath
73      sym   <- liftIO $ fmap isSymbolicLink $ getSymbolicLinkStatus (encodeString absolutePath)
74      newAcc <- folder acc relativePath
75      follow <- fmap sFollowSymlink get
76      if isDir && (follow || not sym)
77        then findFoldDirFilter folder newAcc
78                dirFilter relativePath
79        else return newAcc
80