{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module System.FilePath.Find (
FileInfo(..)
, FileType(..)
, FindClause
, FilterPredicate
, RecursionPredicate
, find
, fold
, findWithHandler
, foldWithHandler
, evalClause
, statusType
, liftOp
, filePath
, fileStatus
, depth
, fileInfo
, always
, extension
, directory
, fileName
, fileType
, contains
, deviceID
, fileID
, fileOwner
, fileGroup
, fileSize
, linkCount
, specialDeviceID
, fileMode
, accessTime
, modificationTime
, statusChangeTime
, filePerms
, anyPerms
, canonicalPath
, canonicalName
, readLink
, followStatus
, (~~?)
, (/~?)
, (==?)
, (/=?)
, (>?)
, (<?)
, (>=?)
, (<=?)
, (.&.?)
, (&&?)
, (||?)
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative)
#endif
import qualified Control.Exception as E
import Control.Exception (IOException, handle)
import Control.Monad (foldM, forM, liftM, liftM2)
import Control.Monad.State (State, evalState, get)
import Data.Bits (Bits, (.&.))
import Data.List (sort)
import System.Directory (getDirectoryContents, canonicalizePath)
import System.FilePath ((</>), takeDirectory, takeExtension, takeFileName)
import System.FilePath.GlobPattern (GlobPattern, (~~), (/~))
import System.IO (hPutStrLn, stderr)
import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO)
import qualified System.PosixCompat.Files as F
import qualified System.PosixCompat.Types as T
data FileInfo = FileInfo
{
FileInfo -> FilePath
infoPath :: FilePath
, FileInfo -> Int
infoDepth :: Int
, FileInfo -> FileStatus
infoStatus :: F.FileStatus
} deriving (FileInfo -> FileInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileInfo -> FileInfo -> Bool
$c/= :: FileInfo -> FileInfo -> Bool
== :: FileInfo -> FileInfo -> Bool
$c== :: FileInfo -> FileInfo -> Bool
Eq)
instance Eq F.FileStatus where
FileStatus
a == :: FileStatus -> FileStatus -> Bool
== FileStatus
b = FileStatus -> DeviceID
F.deviceID FileStatus
a forall a. Eq a => a -> a -> Bool
== FileStatus -> DeviceID
F.deviceID FileStatus
b Bool -> Bool -> Bool
&&
FileStatus -> FileID
F.fileID FileStatus
a forall a. Eq a => a -> a -> Bool
== FileStatus -> FileID
F.fileID FileStatus
b
mkFI :: FilePath -> Int -> F.FileStatus -> FileInfo
mkFI :: FilePath -> Int -> FileStatus -> FileInfo
mkFI = FilePath -> Int -> FileStatus -> FileInfo
FileInfo
newtype FindClause a = FC { forall a. FindClause a -> State FileInfo a
runFC :: State FileInfo a }
deriving (forall a b. a -> FindClause b -> FindClause a
forall a b. (a -> b) -> FindClause a -> FindClause b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> FindClause b -> FindClause a
$c<$ :: forall a b. a -> FindClause b -> FindClause a
fmap :: forall a b. (a -> b) -> FindClause a -> FindClause b
$cfmap :: forall a b. (a -> b) -> FindClause a -> FindClause b
Functor, Functor FindClause
forall a. a -> FindClause a
forall a b. FindClause a -> FindClause b -> FindClause a
forall a b. FindClause a -> FindClause b -> FindClause b
forall a b. FindClause (a -> b) -> FindClause a -> FindClause b
forall a b c.
(a -> b -> c) -> FindClause a -> FindClause b -> FindClause c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. FindClause a -> FindClause b -> FindClause a
$c<* :: forall a b. FindClause a -> FindClause b -> FindClause a
*> :: forall a b. FindClause a -> FindClause b -> FindClause b
$c*> :: forall a b. FindClause a -> FindClause b -> FindClause b
liftA2 :: forall a b c.
(a -> b -> c) -> FindClause a -> FindClause b -> FindClause c
$cliftA2 :: forall a b c.
(a -> b -> c) -> FindClause a -> FindClause b -> FindClause c
<*> :: forall a b. FindClause (a -> b) -> FindClause a -> FindClause b
$c<*> :: forall a b. FindClause (a -> b) -> FindClause a -> FindClause b
pure :: forall a. a -> FindClause a
$cpure :: forall a. a -> FindClause a
Applicative, Applicative FindClause
forall a. a -> FindClause a
forall a b. FindClause a -> FindClause b -> FindClause b
forall a b. FindClause a -> (a -> FindClause b) -> FindClause b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> FindClause a
$creturn :: forall a. a -> FindClause a
>> :: forall a b. FindClause a -> FindClause b -> FindClause b
$c>> :: forall a b. FindClause a -> FindClause b -> FindClause b
>>= :: forall a b. FindClause a -> (a -> FindClause b) -> FindClause b
$c>>= :: forall a b. FindClause a -> (a -> FindClause b) -> FindClause b
Monad)
evalClause :: FindClause a -> FileInfo -> a
evalClause :: forall a. FindClause a -> FileInfo -> a
evalClause = forall s a. State s a -> s -> a
evalState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FindClause a -> State FileInfo a
runFC
evalFI :: FindClause a
-> FilePath
-> Int
-> F.FileStatus
-> a
evalFI :: forall a. FindClause a -> FilePath -> Int -> FileStatus -> a
evalFI FindClause a
m FilePath
p Int
d FileStatus
s = forall a. FindClause a -> FileInfo -> a
evalClause FindClause a
m (FilePath -> Int -> FileStatus -> FileInfo
mkFI FilePath
p Int
d FileStatus
s)
fileInfo :: FindClause FileInfo
fileInfo :: FindClause FileInfo
fileInfo = forall a. State FileInfo a -> FindClause a
FC forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => m s
get
filePath :: FindClause FilePath
filePath :: FindClause FilePath
filePath = FileInfo -> FilePath
infoPath forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FindClause FileInfo
fileInfo
depth :: FindClause Int
depth :: FindClause Int
depth = FileInfo -> Int
infoDepth forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FindClause FileInfo
fileInfo
fileStatus :: FindClause F.FileStatus
fileStatus :: FindClause FileStatus
fileStatus = FileInfo -> FileStatus
infoStatus forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FindClause FileInfo
fileInfo
type FilterPredicate = FindClause Bool
type RecursionPredicate = FindClause Bool
getDirContents :: FilePath -> IO [FilePath]
getDirContents :: FilePath -> IO [FilePath]
getDirContents FilePath
dir = (forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
goodName) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir
where goodName :: FilePath -> Bool
goodName FilePath
"." = Bool
False
goodName FilePath
".." = Bool
False
goodName FilePath
_ = Bool
True
findWithHandler ::
(FilePath -> IOException -> IO [FilePath])
-> RecursionPredicate
-> FilterPredicate
-> FilePath
-> IO [FilePath]
findWithHandler :: (FilePath -> IOException -> IO [FilePath])
-> RecursionPredicate
-> RecursionPredicate
-> FilePath
-> IO [FilePath]
findWithHandler FilePath -> IOException -> IO [FilePath]
errHandler RecursionPredicate
recurse RecursionPredicate
filt FilePath
path0 =
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (FilePath -> IOException -> IO [FilePath]
errHandler FilePath
path0) forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileStatus
F.getSymbolicLinkStatus FilePath
path0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Int -> FileStatus -> IO [FilePath]
visit FilePath
path0 Int
0
where visit :: FilePath -> Int -> FileStatus -> IO [FilePath]
visit FilePath
path Int
depth FileStatus
st =
if FileStatus -> Bool
F.isDirectory FileStatus
st Bool -> Bool -> Bool
&& forall a. FindClause a -> FilePath -> Int -> FileStatus -> a
evalFI RecursionPredicate
recurse FilePath
path Int
depth FileStatus
st
then forall a. IO a -> IO a
unsafeInterleaveIO (FilePath -> Int -> FileStatus -> IO [FilePath]
traverse FilePath
path (forall a. Enum a => a -> a
succ Int
depth) FileStatus
st)
else forall {m :: * -> *}.
Monad m =>
FilePath -> Int -> FileStatus -> [FilePath] -> m [FilePath]
filterPath FilePath
path Int
depth FileStatus
st []
traverse :: FilePath -> Int -> FileStatus -> IO [FilePath]
traverse FilePath
dir Int
depth FileStatus
dirSt = do
[FilePath]
names <- forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (FilePath -> IO [FilePath]
getDirContents FilePath
dir) (FilePath -> IOException -> IO [FilePath]
errHandler FilePath
dir)
[[FilePath]]
filteredPaths <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
names forall a b. (a -> b) -> a -> b
$ \FilePath
name -> do
let path :: FilePath
path = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
name
forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (FilePath -> IOException -> IO [FilePath]
errHandler FilePath
path)
(FilePath -> IO FileStatus
F.getSymbolicLinkStatus FilePath
path forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Int -> FileStatus -> IO [FilePath]
visit FilePath
path Int
depth)
forall {m :: * -> *}.
Monad m =>
FilePath -> Int -> FileStatus -> [FilePath] -> m [FilePath]
filterPath FilePath
dir Int
depth FileStatus
dirSt (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath]]
filteredPaths)
filterPath :: FilePath -> Int -> FileStatus -> [FilePath] -> m [FilePath]
filterPath FilePath
path Int
depth FileStatus
st [FilePath]
result =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if forall a. FindClause a -> FilePath -> Int -> FileStatus -> a
evalFI RecursionPredicate
filt FilePath
path Int
depth FileStatus
st
then FilePath
pathforall a. a -> [a] -> [a]
:[FilePath]
result
else [FilePath]
result
find :: RecursionPredicate
-> FilterPredicate
-> FilePath
-> IO [FilePath]
find :: RecursionPredicate
-> RecursionPredicate -> FilePath -> IO [FilePath]
find = (FilePath -> IOException -> IO [FilePath])
-> RecursionPredicate
-> RecursionPredicate
-> FilePath
-> IO [FilePath]
findWithHandler forall {a} {a}. Show a => FilePath -> a -> IO [a]
warnOnError
where warnOnError :: FilePath -> a -> IO [a]
warnOnError FilePath
path a
err =
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath
path forall a. [a] -> [a] -> [a]
++ FilePath
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show a
err) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return []
foldWithHandler
:: (FilePath -> a -> IOException -> IO a)
-> RecursionPredicate
-> (a -> FileInfo -> a)
-> a
-> FilePath
-> IO a
foldWithHandler :: forall a.
(FilePath -> a -> IOException -> IO a)
-> RecursionPredicate
-> (a -> FileInfo -> a)
-> a
-> FilePath
-> IO a
foldWithHandler FilePath -> a -> IOException -> IO a
errHandler RecursionPredicate
recurse a -> FileInfo -> a
f a
state FilePath
path =
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (FilePath -> a -> IOException -> IO a
errHandler FilePath
path a
state) forall a b. (a -> b) -> a -> b
$
FilePath -> IO FileStatus
F.getSymbolicLinkStatus FilePath
path forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> FilePath -> Int -> FileStatus -> IO a
visit a
state FilePath
path Int
0
where visit :: a -> FilePath -> Int -> FileStatus -> IO a
visit a
state FilePath
path Int
depth FileStatus
st =
if FileStatus -> Bool
F.isDirectory FileStatus
st Bool -> Bool -> Bool
&& forall a. FindClause a -> FilePath -> Int -> FileStatus -> a
evalFI RecursionPredicate
recurse FilePath
path Int
depth FileStatus
st
then a -> FilePath -> Int -> FileStatus -> IO a
traverse a
state FilePath
path (forall a. Enum a => a -> a
succ Int
depth) FileStatus
st
else let state' :: a
state' = a -> FileInfo -> a
f a
state (FilePath -> Int -> FileStatus -> FileInfo
mkFI FilePath
path Int
depth FileStatus
st)
in a
state' seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. Monad m => a -> m a
return a
state'
traverse :: a -> FilePath -> Int -> FileStatus -> IO a
traverse a
state FilePath
dir Int
depth FileStatus
dirSt = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (FilePath -> a -> IOException -> IO a
errHandler FilePath
dir a
state) forall a b. (a -> b) -> a -> b
$
FilePath -> IO [FilePath]
getDirContents FilePath
dir forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
let state' :: a
state' = a -> FileInfo -> a
f a
state (FilePath -> Int -> FileStatus -> FileInfo
mkFI FilePath
dir Int
depth FileStatus
dirSt)
in a
state' seq :: forall a b. a -> b -> b
`seq` forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM a
state' (\a
state FilePath
name ->
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (FilePath -> a -> IOException -> IO a
errHandler FilePath
dir a
state) forall a b. (a -> b) -> a -> b
$
let path :: FilePath
path = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
name
in FilePath -> IO FileStatus
F.getSymbolicLinkStatus FilePath
path forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> FilePath -> Int -> FileStatus -> IO a
visit a
state FilePath
path Int
depth)
fold :: RecursionPredicate
-> (a -> FileInfo -> a)
-> a
-> FilePath
-> IO a
fold :: forall a.
RecursionPredicate -> (a -> FileInfo -> a) -> a -> FilePath -> IO a
fold = forall a.
(FilePath -> a -> IOException -> IO a)
-> RecursionPredicate
-> (a -> FileInfo -> a)
-> a
-> FilePath
-> IO a
foldWithHandler forall {a} {b}. Show a => FilePath -> b -> a -> IO b
warnOnError
where warnOnError :: FilePath -> b -> a -> IO b
warnOnError FilePath
path b
a a
err =
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath
path forall a. [a] -> [a] -> [a]
++ FilePath
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show a
err) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return b
a
always :: FindClause Bool
always :: RecursionPredicate
always = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
extension :: FindClause FilePath
extension :: FindClause FilePath
extension = FilePath -> FilePath
takeExtension forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FindClause FilePath
filePath
fileName :: FindClause FilePath
fileName :: FindClause FilePath
fileName = FilePath -> FilePath
takeFileName forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FindClause FilePath
filePath
directory :: FindClause FilePath
directory :: FindClause FilePath
directory = FilePath -> FilePath
takeDirectory forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FindClause FilePath
filePath
canonicalPath :: FindClause FilePath
canonicalPath :: FindClause FilePath
canonicalPath = (forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
canonicalizePath) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FindClause FilePath
filePath
canonicalName :: FindClause FilePath
canonicalName :: FindClause FilePath
canonicalName = FilePath -> FilePath
takeFileName forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FindClause FilePath
canonicalPath
withLink :: (FilePath -> IO a) -> FindClause (Maybe a)
withLink :: forall a. (FilePath -> IO a) -> FindClause (Maybe a)
withLink FilePath -> IO a
f = do
FilePath
path <- FindClause FilePath
filePath
FileStatus
st <- FindClause FileStatus
fileStatus
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if FileStatus -> Bool
F.isSymbolicLink FileStatus
st
then forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(IOException
_::IOException) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a
Just forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FilePath -> IO a
f FilePath
path
else forall a. Maybe a
Nothing
readLink :: FindClause (Maybe FilePath)
readLink :: FindClause (Maybe FilePath)
readLink = forall a. (FilePath -> IO a) -> FindClause (Maybe a)
withLink FilePath -> IO FilePath
F.readSymbolicLink
followStatus :: FindClause (Maybe F.FileStatus)
followStatus :: FindClause (Maybe FileStatus)
followStatus = forall a. (FilePath -> IO a) -> FindClause (Maybe a)
withLink FilePath -> IO FileStatus
F.getFileStatus
data FileType = BlockDevice
| CharacterDevice
| NamedPipe
| RegularFile
| Directory
| SymbolicLink
| Socket
| Unknown
deriving (FileType -> FileType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileType -> FileType -> Bool
$c/= :: FileType -> FileType -> Bool
== :: FileType -> FileType -> Bool
$c== :: FileType -> FileType -> Bool
Eq, Eq FileType
FileType -> FileType -> Bool
FileType -> FileType -> Ordering
FileType -> FileType -> FileType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FileType -> FileType -> FileType
$cmin :: FileType -> FileType -> FileType
max :: FileType -> FileType -> FileType
$cmax :: FileType -> FileType -> FileType
>= :: FileType -> FileType -> Bool
$c>= :: FileType -> FileType -> Bool
> :: FileType -> FileType -> Bool
$c> :: FileType -> FileType -> Bool
<= :: FileType -> FileType -> Bool
$c<= :: FileType -> FileType -> Bool
< :: FileType -> FileType -> Bool
$c< :: FileType -> FileType -> Bool
compare :: FileType -> FileType -> Ordering
$ccompare :: FileType -> FileType -> Ordering
Ord, Int -> FileType -> FilePath -> FilePath
[FileType] -> FilePath -> FilePath
FileType -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [FileType] -> FilePath -> FilePath
$cshowList :: [FileType] -> FilePath -> FilePath
show :: FileType -> FilePath
$cshow :: FileType -> FilePath
showsPrec :: Int -> FileType -> FilePath -> FilePath
$cshowsPrec :: Int -> FileType -> FilePath -> FilePath
Show)
fileType :: FindClause FileType
fileType :: FindClause FileType
fileType = FileStatus -> FileType
statusType forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FindClause FileStatus
fileStatus
statusType :: F.FileStatus -> FileType
statusType :: FileStatus -> FileType
statusType FileStatus
st | FileStatus -> Bool
F.isBlockDevice FileStatus
st = FileType
BlockDevice
statusType FileStatus
st | FileStatus -> Bool
F.isCharacterDevice FileStatus
st = FileType
CharacterDevice
statusType FileStatus
st | FileStatus -> Bool
F.isNamedPipe FileStatus
st = FileType
NamedPipe
statusType FileStatus
st | FileStatus -> Bool
F.isRegularFile FileStatus
st = FileType
RegularFile
statusType FileStatus
st | FileStatus -> Bool
F.isDirectory FileStatus
st = FileType
Directory
statusType FileStatus
st | FileStatus -> Bool
F.isSymbolicLink FileStatus
st = FileType
SymbolicLink
statusType FileStatus
st | FileStatus -> Bool
F.isSocket FileStatus
st = FileType
Socket
statusType FileStatus
_ = FileType
Unknown
deviceID :: FindClause T.DeviceID
deviceID :: FindClause DeviceID
deviceID = FileStatus -> DeviceID
F.deviceID forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FindClause FileStatus
fileStatus
fileID :: FindClause T.FileID
fileID :: FindClause FileID
fileID = FileStatus -> FileID
F.fileID forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FindClause FileStatus
fileStatus
fileOwner :: FindClause T.UserID
fileOwner :: FindClause UserID
fileOwner = FileStatus -> UserID
F.fileOwner forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FindClause FileStatus
fileStatus
fileGroup :: FindClause T.GroupID
fileGroup :: FindClause GroupID
fileGroup = FileStatus -> GroupID
F.fileGroup forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FindClause FileStatus
fileStatus
fileSize :: FindClause T.FileOffset
fileSize :: FindClause FileOffset
fileSize = FileStatus -> FileOffset
F.fileSize forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FindClause FileStatus
fileStatus
linkCount :: FindClause T.LinkCount
linkCount :: FindClause LinkCount
linkCount = FileStatus -> LinkCount
F.linkCount forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FindClause FileStatus
fileStatus
specialDeviceID :: FindClause T.DeviceID
specialDeviceID :: FindClause DeviceID
specialDeviceID = FileStatus -> DeviceID
F.specialDeviceID forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FindClause FileStatus
fileStatus
fileMode :: FindClause T.FileMode
fileMode :: FindClause FileMode
fileMode = FileStatus -> FileMode
F.fileMode forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FindClause FileStatus
fileStatus
filePerms :: FindClause T.FileMode
filePerms :: FindClause FileMode
filePerms = (forall a. Bits a => a -> a -> a
.&. FileMode
0777) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FindClause FileMode
fileMode
anyPerms :: T.FileMode
-> FindClause Bool
anyPerms :: FileMode -> RecursionPredicate
anyPerms FileMode
m = FindClause FileMode
filePerms forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FileMode
p -> forall (m :: * -> *) a. Monad m => a -> m a
return (FileMode
p forall a. Bits a => a -> a -> a
.&. FileMode
m forall a. Eq a => a -> a -> Bool
/= FileMode
0)
accessTime :: FindClause T.EpochTime
accessTime :: FindClause EpochTime
accessTime = FileStatus -> EpochTime
F.accessTime forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FindClause FileStatus
fileStatus
modificationTime :: FindClause T.EpochTime
modificationTime :: FindClause EpochTime
modificationTime = FileStatus -> EpochTime
F.modificationTime forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FindClause FileStatus
fileStatus
statusChangeTime :: FindClause T.EpochTime
statusChangeTime :: FindClause EpochTime
statusChangeTime = FileStatus -> EpochTime
F.statusChangeTime forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FindClause FileStatus
fileStatus
contains :: FilePath -> FindClause Bool
contains :: FilePath -> RecursionPredicate
contains FilePath
p = do
FilePath
d <- FindClause FilePath
filePath
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(IOException
_::IOException) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) forall a b. (a -> b) -> a -> b
$
FilePath -> IO FileStatus
F.getFileStatus (FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
p) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
liftOp :: Monad m => (a -> b -> c) -> m a -> b -> m c
liftOp :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> b -> m c
liftOp a -> b -> c
f m a
a b
b = m a
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a' -> forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b -> c
f a
a' b
b)
(~~?) :: FindClause FilePath -> GlobPattern -> FindClause Bool
~~? :: FindClause FilePath -> FilePath -> RecursionPredicate
(~~?) = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> b -> m c
liftOp FilePath -> FilePath -> Bool
(~~)
infix 4 ~~?
(/~?) :: FindClause FilePath -> GlobPattern -> FindClause Bool
/~? :: FindClause FilePath -> FilePath -> RecursionPredicate
(/~?) = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> b -> m c
liftOp FilePath -> FilePath -> Bool
(/~)
infix 4 /~?
(==?) :: Eq a => FindClause a -> a -> FindClause Bool
==? :: forall a. Eq a => FindClause a -> a -> RecursionPredicate
(==?) = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> b -> m c
liftOp forall a. Eq a => a -> a -> Bool
(==)
infix 4 ==?
(/=?) :: Eq a => FindClause a -> a -> FindClause Bool
/=? :: forall a. Eq a => FindClause a -> a -> RecursionPredicate
(/=?) = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> b -> m c
liftOp forall a. Eq a => a -> a -> Bool
(/=)
infix 4 /=?
(>?) :: Ord a => FindClause a -> a -> FindClause Bool
>? :: forall a. Ord a => FindClause a -> a -> RecursionPredicate
(>?) = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> b -> m c
liftOp forall a. Ord a => a -> a -> Bool
(>)
infix 4 >?
(<?) :: Ord a => FindClause a -> a -> FindClause Bool
<? :: forall a. Ord a => FindClause a -> a -> RecursionPredicate
(<?) = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> b -> m c
liftOp forall a. Ord a => a -> a -> Bool
(<)
infix 4 <?
(>=?) :: Ord a => FindClause a -> a -> FindClause Bool
>=? :: forall a. Ord a => FindClause a -> a -> RecursionPredicate
(>=?) = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> b -> m c
liftOp forall a. Ord a => a -> a -> Bool
(>=)
infix 4 >=?
(<=?) :: Ord a => FindClause a -> a -> FindClause Bool
<=? :: forall a. Ord a => FindClause a -> a -> RecursionPredicate
(<=?) = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> b -> m c
liftOp forall a. Ord a => a -> a -> Bool
(<=)
infix 4 <=?
(.&.?) :: Bits a => FindClause a -> a -> FindClause a
.&.? :: forall a. Bits a => FindClause a -> a -> FindClause a
(.&.?) = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> b -> m c
liftOp forall a. Bits a => a -> a -> a
(.&.)
infixl 7 .&.?
(&&?) :: FindClause Bool -> FindClause Bool -> FindClause Bool
&&? :: RecursionPredicate -> RecursionPredicate -> RecursionPredicate
(&&?) = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Bool -> Bool -> Bool
(&&)
infixr 3 &&?
(||?) :: FindClause Bool -> FindClause Bool -> FindClause Bool
||? :: RecursionPredicate -> RecursionPredicate -> RecursionPredicate
(||?) = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Bool -> Bool -> Bool
(||)
infixr 2 ||?