{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

module Data.Conduit.Find
    (
    -- * Introduction
    -- $intro

    -- ** Basic comparison with GNU find
    -- $gnufind

    -- ** Performance
    -- $performance

    -- ** Other notes
    -- $notes

    -- * Finding functions
      sourceFindFiles
    , find
    , findFiles
    , findFilePaths
    , FindOptions(..)
    , defaultFindOptions
    , test
    , ltest
    , stat
    , lstat
    , hasStatus

      -- * File path predicates
    , glob
    , regex
    , ignoreVcs

      -- * GNU find compatibility predicates
    , depth_
    , follow_
    , noleaf_
    , prune_
    , maxdepth_
    , mindepth_
    , ignoreErrors_
    , noIgnoreErrors_
    , amin_
    , atime_
    , anewer_
    , empty_
    , executable_
    , gid_
    , name_
    , getDepth
    , filename_
    , pathname_
    , getFilePath

    -- * File entry predicates (uses stat information)
    , regular
    , directory
    , hasMode
    , executable
    , lastAccessed_
    , lastModified_

    -- * Predicate combinators
    , module Cond
    , (=~)

    -- * Types and type classes
    , FileEntry(..)
    ) where

import           Control.Applicative (Alternative (..))
import           Control.Exception (IOException, catch, throwIO)
import           Control.Monad hiding (forM_, forM)
import           Control.Monad.Catch (MonadThrow)
import           Control.Monad.IO.Class (MonadIO, liftIO)
import           Control.Monad.IO.Unlift (MonadUnliftIO)
import           Control.Monad.Morph (hoist, lift)
import           Control.Monad.State.Class (get, gets, modify, put)
import           Control.Monad.Trans.Control (MonadBaseControl)
import           Control.Monad.Trans.Resource (MonadResource)

import           Data.Attoparsec.Text as A
import           Data.Bits ((.&.))
import           Data.Conduit (ConduitT, runConduitRes, (.|))
import qualified Data.Conduit as DC
import qualified Data.Conduit.List as DCL
import qualified Data.Cond as Cond
import           Data.Cond hiding (test)
import qualified Data.Conduit.Filesystem as CF
#if LEAFOPT
import           Data.IORef (IORef, newIORef, modifyIORef, readIORef)
#endif
import           Data.Maybe (fromMaybe, fromJust)
import           Data.Text (Text, unpack, pack)
import           Data.Time (UTCTime,  diffUTCTime)
import           Data.Time.Clock.POSIX (getCurrentTime, posixSecondsToUTCTime)
import qualified System.FilePath as FP
import           System.PosixCompat.Files (FileStatus, linkCount)
import qualified System.PosixCompat.Files as Files
import           System.PosixCompat.Types (EpochTime, FileMode)
import           Text.Regex.Posix ((=~))

{- $intro

**find-conduit** is essentially a souped version of GNU find for Haskell,
using a DSL to provide both ease of us, and extensive flexbility.

In its simplest form, let's compare some uses of find to find-conduit.  Bear
in mind that the result of the find function is a conduit, so you're expected
to either sink it to a list, or operate on the file paths as they are yielded.
-}

{- $gnufind

A typical find command:

@
find src -name '*.hs' -type f -print
@

Would in find-conduit be:

@
find "src" (glob \"*.hs\" \<\> regular) $$ mapM_C (liftIO . print)
@

The 'glob' predicate matches the file basename against the globbing pattern,
while the 'regular' predicate matches plain files.

A more complicated example:

@
find . -size +100M -perm 644 -mtime 1
@

Now in find-conduit:

@
let megs = 1024 * 1024
    days = 86400
now <- liftIO getCurrentTime
find \".\" ( fileSize (> 100*megs)
        \<\> hasMode 0o644
        \<\> lastModified (> addUTCTime now (-(1*days)))
         )
@

Appending predicates like this expressing an "and" relationship.  Use '<|>' to
express "or".  You can also negate any predicate:

@
find \".\" (not_ (hasMode 0o644))
@

By default, predicates, whether matching or not, will allow recursion into
directories.  In order to express that matching predicate should disallow
recursion, use 'prune':

@
find \".\" (prune (depth (> 2)))
@

This is the same as using '-maxdepth 2' in find.

@
find \".\" (prune (filename_ (== \"dist\")))
@

This is the same as:

@
find . \\( -name dist -prune \\) -o -print
@
-}

{- $performance

find-conduit strives to make file-finding a well performing operation.  To
this end, a composed Predicate will only call stat once per entry being
considered; and if you prune a directory, it is not traversed at all.

By default, 'find' calls stat for every file before it applies the predicate,
in order to ensure that only one such call is needed.  Sometimes, however, you
know just from the FilePath that you don't want to consider a certain file, or
you want to prune a directory tree.

To support these types of optimized queries, a variant of find is provided
called 'findWithPreFilter'.  This takes two predicates: one that is applied to
only the FilePath, before stat (or lstat) is called; and one that is applied
to the full file information after the stat.
-}

{- $notes

See 'Data.Cond' for more details on the Monad used to build predicates.
-}

data FindOptions = FindOptions
    { FindOptions -> Bool
findFollowSymlinks   :: !Bool
    , FindOptions -> Bool
findContentsFirst    :: !Bool
    , FindOptions -> Bool
findIgnoreErrors     :: !Bool
    , FindOptions -> Bool
findIgnoreResults    :: !Bool
    , FindOptions -> Bool
findLeafOptimization :: !Bool
    }

defaultFindOptions :: FindOptions
defaultFindOptions :: FindOptions
defaultFindOptions = FindOptions
    { findFollowSymlinks :: Bool
findFollowSymlinks   = Bool
True
    , findContentsFirst :: Bool
findContentsFirst    = Bool
False
    , findIgnoreErrors :: Bool
findIgnoreErrors     = Bool
False
    , findIgnoreResults :: Bool
findIgnoreResults    = Bool
False
    , findLeafOptimization :: Bool
findLeafOptimization = Bool
True
    }

data FileEntry = FileEntry
    { FileEntry -> FilePath
entryPath        :: !FP.FilePath
    , FileEntry -> Int
entryDepth       :: !Int
    , FileEntry -> FindOptions
entryFindOptions :: !FindOptions
    , FileEntry -> Maybe FileStatus
entryStatus      :: !(Maybe FileStatus)
      -- ^ This is Nothing until we determine stat should be called.
    }

newFileEntry :: FP.FilePath -> Int -> FindOptions -> FileEntry
newFileEntry :: FilePath -> Int -> FindOptions -> FileEntry
newFileEntry FilePath
fp Int
d FindOptions
f = FilePath -> Int -> FindOptions -> Maybe FileStatus -> FileEntry
FileEntry FilePath
fp Int
d FindOptions
f Maybe FileStatus
forall a. Maybe a
Nothing

instance Show FileEntry where
    show :: FileEntry -> FilePath
show FileEntry
entry = FilePath
"FileEntry "
              FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> FilePath
show (FileEntry -> FilePath
entryPath FileEntry
entry)
              FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (FileEntry -> Int
entryDepth FileEntry
entry)

getFilePath :: Monad m => CondT FileEntry m FP.FilePath
getFilePath :: forall (m :: * -> *). Monad m => CondT FileEntry m FilePath
getFilePath = (FileEntry -> FilePath) -> CondT FileEntry m FilePath
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FileEntry -> FilePath
entryPath

pathname_ :: Monad m => (FP.FilePath -> Bool) -> CondT FileEntry m ()
pathname_ :: forall (m :: * -> *).
Monad m =>
(FilePath -> Bool) -> CondT FileEntry m ()
pathname_ FilePath -> Bool
f = Bool -> CondT FileEntry m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> CondT FileEntry m ())
-> (FilePath -> Bool) -> FilePath -> CondT FileEntry m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
f (FilePath -> CondT FileEntry m ())
-> CondT FileEntry m FilePath -> CondT FileEntry m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CondT FileEntry m FilePath
forall (m :: * -> *). Monad m => CondT FileEntry m FilePath
getFilePath

filename_ :: Monad m => (FP.FilePath -> Bool) -> CondT FileEntry m ()
filename_ :: forall (m :: * -> *).
Monad m =>
(FilePath -> Bool) -> CondT FileEntry m ()
filename_ FilePath -> Bool
f = (FilePath -> Bool) -> CondT FileEntry m ()
forall (m :: * -> *).
Monad m =>
(FilePath -> Bool) -> CondT FileEntry m ()
pathname_ (FilePath -> Bool
f (FilePath -> Bool) -> ShowS -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
FP.takeFileName)

getDepth :: Monad m => CondT FileEntry m Int
getDepth :: forall (m :: * -> *). Monad m => CondT FileEntry m Int
getDepth = (FileEntry -> Int) -> CondT FileEntry m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FileEntry -> Int
entryDepth

modifyFindOptions :: Monad m
                  => (FindOptions -> FindOptions)
                  -> CondT FileEntry m ()
modifyFindOptions :: forall (m :: * -> *).
Monad m =>
(FindOptions -> FindOptions) -> CondT FileEntry m ()
modifyFindOptions FindOptions -> FindOptions
f =
    (FileEntry -> FileEntry) -> CondT FileEntry m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FileEntry -> FileEntry) -> CondT FileEntry m ())
-> (FileEntry -> FileEntry) -> CondT FileEntry m ()
forall a b. (a -> b) -> a -> b
$ \FileEntry
e -> FileEntry
e { entryFindOptions = f (entryFindOptions e) }

------------------------------------------------------------------------
-- Workalike options for emulating GNU find.
------------------------------------------------------------------------

depth_ :: Monad m => CondT FileEntry m ()
depth_ :: forall (m :: * -> *). Monad m => CondT FileEntry m ()
depth_ = (FindOptions -> FindOptions) -> CondT FileEntry m ()
forall (m :: * -> *).
Monad m =>
(FindOptions -> FindOptions) -> CondT FileEntry m ()
modifyFindOptions ((FindOptions -> FindOptions) -> CondT FileEntry m ())
-> (FindOptions -> FindOptions) -> CondT FileEntry m ()
forall a b. (a -> b) -> a -> b
$ \FindOptions
opts -> FindOptions
opts { findContentsFirst = True }

follow_ :: Monad m => CondT FileEntry m ()
follow_ :: forall (m :: * -> *). Monad m => CondT FileEntry m ()
follow_ = (FindOptions -> FindOptions) -> CondT FileEntry m ()
forall (m :: * -> *).
Monad m =>
(FindOptions -> FindOptions) -> CondT FileEntry m ()
modifyFindOptions ((FindOptions -> FindOptions) -> CondT FileEntry m ())
-> (FindOptions -> FindOptions) -> CondT FileEntry m ()
forall a b. (a -> b) -> a -> b
$ \FindOptions
opts -> FindOptions
opts { findFollowSymlinks = True }

noleaf_ :: Monad m => CondT FileEntry m ()
noleaf_ :: forall (m :: * -> *). Monad m => CondT FileEntry m ()
noleaf_ = (FindOptions -> FindOptions) -> CondT FileEntry m ()
forall (m :: * -> *).
Monad m =>
(FindOptions -> FindOptions) -> CondT FileEntry m ()
modifyFindOptions ((FindOptions -> FindOptions) -> CondT FileEntry m ())
-> (FindOptions -> FindOptions) -> CondT FileEntry m ()
forall a b. (a -> b) -> a -> b
$ \FindOptions
opts -> FindOptions
opts { findLeafOptimization = False }

prune_ :: Monad m => CondT a m ()
prune_ :: forall (m :: * -> *) a. Monad m => CondT a m ()
prune_ = CondT a m ()
forall (m :: * -> *) a b. Monad m => CondT a m b
prune

ignoreErrors_ :: Monad m => CondT FileEntry m ()
ignoreErrors_ :: forall (m :: * -> *). Monad m => CondT FileEntry m ()
ignoreErrors_ =
    (FindOptions -> FindOptions) -> CondT FileEntry m ()
forall (m :: * -> *).
Monad m =>
(FindOptions -> FindOptions) -> CondT FileEntry m ()
modifyFindOptions ((FindOptions -> FindOptions) -> CondT FileEntry m ())
-> (FindOptions -> FindOptions) -> CondT FileEntry m ()
forall a b. (a -> b) -> a -> b
$ \FindOptions
opts -> FindOptions
opts { findIgnoreErrors = True }

noIgnoreErrors_ :: Monad m => CondT FileEntry m ()
noIgnoreErrors_ :: forall (m :: * -> *). Monad m => CondT FileEntry m ()
noIgnoreErrors_ =
    (FindOptions -> FindOptions) -> CondT FileEntry m ()
forall (m :: * -> *).
Monad m =>
(FindOptions -> FindOptions) -> CondT FileEntry m ()
modifyFindOptions ((FindOptions -> FindOptions) -> CondT FileEntry m ())
-> (FindOptions -> FindOptions) -> CondT FileEntry m ()
forall a b. (a -> b) -> a -> b
$ \FindOptions
opts -> FindOptions
opts { findIgnoreErrors = False }

maxdepth_ :: Monad m => Int -> CondT FileEntry m ()
maxdepth_ :: forall (m :: * -> *). Monad m => Int -> CondT FileEntry m ()
maxdepth_ Int
l = CondT FileEntry m Int
forall (m :: * -> *). Monad m => CondT FileEntry m Int
getDepth CondT FileEntry m Int
-> (Int -> CondT FileEntry m ()) -> CondT FileEntry m ()
forall a b.
CondT FileEntry m a
-> (a -> CondT FileEntry m b) -> CondT FileEntry m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> CondT FileEntry m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> CondT FileEntry m ())
-> (Int -> Bool) -> Int -> CondT FileEntry m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
l)

mindepth_ :: Monad m => Int -> CondT FileEntry m ()
mindepth_ :: forall (m :: * -> *). Monad m => Int -> CondT FileEntry m ()
mindepth_ Int
l = CondT FileEntry m Int
forall (m :: * -> *). Monad m => CondT FileEntry m Int
getDepth CondT FileEntry m Int
-> (Int -> CondT FileEntry m ()) -> CondT FileEntry m ()
forall a b.
CondT FileEntry m a
-> (a -> CondT FileEntry m b) -> CondT FileEntry m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> CondT FileEntry m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> CondT FileEntry m ())
-> (Int -> Bool) -> Int -> CondT FileEntry m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l)

-- xdev_ = error "NYI"

timeComp :: MonadIO m
         => ((UTCTime -> Bool) -> CondT FileEntry m ()) -> Int
         -> CondT FileEntry m ()
timeComp :: forall (m :: * -> *).
MonadIO m =>
((UTCTime -> Bool) -> CondT FileEntry m ())
-> Int -> CondT FileEntry m ()
timeComp (UTCTime -> Bool) -> CondT FileEntry m ()
f Int
n = do
    UTCTime
now <- IO UTCTime -> CondT FileEntry m UTCTime
forall a. IO a -> CondT FileEntry m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    (UTCTime -> Bool) -> CondT FileEntry m ()
f (\UTCTime
t -> UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
now UTCTime
t NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)

amin_ :: MonadIO m => Int -> CondT FileEntry m ()
amin_ :: forall (m :: * -> *). MonadIO m => Int -> CondT FileEntry m ()
amin_ Int
n = ((UTCTime -> Bool) -> CondT FileEntry m ())
-> Int -> CondT FileEntry m ()
forall (m :: * -> *).
MonadIO m =>
((UTCTime -> Bool) -> CondT FileEntry m ())
-> Int -> CondT FileEntry m ()
timeComp (UTCTime -> Bool) -> CondT FileEntry m ()
forall (m :: * -> *).
MonadIO m =>
(UTCTime -> Bool) -> CondT FileEntry m ()
lastAccessed_ (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60)

atime_ :: MonadIO m => Int -> CondT FileEntry m ()
atime_ :: forall (m :: * -> *). MonadIO m => Int -> CondT FileEntry m ()
atime_ Int
n = ((UTCTime -> Bool) -> CondT FileEntry m ())
-> Int -> CondT FileEntry m ()
forall (m :: * -> *).
MonadIO m =>
((UTCTime -> Bool) -> CondT FileEntry m ())
-> Int -> CondT FileEntry m ()
timeComp (UTCTime -> Bool) -> CondT FileEntry m ()
forall (m :: * -> *).
MonadIO m =>
(UTCTime -> Bool) -> CondT FileEntry m ()
lastAccessed_ (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
24 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3600)

anewer_ :: MonadIO m => FP.FilePath -> CondT FileEntry m ()
anewer_ :: forall (m :: * -> *). MonadIO m => FilePath -> CondT FileEntry m ()
anewer_ FilePath
path = do
    FileEntry
e  <- CondT FileEntry m FileEntry
forall s (m :: * -> *). MonadState s m => m s
get
    FileStatus
es <- Maybe Bool -> CondT FileEntry m FileStatus
forall (m :: * -> *).
MonadIO m =>
Maybe Bool -> CondT FileEntry m FileStatus
applyStat Maybe Bool
forall a. Maybe a
Nothing
    Maybe (FileStatus, FileEntry)
ms <- Maybe Bool
-> FileEntry -> CondT FileEntry m (Maybe (FileStatus, FileEntry))
forall (m :: * -> *).
MonadIO m =>
Maybe Bool -> FileEntry -> m (Maybe (FileStatus, FileEntry))
getStat Maybe Bool
forall a. Maybe a
Nothing FileEntry
e { entryPath   = path
                            , entryStatus = Nothing
                            }
    case Maybe (FileStatus, FileEntry)
ms of
        Maybe (FileStatus, FileEntry)
Nothing     -> CondT FileEntry m Any
forall (m :: * -> *) a b. Monad m => CondT a m b
prune CondT FileEntry m Any
-> CondT FileEntry m () -> CondT FileEntry m ()
forall a b.
CondT FileEntry m a -> CondT FileEntry m b -> CondT FileEntry m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> CondT FileEntry m ()
forall a. HasCallStack => FilePath -> a
error FilePath
"This is never reached"
        Just (FileStatus
s, FileEntry
_) -> Bool -> CondT FileEntry m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> CondT FileEntry m ()) -> Bool -> CondT FileEntry m ()
forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime (FileStatus -> UTCTime
f FileStatus
s) (FileStatus -> UTCTime
f FileStatus
es) NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> NominalDiffTime
0
  where
    f :: FileStatus -> UTCTime
f = NominalDiffTime -> UTCTime
posixSecondsToUTCTime (NominalDiffTime -> UTCTime)
-> (FileStatus -> NominalDiffTime) -> FileStatus -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochTime -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (EpochTime -> NominalDiffTime)
-> (FileStatus -> EpochTime) -> FileStatus -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> EpochTime
Files.accessTime

-- cmin_ = error "NYI"
-- cnewer_ = error "NYI"
-- ctime_ = error "NYI"

empty_ :: MonadIO m => CondT FileEntry m ()
empty_ :: forall (m :: * -> *). MonadIO m => CondT FileEntry m ()
empty_ = (CondT FileEntry m ()
forall (m :: * -> *). MonadIO m => CondT FileEntry m ()
regular   CondT FileEntry m ()
-> CondT FileEntry m () -> CondT FileEntry m ()
forall a b.
CondT FileEntry m a -> CondT FileEntry m b -> CondT FileEntry m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (FileStatus -> Bool) -> CondT FileEntry m ()
forall (m :: * -> *).
MonadIO m =>
(FileStatus -> Bool) -> CondT FileEntry m ()
hasStatus ((FileOffset -> FileOffset -> Bool
forall a. Eq a => a -> a -> Bool
== FileOffset
0) (FileOffset -> Bool)
-> (FileStatus -> FileOffset) -> FileStatus -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> FileOffset
Files.fileSize))
     CondT FileEntry m ()
-> CondT FileEntry m () -> CondT FileEntry m ()
forall a.
CondT FileEntry m a -> CondT FileEntry m a -> CondT FileEntry m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CondT FileEntry m ()
forall (m :: * -> *). MonadIO m => CondT FileEntry m ()
directory CondT FileEntry m ()
-> CondT FileEntry m () -> CondT FileEntry m ()
forall a b.
CondT FileEntry m a -> CondT FileEntry m b -> CondT FileEntry m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (FileStatus -> Bool) -> CondT FileEntry m ()
forall (m :: * -> *).
MonadIO m =>
(FileStatus -> Bool) -> CondT FileEntry m ()
hasStatus ((LinkCount -> LinkCount -> Bool
forall a. Eq a => a -> a -> Bool
== LinkCount
2) (LinkCount -> Bool)
-> (FileStatus -> LinkCount) -> FileStatus -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> LinkCount
linkCount))

executable_ :: MonadIO m => CondT FileEntry m ()
executable_ :: forall (m :: * -> *). MonadIO m => CondT FileEntry m ()
executable_ = CondT FileEntry m ()
forall (m :: * -> *). MonadIO m => CondT FileEntry m ()
executable

gid_ :: MonadIO m => Int -> CondT FileEntry m ()
gid_ :: forall (m :: * -> *). MonadIO m => Int -> CondT FileEntry m ()
gid_ Int
n = (FileStatus -> Bool) -> CondT FileEntry m ()
forall (m :: * -> *).
MonadIO m =>
(FileStatus -> Bool) -> CondT FileEntry m ()
hasStatus ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n) (Int -> Bool) -> (FileStatus -> Int) -> FileStatus -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GroupID -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GroupID -> Int) -> (FileStatus -> GroupID) -> FileStatus -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> GroupID
Files.fileGroup)

{-
group_ name
ilname_ pat
iname_ pat
inum_ n
ipath_ pat
iregex_ pat
iwholename_ pat
links_ n
lname_ pat
mmin_
mtime_
-}

name_ :: Monad m => FP.FilePath -> CondT FileEntry m ()
name_ :: forall (m :: * -> *). Monad m => FilePath -> CondT FileEntry m ()
name_ = (FilePath -> Bool) -> CondT FileEntry m ()
forall (m :: * -> *).
Monad m =>
(FilePath -> Bool) -> CondT FileEntry m ()
filename_ ((FilePath -> Bool) -> CondT FileEntry m ())
-> (FilePath -> FilePath -> Bool)
-> FilePath
-> CondT FileEntry m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
(==)

{-
newer_ path
newerXY_ ref
nogroup_
nouser_
path_ pat
perm_ mode :: Perm
readable_
regex_ pat
samefile_ path
size_ n :: Size
type_ c
uid_ n
used_ n
user_ name
wholename_ pat
writable_
xtype_ c
-}

------------------------------------------------------------------------

statFilePath :: Bool -> Bool -> FP.FilePath -> IO (Maybe FileStatus)
statFilePath :: Bool -> Bool -> FilePath -> IO (Maybe FileStatus)
statFilePath Bool
follow Bool
ignoreErrors FilePath
path = do
    let doStat :: IO FileStatus
doStat = (if Bool
follow
                  then FilePath -> IO FileStatus
Files.getFileStatus
                  else FilePath -> IO FileStatus
Files.getSymbolicLinkStatus) FilePath
path
    IO (Maybe FileStatus)
-> (IOException -> IO (Maybe FileStatus)) -> IO (Maybe FileStatus)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (FileStatus -> Maybe FileStatus
forall a. a -> Maybe a
Just (FileStatus -> Maybe FileStatus)
-> IO FileStatus -> IO (Maybe FileStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FileStatus
doStat) ((IOException -> IO (Maybe FileStatus)) -> IO (Maybe FileStatus))
-> (IOException -> IO (Maybe FileStatus)) -> IO (Maybe FileStatus)
forall a b. (a -> b) -> a -> b
$ \IOException
e ->
        if Bool
ignoreErrors
        then Maybe FileStatus -> IO (Maybe FileStatus)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FileStatus
forall a. Maybe a
Nothing
        else IOException -> IO (Maybe FileStatus)
forall e a. Exception e => e -> IO a
throwIO (IOException
e :: IOException)

-- | Get the current status for the file.  If the status being requested is
--   already cached in the entry information, simply return it from there.
getStat :: MonadIO m
        => Maybe Bool
        -> FileEntry
        -> m (Maybe (FileStatus, FileEntry))
getStat :: forall (m :: * -> *).
MonadIO m =>
Maybe Bool -> FileEntry -> m (Maybe (FileStatus, FileEntry))
getStat Maybe Bool
mfollow FileEntry
entry = case FileEntry -> Maybe FileStatus
entryStatus FileEntry
entry of
    Just FileStatus
s
        | Bool -> (Bool -> Bool) -> Maybe Bool -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== FileEntry -> Bool
follow FileEntry
entry) Maybe Bool
mfollow ->
            Maybe (FileStatus, FileEntry) -> m (Maybe (FileStatus, FileEntry))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (FileStatus, FileEntry)
 -> m (Maybe (FileStatus, FileEntry)))
-> Maybe (FileStatus, FileEntry)
-> m (Maybe (FileStatus, FileEntry))
forall a b. (a -> b) -> a -> b
$ (FileStatus, FileEntry) -> Maybe (FileStatus, FileEntry)
forall a. a -> Maybe a
Just (FileStatus
s, FileEntry
entry)
        | Bool
otherwise -> (FileStatus -> (FileStatus, FileEntry))
-> Maybe FileStatus -> Maybe (FileStatus, FileEntry)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, FileEntry
entry) (Maybe FileStatus -> Maybe (FileStatus, FileEntry))
-> m (Maybe FileStatus) -> m (Maybe (FileStatus, FileEntry))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (Maybe FileStatus)
wrapStat
    Maybe FileStatus
Nothing -> do
        Maybe FileStatus
ms <- m (Maybe FileStatus)
wrapStat
        Maybe (FileStatus, FileEntry) -> m (Maybe (FileStatus, FileEntry))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (FileStatus, FileEntry)
 -> m (Maybe (FileStatus, FileEntry)))
-> Maybe (FileStatus, FileEntry)
-> m (Maybe (FileStatus, FileEntry))
forall a b. (a -> b) -> a -> b
$ case Maybe FileStatus
ms of
            Just FileStatus
s  -> (FileStatus, FileEntry) -> Maybe (FileStatus, FileEntry)
forall a. a -> Maybe a
Just (FileStatus
s, FileEntry
entry { entryStatus = Just s })
            Maybe FileStatus
Nothing -> Maybe (FileStatus, FileEntry)
forall a. Maybe a
Nothing
  where
    follow :: FileEntry -> Bool
follow   = FindOptions -> Bool
findFollowSymlinks (FindOptions -> Bool)
-> (FileEntry -> FindOptions) -> FileEntry -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileEntry -> FindOptions
entryFindOptions
    wrapStat :: m (Maybe FileStatus)
wrapStat = IO (Maybe FileStatus) -> m (Maybe FileStatus)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FileStatus) -> m (Maybe FileStatus))
-> IO (Maybe FileStatus) -> m (Maybe FileStatus)
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> FilePath -> IO (Maybe FileStatus)
statFilePath
        (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (FindOptions -> Bool
findFollowSymlinks FindOptions
opts) Maybe Bool
mfollow)
        (FindOptions -> Bool
findIgnoreErrors FindOptions
opts)
        (FileEntry -> FilePath
entryPath FileEntry
entry)
      where
        opts :: FindOptions
opts = FileEntry -> FindOptions
entryFindOptions FileEntry
entry

applyStat :: MonadIO m => Maybe Bool -> CondT FileEntry m FileStatus
applyStat :: forall (m :: * -> *).
MonadIO m =>
Maybe Bool -> CondT FileEntry m FileStatus
applyStat Maybe Bool
mfollow = do
    Maybe (FileStatus, FileEntry)
ms <- m (Maybe (FileStatus, FileEntry))
-> CondT FileEntry m (Maybe (FileStatus, FileEntry))
forall (m :: * -> *) a. Monad m => m a -> CondT FileEntry m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (FileStatus, FileEntry))
 -> CondT FileEntry m (Maybe (FileStatus, FileEntry)))
-> (FileEntry -> m (Maybe (FileStatus, FileEntry)))
-> FileEntry
-> CondT FileEntry m (Maybe (FileStatus, FileEntry))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Bool -> FileEntry -> m (Maybe (FileStatus, FileEntry))
forall (m :: * -> *).
MonadIO m =>
Maybe Bool -> FileEntry -> m (Maybe (FileStatus, FileEntry))
getStat Maybe Bool
mfollow (FileEntry -> CondT FileEntry m (Maybe (FileStatus, FileEntry)))
-> CondT FileEntry m FileEntry
-> CondT FileEntry m (Maybe (FileStatus, FileEntry))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CondT FileEntry m FileEntry
forall s (m :: * -> *). MonadState s m => m s
get
    case Maybe (FileStatus, FileEntry)
ms of
        Maybe (FileStatus, FileEntry)
Nothing      -> CondT FileEntry m Any
forall (m :: * -> *) a b. Monad m => CondT a m b
prune CondT FileEntry m Any
-> CondT FileEntry m FileStatus -> CondT FileEntry m FileStatus
forall a b.
CondT FileEntry m a -> CondT FileEntry m b -> CondT FileEntry m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> CondT FileEntry m FileStatus
forall a. HasCallStack => FilePath -> a
error FilePath
"This is never reached"
        Just (FileStatus
s, FileEntry
e') -> FileStatus
s FileStatus -> CondT FileEntry m () -> CondT FileEntry m FileStatus
forall a b. a -> CondT FileEntry m b -> CondT FileEntry m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ FileEntry -> CondT FileEntry m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put FileEntry
e'

lstat :: MonadIO m => CondT FileEntry m FileStatus
lstat :: forall (m :: * -> *). MonadIO m => CondT FileEntry m FileStatus
lstat = Maybe Bool -> CondT FileEntry m FileStatus
forall (m :: * -> *).
MonadIO m =>
Maybe Bool -> CondT FileEntry m FileStatus
applyStat (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False)

stat :: MonadIO m => CondT FileEntry m FileStatus
stat :: forall (m :: * -> *). MonadIO m => CondT FileEntry m FileStatus
stat = Maybe Bool -> CondT FileEntry m FileStatus
forall (m :: * -> *).
MonadIO m =>
Maybe Bool -> CondT FileEntry m FileStatus
applyStat (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)

hasStatus :: MonadIO m => (FileStatus -> Bool) -> CondT FileEntry m ()
hasStatus :: forall (m :: * -> *).
MonadIO m =>
(FileStatus -> Bool) -> CondT FileEntry m ()
hasStatus FileStatus -> Bool
f = Bool -> CondT FileEntry m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> CondT FileEntry m ())
-> (FileStatus -> Bool) -> FileStatus -> CondT FileEntry m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> Bool
f (FileStatus -> CondT FileEntry m ())
-> CondT FileEntry m FileStatus -> CondT FileEntry m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Bool -> CondT FileEntry m FileStatus
forall (m :: * -> *).
MonadIO m =>
Maybe Bool -> CondT FileEntry m FileStatus
applyStat Maybe Bool
forall a. Maybe a
Nothing

regular :: MonadIO m => CondT FileEntry m ()
regular :: forall (m :: * -> *). MonadIO m => CondT FileEntry m ()
regular = (FileStatus -> Bool) -> CondT FileEntry m ()
forall (m :: * -> *).
MonadIO m =>
(FileStatus -> Bool) -> CondT FileEntry m ()
hasStatus FileStatus -> Bool
Files.isRegularFile

executable :: MonadIO m => CondT FileEntry m ()
executable :: forall (m :: * -> *). MonadIO m => CondT FileEntry m ()
executable = FileMode -> CondT FileEntry m ()
forall (m :: * -> *). MonadIO m => FileMode -> CondT FileEntry m ()
hasMode FileMode
Files.ownerExecuteMode

directory :: MonadIO m => CondT FileEntry m ()
directory :: forall (m :: * -> *). MonadIO m => CondT FileEntry m ()
directory = (FileStatus -> Bool) -> CondT FileEntry m ()
forall (m :: * -> *).
MonadIO m =>
(FileStatus -> Bool) -> CondT FileEntry m ()
hasStatus FileStatus -> Bool
Files.isDirectory

hasMode :: MonadIO m => FileMode -> CondT FileEntry m ()
hasMode :: forall (m :: * -> *). MonadIO m => FileMode -> CondT FileEntry m ()
hasMode FileMode
m = (FileStatus -> Bool) -> CondT FileEntry m ()
forall (m :: * -> *).
MonadIO m =>
(FileStatus -> Bool) -> CondT FileEntry m ()
hasStatus (\FileStatus
s -> FileStatus -> FileMode
Files.fileMode FileStatus
s FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.&. FileMode
m FileMode -> FileMode -> Bool
forall a. Eq a => a -> a -> Bool
/= FileMode
0)

withStatusTime :: MonadIO m
               => (FileStatus -> EpochTime) -> (UTCTime -> Bool)
               -> CondT FileEntry m ()
withStatusTime :: forall (m :: * -> *).
MonadIO m =>
(FileStatus -> EpochTime)
-> (UTCTime -> Bool) -> CondT FileEntry m ()
withStatusTime FileStatus -> EpochTime
g UTCTime -> Bool
f = (FileStatus -> Bool) -> CondT FileEntry m ()
forall (m :: * -> *).
MonadIO m =>
(FileStatus -> Bool) -> CondT FileEntry m ()
hasStatus (UTCTime -> Bool
f (UTCTime -> Bool) -> (FileStatus -> UTCTime) -> FileStatus -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> UTCTime
posixSecondsToUTCTime (NominalDiffTime -> UTCTime)
-> (FileStatus -> NominalDiffTime) -> FileStatus -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochTime -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (EpochTime -> NominalDiffTime)
-> (FileStatus -> EpochTime) -> FileStatus -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> EpochTime
g)

lastAccessed_ :: MonadIO m => (UTCTime -> Bool) -> CondT FileEntry m ()
lastAccessed_ :: forall (m :: * -> *).
MonadIO m =>
(UTCTime -> Bool) -> CondT FileEntry m ()
lastAccessed_ = (FileStatus -> EpochTime)
-> (UTCTime -> Bool) -> CondT FileEntry m ()
forall (m :: * -> *).
MonadIO m =>
(FileStatus -> EpochTime)
-> (UTCTime -> Bool) -> CondT FileEntry m ()
withStatusTime FileStatus -> EpochTime
Files.accessTime

lastModified_ :: MonadIO m => (UTCTime -> Bool) -> CondT FileEntry m ()
lastModified_ :: forall (m :: * -> *).
MonadIO m =>
(UTCTime -> Bool) -> CondT FileEntry m ()
lastModified_ = (FileStatus -> EpochTime)
-> (UTCTime -> Bool) -> CondT FileEntry m ()
forall (m :: * -> *).
MonadIO m =>
(FileStatus -> EpochTime)
-> (UTCTime -> Bool) -> CondT FileEntry m ()
withStatusTime FileStatus -> EpochTime
Files.modificationTime

regex :: Monad m => String -> CondT FileEntry m ()
regex :: forall (m :: * -> *). Monad m => FilePath -> CondT FileEntry m ()
regex FilePath
pat = (FilePath -> Bool) -> CondT FileEntry m ()
forall (m :: * -> *).
Monad m =>
(FilePath -> Bool) -> CondT FileEntry m ()
filename_ (FilePath -> FilePath -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ FilePath
pat)

-- | Return all entries, except for those within version-control metadata
--   directories (and not including the version control directory itself either).
ignoreVcs :: Monad m => CondT FileEntry m ()
ignoreVcs :: forall (m :: * -> *). Monad m => CondT FileEntry m ()
ignoreVcs = CondT FileEntry m ()
-> CondT FileEntry m () -> CondT FileEntry m ()
forall (m :: * -> *) a r.
Monad m =>
CondT a m r -> CondT a m () -> CondT a m ()
when_ ((FilePath -> Bool) -> CondT FileEntry m ()
forall (m :: * -> *).
Monad m =>
(FilePath -> Bool) -> CondT FileEntry m ()
filename_ (FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
vcsDirs)) CondT FileEntry m ()
forall (m :: * -> *) a b. Monad m => CondT a m b
prune
  where
    vcsDirs :: [FilePath]
vcsDirs = [ FilePath
".git", FilePath
"CVS", FilePath
"RCS", FilePath
"SCCS", FilePath
".svn", FilePath
".hg", FilePath
"_darcs" ]

-- | Find every entry whose filename part matching the given filename globbing
--   expression.  For example: @glob "*.hs"@.
glob :: Monad m => String -> CondT FileEntry m ()
glob :: forall (m :: * -> *). Monad m => FilePath -> CondT FileEntry m ()
glob FilePath
g = case Parser Text -> Text -> Either FilePath Text
forall a. Parser a -> Text -> Either FilePath a
parseOnly Parser Text
globParser (FilePath -> Text
pack FilePath
g) of
    Left FilePath
e  -> FilePath -> CondT FileEntry m ()
forall a. HasCallStack => FilePath -> a
error (FilePath -> CondT FileEntry m ())
-> FilePath -> CondT FileEntry m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to parse glob: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
e
    Right Text
x -> FilePath -> CondT FileEntry m ()
forall (m :: * -> *). Monad m => FilePath -> CondT FileEntry m ()
regex (FilePath
"^" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
unpack Text
x FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"$")
  where
    globParser :: Parser Text
    globParser :: Parser Text
globParser = ([Text] -> Text) -> Parser Text [Text] -> Parser Text
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat (Parser Text [Text] -> Parser Text)
-> Parser Text [Text] -> Parser Text
forall a b. (a -> b) -> a -> b
$ Parser Text -> Parser Text [Text]
forall a. Parser Text a -> Parser Text [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Text -> Parser Text [Text])
-> Parser Text -> Parser Text [Text]
forall a b. (a -> b) -> a -> b
$
            Char -> Parser Char
char Char
'*' Parser Char -> Parser Text -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
".*"
        Parser Text -> Parser Text -> Parser Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Char
char Char
'?' Parser Char -> Parser Text -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"."
        Parser Text -> Parser Text -> Parser Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
string Text
"[]]" Parser Text -> Parser Text -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"[]]"
        Parser Text -> Parser Text -> Parser Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (\Char
x FilePath
y Char
z -> FilePath -> Text
pack ((Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:FilePath
y) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
z]))
                (Char -> FilePath -> Char -> Text)
-> Parser Char -> Parser Text (FilePath -> Char -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Parser Char
char Char
'['
                Parser Text (FilePath -> Char -> Text)
-> Parser Text FilePath -> Parser Text (Char -> Text)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Char -> Parser Char -> Parser Text FilePath
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser Char
anyChar (Parser Char -> Parser Char
forall i a. Parser i a -> Parser i a
A.try (Char -> Parser Char
char Char
']'))
                Parser Text (Char -> Text) -> Parser Char -> Parser Text
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> Parser Char
char Char
']'
        Parser Text -> Parser Text -> Parser Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
            Char
x <- Parser Char
anyChar
            Text -> Parser Text
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Parser Text)
-> (FilePath -> Text) -> FilePath -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
pack (FilePath -> Parser Text) -> FilePath -> Parser Text
forall a b. (a -> b) -> a -> b
$ if Char
x Char -> FilePath -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (FilePath
".()^$" :: String)
                            then [Char
'\\', Char
x]
                            else [Char
x]

#if LEAFOPT
type DirCounter = IORef Word

newDirCounter :: MonadIO m => m DirCounter
newDirCounter :: forall (m :: * -> *). MonadIO m => m DirCounter
newDirCounter = IO DirCounter -> m DirCounter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DirCounter -> m DirCounter) -> IO DirCounter -> m DirCounter
forall a b. (a -> b) -> a -> b
$ Word -> IO DirCounter
forall a. a -> IO (IORef a)
newIORef Word
1
#else
type DirCounter = ()

newDirCounter :: MonadIO m => m DirCounter
newDirCounter = return ()
#endif

-- | Find file entries in a directory tree, recursively, applying the given
--   recursion predicate to the search.  This conduit yields pairs of type
--   @(FileEntry, a)@, where is the return value from the predicate at each
--   step.
sourceFindFiles :: MonadResource m
                => FindOptions
                -> FilePath
                -> CondT FileEntry m a
                -> ConduitT i (FileEntry, a) m ()
sourceFindFiles :: forall (m :: * -> *) a i.
MonadResource m =>
FindOptions
-> FilePath
-> CondT FileEntry m a
-> ConduitT i (FileEntry, a) m ()
sourceFindFiles FindOptions
findOptions FilePath
startPath CondT FileEntry m a
predicate = do
    DirCounter
startDc <- ConduitT i (FileEntry, a) m DirCounter
forall (m :: * -> *). MonadIO m => m DirCounter
newDirCounter
    DirCounter
-> FileEntry
-> FilePath
-> CondT FileEntry m a
-> ConduitT i (FileEntry, a) m ()
forall (m :: * -> *) a i.
MonadResource m =>
DirCounter
-> FileEntry
-> FilePath
-> CondT FileEntry m a
-> ConduitT i (FileEntry, a) m ()
walk DirCounter
startDc
        (FilePath -> Int -> FindOptions -> FileEntry
newFileEntry FilePath
startPath Int
0 FindOptions
findOptions)
        FilePath
startPath
        CondT FileEntry m a
predicate
  where
    walk :: MonadResource m
         => DirCounter
         -> FileEntry
         -> FP.FilePath
         -> CondT FileEntry m a
         -> ConduitT i (FileEntry, a) m ()
    walk :: forall (m :: * -> *) a i.
MonadResource m =>
DirCounter
-> FileEntry
-> FilePath
-> CondT FileEntry m a
-> ConduitT i (FileEntry, a) m ()
walk !DirCounter
dc !FileEntry
entry !FilePath
path !CondT FileEntry m a
cond = do
        ((!Maybe a
mres, !Maybe (CondT FileEntry m a)
mcond), !FileEntry
entry') <- m ((Maybe a, Maybe (CondT FileEntry m a)), FileEntry)
-> ConduitT
     i
     (FileEntry, a)
     m
     ((Maybe a, Maybe (CondT FileEntry m a)), FileEntry)
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT i (FileEntry, a) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ((Maybe a, Maybe (CondT FileEntry m a)), FileEntry)
 -> ConduitT
      i
      (FileEntry, a)
      m
      ((Maybe a, Maybe (CondT FileEntry m a)), FileEntry))
-> m ((Maybe a, Maybe (CondT FileEntry m a)), FileEntry)
-> ConduitT
     i
     (FileEntry, a)
     m
     ((Maybe a, Maybe (CondT FileEntry m a)), FileEntry)
forall a b. (a -> b) -> a -> b
$ FileEntry
-> CondT FileEntry m a
-> m ((Maybe a, Maybe (CondT FileEntry m a)), FileEntry)
forall (m :: * -> *) a b.
Monad m =>
a -> CondT a m b -> m ((Maybe b, Maybe (CondT a m b)), a)
applyCondT FileEntry
entry CondT FileEntry m a
cond
        let opts' :: FindOptions
opts' = FileEntry -> FindOptions
entryFindOptions FileEntry
entry
            this :: ConduitT i (FileEntry, a) m ()
this  = Bool
-> ConduitT i (FileEntry, a) m () -> ConduitT i (FileEntry, a) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FindOptions -> Bool
findIgnoreResults FindOptions
opts') (ConduitT i (FileEntry, a) m () -> ConduitT i (FileEntry, a) m ())
-> ConduitT i (FileEntry, a) m () -> ConduitT i (FileEntry, a) m ()
forall a b. (a -> b) -> a -> b
$
                        FileEntry -> Maybe a -> ConduitT i (FileEntry, a) m ()
forall {m :: * -> *} {a} {b} {i}.
Monad m =>
a -> Maybe b -> ConduitT i (a, b) m ()
yieldEntry FileEntry
entry' Maybe a
mres
            next :: ConduitT i (FileEntry, a) m ()
next  = DirCounter
-> FileEntry
-> FilePath
-> Maybe (CondT FileEntry m a)
-> ConduitT i (FileEntry, a) m ()
forall (m :: * -> *) a i.
MonadResource m =>
DirCounter
-> FileEntry
-> FilePath
-> Maybe (CondT FileEntry m a)
-> ConduitT i (FileEntry, a) m ()
walkChildren DirCounter
dc FileEntry
entry' FilePath
path Maybe (CondT FileEntry m a)
mcond
        if FindOptions -> Bool
findContentsFirst FindOptions
opts'
            then ConduitT i (FileEntry, a) m ()
forall {i}. ConduitT i (FileEntry, a) m ()
next ConduitT i (FileEntry, a) m ()
-> ConduitT i (FileEntry, a) m () -> ConduitT i (FileEntry, a) m ()
forall a b.
ConduitT i (FileEntry, a) m a
-> ConduitT i (FileEntry, a) m b -> ConduitT i (FileEntry, a) m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT i (FileEntry, a) m ()
forall {i}. ConduitT i (FileEntry, a) m ()
this
            else ConduitT i (FileEntry, a) m ()
forall {i}. ConduitT i (FileEntry, a) m ()
this ConduitT i (FileEntry, a) m ()
-> ConduitT i (FileEntry, a) m () -> ConduitT i (FileEntry, a) m ()
forall a b.
ConduitT i (FileEntry, a) m a
-> ConduitT i (FileEntry, a) m b -> ConduitT i (FileEntry, a) m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT i (FileEntry, a) m ()
forall {i}. ConduitT i (FileEntry, a) m ()
next
      where
        yieldEntry :: a -> Maybe b -> ConduitT i (a, b) m ()
yieldEntry a
_      Maybe b
Nothing    = () -> ConduitT i (a, b) m ()
forall a. a -> ConduitT i (a, b) m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        yieldEntry a
entry' (Just b
res) = (a, b) -> ConduitT i (a, b) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
DC.yield (a
entry', b
res)

    walkChildren :: MonadResource m
                 => DirCounter
                 -> FileEntry
                 -> FP.FilePath
                 -> Maybe (CondT FileEntry m a)
                 -> ConduitT i (FileEntry, a) m ()
    walkChildren :: forall (m :: * -> *) a i.
MonadResource m =>
DirCounter
-> FileEntry
-> FilePath
-> Maybe (CondT FileEntry m a)
-> ConduitT i (FileEntry, a) m ()
walkChildren DirCounter
_ FileEntry
_ FilePath
_ Maybe (CondT FileEntry m a)
Nothing = () -> ConduitT i (FileEntry, a) m ()
forall a. a -> ConduitT i (FileEntry, a) m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    -- If the conditional matched, we are requested to recurse if this is a
    -- directory
    walkChildren !DirCounter
dc !FileEntry
entry !FilePath
path (Just !CondT FileEntry m a
cond) = do
        Maybe FileStatus
st <- m (Maybe FileStatus)
-> ConduitT i (FileEntry, a) m (Maybe FileStatus)
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT i (FileEntry, a) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe FileStatus)
 -> ConduitT i (FileEntry, a) m (Maybe FileStatus))
-> m (Maybe FileStatus)
-> ConduitT i (FileEntry, a) m (Maybe FileStatus)
forall a b. (a -> b) -> a -> b
$ DirCounter -> FileEntry -> FilePath -> m (Maybe FileStatus)
forall (m :: * -> *).
MonadResource m =>
DirCounter -> FileEntry -> FilePath -> m (Maybe FileStatus)
checkIfDirectory DirCounter
dc FileEntry
entry FilePath
path
        Bool
-> ConduitT i (FileEntry, a) m () -> ConduitT i (FileEntry, a) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((FileStatus -> Bool) -> Maybe FileStatus -> Maybe Bool
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FileStatus -> Bool
Files.isDirectory Maybe FileStatus
st Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) (ConduitT i (FileEntry, a) m () -> ConduitT i (FileEntry, a) m ())
-> ConduitT i (FileEntry, a) m () -> ConduitT i (FileEntry, a) m ()
forall a b. (a -> b) -> a -> b
$ do
#if LEAFOPT
            -- Update directory count for the parent directory.
            IO () -> ConduitT i (FileEntry, a) m ()
forall a. IO a -> ConduitT i (FileEntry, a) m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ConduitT i (FileEntry, a) m ())
-> IO () -> ConduitT i (FileEntry, a) m ()
forall a b. (a -> b) -> a -> b
$ DirCounter -> (Word -> Word) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef DirCounter
dc Word -> Word
forall a. Enum a => a -> a
pred
            -- Track the directory count for this child path.
            let leafOpt :: Bool
leafOpt = FindOptions -> Bool
findLeafOptimization (FileEntry -> FindOptions
entryFindOptions FileEntry
entry)
            let lc :: LinkCount
lc = FileStatus -> LinkCount
linkCount (Maybe FileStatus -> FileStatus
forall a. HasCallStack => Maybe a -> a
fromJust Maybe FileStatus
st) LinkCount -> LinkCount -> LinkCount
forall a. Num a => a -> a -> a
- LinkCount
2
                opts' :: FindOptions
opts' = (FileEntry -> FindOptions
entryFindOptions FileEntry
entry)
                    { findLeafOptimization = leafOpt && lc >= 0
                    }
            DirCounter
dc' <- IO DirCounter -> ConduitT i (FileEntry, a) m DirCounter
forall a. IO a -> ConduitT i (FileEntry, a) m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DirCounter -> ConduitT i (FileEntry, a) m DirCounter)
-> IO DirCounter -> ConduitT i (FileEntry, a) m DirCounter
forall a b. (a -> b) -> a -> b
$ Word -> IO DirCounter
forall a. a -> IO (IORef a)
newIORef (LinkCount -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral LinkCount
lc :: Word)
#else
            let dc'   = dc
                opts' = entryFindOptions entry
#endif
            FilePath -> ConduitT i FilePath m ()
forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitT i FilePath m ()
CF.sourceDirectory FilePath
path ConduitT i FilePath m ()
-> ConduitT FilePath (FileEntry, a) m ()
-> ConduitT i (FileEntry, a) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (FilePath -> ConduitT FilePath (FileEntry, a) m ())
-> ConduitT FilePath (FileEntry, a) m ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
DC.awaitForever (DirCounter
-> FindOptions -> FilePath -> ConduitT FilePath (FileEntry, a) m ()
forall {i}.
DirCounter
-> FindOptions -> FilePath -> ConduitT i (FileEntry, a) m ()
go DirCounter
dc' FindOptions
opts')
      where
        go :: DirCounter
-> FindOptions -> FilePath -> ConduitT i (FileEntry, a) m ()
go DirCounter
dc' FindOptions
opts' FilePath
fp =
            let entry' :: FileEntry
entry' = FilePath -> Int -> FindOptions -> FileEntry
newFileEntry FilePath
fp (Int -> Int
forall a. Enum a => a -> a
succ (FileEntry -> Int
entryDepth FileEntry
entry)) FindOptions
opts'
            in DirCounter
-> FileEntry
-> FilePath
-> CondT FileEntry m a
-> ConduitT i (FileEntry, a) m ()
forall (m :: * -> *) a i.
MonadResource m =>
DirCounter
-> FileEntry
-> FilePath
-> CondT FileEntry m a
-> ConduitT i (FileEntry, a) m ()
walk DirCounter
dc' FileEntry
entry' FilePath
fp CondT FileEntry m a
cond

    -- Return True if the given entry is a directory.  We can sometimes use
    -- "leaf optimization" on Linux to answer this question without performing
    -- a stat call.  This is possible because the link count of a directory is
    -- two more than the number of sub-directories it contains, so we've seen
    -- that many sub-directories, the remaining entries must be files.
    checkIfDirectory :: MonadResource m
                     => DirCounter
                     -> FileEntry
                     -> FP.FilePath
                     -> m (Maybe FileStatus)
    checkIfDirectory :: forall (m :: * -> *).
MonadResource m =>
DirCounter -> FileEntry -> FilePath -> m (Maybe FileStatus)
checkIfDirectory !DirCounter
dc !FileEntry
entry !FilePath
path = do
#if LEAFOPT
        let leafOpt :: Bool
leafOpt = FindOptions -> Bool
findLeafOptimization (FileEntry -> FindOptions
entryFindOptions FileEntry
entry)
        Bool
doStat <- if Bool
leafOpt
                  then (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
0) (Word -> Bool) -> m Word -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Word -> m Word
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (DirCounter -> IO Word
forall a. IORef a -> IO a
readIORef DirCounter
dc)
                  else Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
#else
        let doStat = dc == () -- to quiet hlint warnings
#endif
        let opts :: FindOptions
opts = FileEntry -> FindOptions
entryFindOptions FileEntry
entry
        if Bool
doStat
            then IO (Maybe FileStatus) -> m (Maybe FileStatus)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FileStatus) -> m (Maybe FileStatus))
-> IO (Maybe FileStatus) -> m (Maybe FileStatus)
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> FilePath -> IO (Maybe FileStatus)
statFilePath
                (FindOptions -> Bool
findFollowSymlinks FindOptions
opts)
                (FindOptions -> Bool
findIgnoreErrors FindOptions
opts)
                FilePath
path
            else Maybe FileStatus -> m (Maybe FileStatus)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FileStatus
forall a. Maybe a
Nothing

findFiles :: (MonadIO m, MonadBaseControl IO m, MonadThrow m, MonadUnliftIO m)
          => FindOptions
          -> FilePath
          -> CondT FileEntry m a
          -> m ()
findFiles :: forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m, MonadThrow m,
 MonadUnliftIO m) =>
FindOptions -> FilePath -> CondT FileEntry m a -> m ()
findFiles FindOptions
opts FilePath
path CondT FileEntry m a
predicate =
    ConduitT () Void (ResourceT m) () -> m ()
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes (ConduitT () Void (ResourceT m) () -> m ())
-> ConduitT () Void (ResourceT m) () -> m ()
forall a b. (a -> b) -> a -> b
$
        FindOptions
-> FilePath
-> CondT FileEntry (ResourceT m) a
-> ConduitT () (FileEntry, a) (ResourceT m) ()
forall (m :: * -> *) a i.
MonadResource m =>
FindOptions
-> FilePath
-> CondT FileEntry m a
-> ConduitT i (FileEntry, a) m ()
sourceFindFiles FindOptions
opts { findIgnoreResults = True } FilePath
path
            ((forall a. m a -> ResourceT m a)
-> CondT FileEntry m a -> CondT FileEntry (ResourceT m) a
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> CondT FileEntry m b -> CondT FileEntry n b
hoist m a -> ResourceT m a
forall a. m a -> ResourceT m a
forall (m :: * -> *) a. Monad m => m a -> ResourceT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift CondT FileEntry m a
predicate) ConduitT () (FileEntry, a) (ResourceT m) ()
-> ConduitT (FileEntry, a) Void (ResourceT m) ()
-> ConduitT () Void (ResourceT m) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT (FileEntry, a) Void (ResourceT m) ()
forall (m :: * -> *) i o. Monad m => ConduitT i o m ()
DCL.sinkNull

-- | A simpler version of 'findFiles', which yields only 'FilePath' values,
--   and ignores any values returned by the predicate action.
findFilePaths :: (MonadIO m, MonadResource m)
              => FindOptions
              -> FilePath
              -> CondT FileEntry m a
              -> ConduitT i FilePath m ()
findFilePaths :: forall (m :: * -> *) a i.
(MonadIO m, MonadResource m) =>
FindOptions
-> FilePath -> CondT FileEntry m a -> ConduitT i FilePath m ()
findFilePaths FindOptions
opts FilePath
path CondT FileEntry m a
predicate =
    FindOptions
-> FilePath
-> CondT FileEntry m a
-> ConduitT i (FileEntry, a) m ()
forall (m :: * -> *) a i.
MonadResource m =>
FindOptions
-> FilePath
-> CondT FileEntry m a
-> ConduitT i (FileEntry, a) m ()
sourceFindFiles FindOptions
opts FilePath
path CondT FileEntry m a
predicate ConduitT i (FileEntry, a) m ()
-> ConduitT (FileEntry, a) FilePath m ()
-> ConduitT i FilePath m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ((FileEntry, a) -> FilePath)
-> ConduitT (FileEntry, a) FilePath m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
DCL.map (FileEntry -> FilePath
entryPath (FileEntry -> FilePath)
-> ((FileEntry, a) -> FileEntry) -> (FileEntry, a) -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileEntry, a) -> FileEntry
forall a b. (a, b) -> a
fst)

-- | Calls 'findFilePaths' with the default set of finding options.
--   Equivalent to @findFilePaths defaultFindOptions@.
find :: MonadResource m
     => FilePath -> CondT FileEntry m a -> DC.ConduitT i FilePath m ()
find :: forall (m :: * -> *) a i.
MonadResource m =>
FilePath -> CondT FileEntry m a -> ConduitT i FilePath m ()
find = FindOptions
-> FilePath -> CondT FileEntry m a -> ConduitT i FilePath m ()
forall (m :: * -> *) a i.
(MonadIO m, MonadResource m) =>
FindOptions
-> FilePath -> CondT FileEntry m a -> ConduitT i FilePath m ()
findFilePaths FindOptions
defaultFindOptions

-- | Test a file path using the same type of predicate that is accepted by
--   'findFiles'.
test :: MonadIO m => CondT FileEntry m () -> FilePath -> m Bool
test :: forall (m :: * -> *).
MonadIO m =>
CondT FileEntry m () -> FilePath -> m Bool
test CondT FileEntry m ()
matcher FilePath
path =
    FileEntry -> CondT FileEntry m () -> m Bool
forall (m :: * -> *) a b. Monad m => a -> CondT a m b -> m Bool
Cond.test (FilePath -> Int -> FindOptions -> FileEntry
newFileEntry FilePath
path Int
0 FindOptions
defaultFindOptions) CondT FileEntry m ()
matcher

-- | Test a file path using the same type of predicate that is accepted by
--   'findFiles', but do not follow symlinks.
ltest :: MonadIO m => CondT FileEntry m () -> FilePath -> m Bool
ltest :: forall (m :: * -> *).
MonadIO m =>
CondT FileEntry m () -> FilePath -> m Bool
ltest CondT FileEntry m ()
matcher FilePath
path =
    FileEntry -> CondT FileEntry m () -> m Bool
forall (m :: * -> *) a b. Monad m => a -> CondT a m b -> m Bool
Cond.test
        (FilePath -> Int -> FindOptions -> FileEntry
newFileEntry FilePath
path Int
0 FindOptions
defaultFindOptions
            { findFollowSymlinks = False })
        CondT FileEntry m ()
matcher