{-# 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
(FileInfo -> FileInfo -> Bool)
-> (FileInfo -> FileInfo -> Bool) -> Eq FileInfo
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 DeviceID -> DeviceID -> Bool
forall a. Eq a => a -> a -> Bool
== FileStatus -> DeviceID
F.deviceID FileStatus
b Bool -> Bool -> Bool
&&
FileStatus -> FileID
F.fileID FileStatus
a FileID -> FileID -> Bool
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 { FindClause a -> State FileInfo a
runFC :: State FileInfo a }
deriving (a -> FindClause b -> FindClause a
(a -> b) -> FindClause a -> FindClause b
(forall a b. (a -> b) -> FindClause a -> FindClause b)
-> (forall a b. a -> FindClause b -> FindClause a)
-> Functor FindClause
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
<$ :: a -> FindClause b -> FindClause a
$c<$ :: forall a b. a -> FindClause b -> FindClause a
fmap :: (a -> b) -> FindClause a -> FindClause b
$cfmap :: forall a b. (a -> b) -> FindClause a -> FindClause b
Functor, Functor FindClause
a -> FindClause a
Functor FindClause
-> (forall a. a -> FindClause a)
-> (forall a b.
FindClause (a -> b) -> FindClause a -> FindClause b)
-> (forall a b c.
(a -> b -> c) -> FindClause a -> FindClause b -> FindClause c)
-> (forall a b. FindClause a -> FindClause b -> FindClause b)
-> (forall a b. FindClause a -> FindClause b -> FindClause a)
-> Applicative FindClause
FindClause a -> FindClause b -> FindClause b
FindClause a -> FindClause b -> FindClause a
FindClause (a -> b) -> FindClause a -> FindClause b
(a -> b -> c) -> FindClause a -> FindClause b -> FindClause c
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
<* :: FindClause a -> FindClause b -> FindClause a
$c<* :: forall a b. FindClause a -> FindClause b -> FindClause a
*> :: FindClause a -> FindClause b -> FindClause b
$c*> :: forall a b. FindClause a -> FindClause b -> FindClause b
liftA2 :: (a -> b -> c) -> FindClause a -> FindClause b -> FindClause c
$cliftA2 :: forall a b c.
(a -> b -> c) -> FindClause a -> FindClause b -> FindClause c
<*> :: FindClause (a -> b) -> FindClause a -> FindClause b
$c<*> :: forall a b. FindClause (a -> b) -> FindClause a -> FindClause b
pure :: a -> FindClause a
$cpure :: forall a. a -> FindClause a
$cp1Applicative :: Functor FindClause
Applicative, Applicative FindClause
a -> FindClause a
Applicative FindClause
-> (forall a b.
FindClause a -> (a -> FindClause b) -> FindClause b)
-> (forall a b. FindClause a -> FindClause b -> FindClause b)
-> (forall a. a -> FindClause a)
-> Monad FindClause
FindClause a -> (a -> FindClause b) -> FindClause b
FindClause a -> FindClause b -> FindClause b
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 :: a -> FindClause a
$creturn :: forall a. a -> FindClause a
>> :: FindClause a -> FindClause b -> FindClause b
$c>> :: forall a b. FindClause a -> FindClause b -> FindClause b
>>= :: FindClause a -> (a -> FindClause b) -> FindClause b
$c>>= :: forall a b. FindClause a -> (a -> FindClause b) -> FindClause b
$cp1Monad :: Applicative FindClause
Monad)
evalClause :: FindClause a -> FileInfo -> a
evalClause :: FindClause a -> FileInfo -> a
evalClause = State FileInfo a -> FileInfo -> a
forall s a. State s a -> s -> a
evalState (State FileInfo a -> FileInfo -> a)
-> (FindClause a -> State FileInfo a)
-> FindClause a
-> FileInfo
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FindClause a -> State FileInfo a
forall a. FindClause a -> State FileInfo a
runFC
evalFI :: FindClause a
-> FilePath
-> Int
-> F.FileStatus
-> a
evalFI :: FindClause a -> FilePath -> Int -> FileStatus -> a
evalFI FindClause a
m FilePath
p Int
d FileStatus
s = FindClause a -> FileInfo -> a
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 = State FileInfo FileInfo -> FindClause FileInfo
forall a. State FileInfo a -> FindClause a
FC (State FileInfo FileInfo -> FindClause FileInfo)
-> State FileInfo FileInfo -> FindClause FileInfo
forall a b. (a -> b) -> a -> b
$ State FileInfo FileInfo
forall s (m :: * -> *). MonadState s m => m s
get
filePath :: FindClause FilePath
filePath :: FindClause FilePath
filePath = FileInfo -> FilePath
infoPath (FileInfo -> FilePath)
-> FindClause FileInfo -> FindClause FilePath
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 (FileInfo -> Int) -> FindClause FileInfo -> FindClause Int
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 (FileInfo -> FileStatus)
-> FindClause FileInfo -> FindClause FileStatus
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 = ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
goodName) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
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 =
(IOException -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (FilePath -> IOException -> IO [FilePath]
errHandler FilePath
path0) (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileStatus
F.getSymbolicLinkStatus FilePath
path0 IO FileStatus -> (FileStatus -> IO [FilePath]) -> IO [FilePath]
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
&& RecursionPredicate -> FilePath -> Int -> FileStatus -> Bool
forall a. FindClause a -> FilePath -> Int -> FileStatus -> a
evalFI RecursionPredicate
recurse FilePath
path Int
depth FileStatus
st
then IO [FilePath] -> IO [FilePath]
forall a. IO a -> IO a
unsafeInterleaveIO (FilePath -> Int -> FileStatus -> IO [FilePath]
traverse FilePath
path (Int -> Int
forall a. Enum a => a -> a
succ Int
depth) FileStatus
st)
else FilePath -> Int -> FileStatus -> [FilePath] -> IO [FilePath]
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 <- IO [FilePath] -> (IOException -> IO [FilePath]) -> IO [FilePath]
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 <- [FilePath] -> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
names ((FilePath -> IO [FilePath]) -> IO [[FilePath]])
-> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
forall a b. (a -> b) -> a -> b
$ \FilePath
name -> do
let path :: FilePath
path = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
name
IO [FilePath] -> IO [FilePath]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (IOException -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
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 IO FileStatus -> (FileStatus -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Int -> FileStatus -> IO [FilePath]
visit FilePath
path Int
depth)
FilePath -> Int -> FileStatus -> [FilePath] -> IO [FilePath]
forall (m :: * -> *).
Monad m =>
FilePath -> Int -> FileStatus -> [FilePath] -> m [FilePath]
filterPath FilePath
dir Int
depth FileStatus
dirSt ([[FilePath]] -> [FilePath]
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 =
[FilePath] -> m [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> m [FilePath]) -> [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ if RecursionPredicate -> FilePath -> Int -> FileStatus -> Bool
forall a. FindClause a -> FilePath -> Int -> FileStatus -> a
evalFI RecursionPredicate
filt FilePath
path Int
depth FileStatus
st
then FilePath
pathFilePath -> [FilePath] -> [FilePath]
forall 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 FilePath -> IOException -> IO [FilePath]
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 FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
err) IO () -> IO [a] -> IO [a]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
foldWithHandler
:: (FilePath -> a -> IOException -> IO a)
-> RecursionPredicate
-> (a -> FileInfo -> a)
-> a
-> FilePath
-> IO a
foldWithHandler :: (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 =
(IOException -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (FilePath -> a -> IOException -> IO a
errHandler FilePath
path a
state) (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$
FilePath -> IO FileStatus
F.getSymbolicLinkStatus FilePath
path IO FileStatus -> (FileStatus -> IO a) -> IO a
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
&& RecursionPredicate -> FilePath -> Int -> FileStatus -> 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 (Int -> Int
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' a -> IO a -> IO a
`seq` a -> IO a
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 = (IOException -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (FilePath -> a -> IOException -> IO a
errHandler FilePath
dir a
state) (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$
FilePath -> IO [FilePath]
getDirContents FilePath
dir IO [FilePath] -> ([FilePath] -> IO a) -> IO a
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' a -> ([FilePath] -> IO a) -> [FilePath] -> IO a
`seq` ((a -> FilePath -> IO a) -> a -> [FilePath] -> IO a)
-> a -> (a -> FilePath -> IO a) -> [FilePath] -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> FilePath -> IO a) -> a -> [FilePath] -> IO a
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 ->
(IOException -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (FilePath -> a -> IOException -> IO a
errHandler FilePath
dir a
state) (IO a -> IO a) -> IO a -> IO a
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 IO FileStatus -> (FileStatus -> IO a) -> IO a
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 :: RecursionPredicate -> (a -> FileInfo -> a) -> a -> FilePath -> IO a
fold = (FilePath -> a -> IOException -> IO a)
-> RecursionPredicate
-> (a -> FileInfo -> a)
-> a
-> FilePath
-> IO a
forall a.
(FilePath -> a -> IOException -> IO a)
-> RecursionPredicate
-> (a -> FileInfo -> a)
-> a
-> FilePath
-> IO a
foldWithHandler FilePath -> a -> IOException -> IO a
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 FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
err) IO () -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
a
always :: FindClause Bool
always :: RecursionPredicate
always = Bool -> RecursionPredicate
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
extension :: FindClause FilePath
extension :: FindClause FilePath
extension = FilePath -> FilePath
takeExtension (FilePath -> FilePath)
-> FindClause FilePath -> FindClause FilePath
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 (FilePath -> FilePath)
-> FindClause FilePath -> FindClause FilePath
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 (FilePath -> FilePath)
-> FindClause FilePath -> FindClause FilePath
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FindClause FilePath
filePath
canonicalPath :: FindClause FilePath
canonicalPath :: FindClause FilePath
canonicalPath = (IO FilePath -> FilePath
forall a. IO a -> a
unsafePerformIO (IO FilePath -> FilePath)
-> (FilePath -> IO FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
canonicalizePath) (FilePath -> FilePath)
-> FindClause FilePath -> FindClause FilePath
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 (FilePath -> FilePath)
-> FindClause FilePath -> FindClause FilePath
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FindClause FilePath
canonicalPath
withLink :: (FilePath -> IO a) -> FindClause (Maybe a)
withLink :: (FilePath -> IO a) -> FindClause (Maybe a)
withLink FilePath -> IO a
f = do
FilePath
path <- FindClause FilePath
filePath
FileStatus
st <- FindClause FileStatus
fileStatus
Maybe a -> FindClause (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> FindClause (Maybe a))
-> Maybe a -> FindClause (Maybe a)
forall a b. (a -> b) -> a -> b
$ if FileStatus -> Bool
F.isSymbolicLink FileStatus
st
then IO (Maybe a) -> Maybe a
forall a. IO a -> a
unsafePerformIO (IO (Maybe a) -> Maybe a) -> IO (Maybe a) -> Maybe a
forall a b. (a -> b) -> a -> b
$ (IOException -> IO (Maybe a)) -> IO (Maybe a) -> IO (Maybe a)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(IOException
_::IOException) -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing) (IO (Maybe a) -> IO (Maybe a)) -> IO (Maybe a) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$
a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FilePath -> IO a
f FilePath
path
else Maybe a
forall a. Maybe a
Nothing
readLink :: FindClause (Maybe FilePath)
readLink :: FindClause (Maybe FilePath)
readLink = (FilePath -> IO FilePath) -> FindClause (Maybe FilePath)
forall a. (FilePath -> IO a) -> FindClause (Maybe a)
withLink FilePath -> IO FilePath
F.readSymbolicLink
followStatus :: FindClause (Maybe F.FileStatus)
followStatus :: FindClause (Maybe FileStatus)
followStatus = (FilePath -> IO FileStatus) -> FindClause (Maybe FileStatus)
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
(FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool) -> Eq FileType
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
Eq FileType
-> (FileType -> FileType -> Ordering)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> FileType)
-> (FileType -> FileType -> FileType)
-> Ord 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
$cp1Ord :: Eq FileType
Ord, Int -> FileType -> FilePath -> FilePath
[FileType] -> FilePath -> FilePath
FileType -> FilePath
(Int -> FileType -> FilePath -> FilePath)
-> (FileType -> FilePath)
-> ([FileType] -> FilePath -> FilePath)
-> Show FileType
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 (FileStatus -> FileType)
-> FindClause FileStatus -> FindClause FileType
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 (FileStatus -> DeviceID)
-> FindClause FileStatus -> FindClause 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 (FileStatus -> FileID)
-> FindClause FileStatus -> FindClause 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 (FileStatus -> UserID)
-> FindClause FileStatus -> FindClause UserID
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 (FileStatus -> GroupID)
-> FindClause FileStatus -> FindClause GroupID
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 (FileStatus -> FileOffset)
-> FindClause FileStatus -> FindClause FileOffset
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 (FileStatus -> LinkCount)
-> FindClause FileStatus -> FindClause 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 (FileStatus -> DeviceID)
-> FindClause FileStatus -> FindClause DeviceID
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 (FileStatus -> FileMode)
-> FindClause FileStatus -> FindClause 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 = (FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.&. FileMode
0777) (FileMode -> FileMode)
-> FindClause FileMode -> FindClause FileMode
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 FindClause FileMode
-> (FileMode -> RecursionPredicate) -> RecursionPredicate
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FileMode
p -> Bool -> RecursionPredicate
forall (m :: * -> *) a. Monad m => a -> m a
return (FileMode
p FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.&. FileMode
m FileMode -> FileMode -> Bool
forall a. Eq a => a -> a -> Bool
/= FileMode
0)
accessTime :: FindClause T.EpochTime
accessTime :: FindClause EpochTime
accessTime = FileStatus -> EpochTime
F.accessTime (FileStatus -> EpochTime)
-> FindClause FileStatus -> FindClause EpochTime
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 (FileStatus -> EpochTime)
-> FindClause FileStatus -> FindClause EpochTime
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 (FileStatus -> EpochTime)
-> FindClause FileStatus -> FindClause EpochTime
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
Bool -> RecursionPredicate
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> RecursionPredicate) -> Bool -> RecursionPredicate
forall a b. (a -> b) -> a -> b
$ IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
(IOException -> IO Bool) -> IO Bool -> IO Bool
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(IOException
_::IOException) -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$
FilePath -> IO FileStatus
F.getFileStatus (FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
p) IO FileStatus -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
liftOp :: Monad m => (a -> b -> c) -> m a -> b -> m c
liftOp :: (a -> b -> c) -> m a -> b -> m c
liftOp a -> b -> c
f m a
a b
b = m a
a m a -> (a -> m c) -> m c
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a' -> c -> m c
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
(~~?) = (FilePath -> FilePath -> 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
(/~?) = (FilePath -> FilePath -> 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
==? :: FindClause a -> a -> RecursionPredicate
(==?) = (a -> a -> Bool) -> FindClause a -> a -> RecursionPredicate
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> b -> m c
liftOp a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
infix 4 ==?
(/=?) :: Eq a => FindClause a -> a -> FindClause Bool
/=? :: FindClause a -> a -> RecursionPredicate
(/=?) = (a -> a -> Bool) -> FindClause a -> a -> RecursionPredicate
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> b -> m c
liftOp a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(/=)
infix 4 /=?
(>?) :: Ord a => FindClause a -> a -> FindClause Bool
>? :: FindClause a -> a -> RecursionPredicate
(>?) = (a -> a -> Bool) -> FindClause a -> a -> RecursionPredicate
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> b -> m c
liftOp a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>)
infix 4 >?
(<?) :: Ord a => FindClause a -> a -> FindClause Bool
<? :: FindClause a -> a -> RecursionPredicate
(<?) = (a -> a -> Bool) -> FindClause a -> a -> RecursionPredicate
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> b -> m c
liftOp a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)
infix 4 <?
(>=?) :: Ord a => FindClause a -> a -> FindClause Bool
>=? :: FindClause a -> a -> RecursionPredicate
(>=?) = (a -> a -> Bool) -> FindClause a -> a -> RecursionPredicate
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> b -> m c
liftOp a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=)
infix 4 >=?
(<=?) :: Ord a => FindClause a -> a -> FindClause Bool
<=? :: FindClause a -> a -> RecursionPredicate
(<=?) = (a -> a -> Bool) -> FindClause a -> a -> RecursionPredicate
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> b -> m c
liftOp a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
infix 4 <=?
(.&.?) :: Bits a => FindClause a -> a -> FindClause a
.&.? :: FindClause a -> a -> FindClause a
(.&.?) = (a -> a -> a) -> FindClause a -> a -> FindClause a
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> b -> m c
liftOp a -> a -> a
forall a. Bits a => a -> a -> a
(.&.)
infixl 7 .&.?
(&&?) :: FindClause Bool -> FindClause Bool -> FindClause Bool
&&? :: RecursionPredicate -> RecursionPredicate -> RecursionPredicate
(&&?) = (Bool -> Bool -> 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
(||?) = (Bool -> Bool -> 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 ||?