LIB: cleanup ViewPatterns/PatternSynonyms
This commit is contained in:
parent
4b68bf759b
commit
efd2535ef9
|
|
@ -232,6 +232,8 @@ data FileInfo = FileInfo {
|
|||
------------------------------------
|
||||
|
||||
|
||||
-- |Converts a viewpattern like function written for `File` to one
|
||||
-- for `AnchoredFile`.
|
||||
convertViewP :: (File FileInfo -> (Bool, File FileInfo))
|
||||
-> AnchoredFile FileInfo
|
||||
-> (Bool, AnchoredFile FileInfo)
|
||||
|
|
@ -240,9 +242,27 @@ convertViewP f af@(bp :/ constr) =
|
|||
in (b, bp :/ file)
|
||||
|
||||
|
||||
|
||||
---- Filetypes ----
|
||||
|
||||
|
||||
safileLike :: AnchoredFile FileInfo -> (Bool, AnchoredFile FileInfo)
|
||||
safileLike f = convertViewP sfileLike f
|
||||
|
||||
|
||||
sfileLike :: File FileInfo -> (Bool, File FileInfo)
|
||||
sfileLike f@RegFile{} = (True, f)
|
||||
sfileLike f@BlockDev{} = (True, f)
|
||||
sfileLike f@CharDev{} = (True, f)
|
||||
sfileLike f@NamedPipe{} = (True, f)
|
||||
sfileLike f@Socket{} = (True, f)
|
||||
sfileLike f = fileLikeSym f
|
||||
|
||||
|
||||
afileLike :: AnchoredFile FileInfo -> (Bool, AnchoredFile FileInfo)
|
||||
afileLike f@(bp :/ constr) = convertViewP fileLike f
|
||||
|
||||
|
||||
fileLike :: File FileInfo -> (Bool, File FileInfo)
|
||||
fileLike f@RegFile {} = (True, f)
|
||||
fileLike f@BlockDev{} = (True, f)
|
||||
|
|
@ -255,58 +275,38 @@ fileLike f = (False, f)
|
|||
sadir :: AnchoredFile FileInfo -> (Bool, AnchoredFile FileInfo)
|
||||
sadir f = convertViewP sdir f
|
||||
|
||||
|
||||
sdir :: File FileInfo -> (Bool, File FileInfo)
|
||||
sdir f@(SymLink { sdest = (_ :/ s@(SymLink {}) )})
|
||||
sdir f@SymLink{ sdest = (_ :/ s@SymLink{} )}
|
||||
-- we have to follow a chain of symlinks here, but
|
||||
-- return only the very first level
|
||||
-- TODO: this is probably obsolete now
|
||||
= case (sdir s) of
|
||||
(True, _) -> (True, f)
|
||||
_ -> (False, f)
|
||||
sdir f@(SymLink { sdest = (_ :/ Dir {} )})
|
||||
sdir f@SymLink{ sdest = (_ :/ Dir {} )}
|
||||
= (True, f)
|
||||
sdir f@(Dir {}) = (True, f)
|
||||
sdir f = (False, f)
|
||||
sdir f@Dir{} = (True, f)
|
||||
sdir f = (False, f)
|
||||
|
||||
|
||||
safileLike :: AnchoredFile FileInfo -> (Bool, AnchoredFile FileInfo)
|
||||
safileLike f = convertViewP sfileLike f
|
||||
-- |Matches on any non-directory kind of files, excluding symlinks.
|
||||
pattern AFileLike f <- (afileLike -> (True, f))
|
||||
-- |Like `AFileLike`, except on File.
|
||||
pattern FileLike f <- (fileLike -> (True, f))
|
||||
|
||||
sfileLike :: File FileInfo -> (Bool, File FileInfo)
|
||||
sfileLike f@RegFile{} = (True, f)
|
||||
sfileLike f@BlockDev{} = (True, f)
|
||||
sfileLike f@CharDev{} = (True, f)
|
||||
sfileLike f@NamedPipe{} = (True, f)
|
||||
sfileLike f@Socket{} = (True, f)
|
||||
sfileLike f = fileLikeSym f
|
||||
-- |Matches a list of directories or symlinks pointing to directories.
|
||||
pattern DirList fs <- (\fs -> (and . fmap (fst . sadir) $ fs, fs)
|
||||
-> (True, fs))
|
||||
|
||||
-- |Matches a list of any non-directory kind of files or symlinks
|
||||
-- pointing to such.
|
||||
pattern FileLikeList fs <- (\fs -> (and
|
||||
. fmap (fst . safileLike)
|
||||
$ fs, fs) -> (True, fs))
|
||||
|
||||
|
||||
afileLikeSym :: AnchoredFile FileInfo -> (Bool, AnchoredFile FileInfo)
|
||||
afileLikeSym f = convertViewP fileLikeSym f
|
||||
|
||||
fileLikeSym :: File FileInfo -> (Bool, File FileInfo)
|
||||
fileLikeSym f@(SymLink { sdest = (_ :/ s@(SymLink {}) )})
|
||||
= case (fileLikeSym s) of
|
||||
(True, _) -> (True, f)
|
||||
_ -> (False, f)
|
||||
fileLikeSym f@(SymLink { sdest = (_ :/ RegFile {} )}) = (True, f)
|
||||
fileLikeSym f@(SymLink { sdest = (_ :/ BlockDev {} )}) = (True, f)
|
||||
fileLikeSym f@(SymLink { sdest = (_ :/ CharDev {} )}) = (True, f)
|
||||
fileLikeSym f@(SymLink { sdest = (_ :/ NamedPipe {} )}) = (True, f)
|
||||
fileLikeSym f@(SymLink { sdest = (_ :/ Socket {} )}) = (True, f)
|
||||
fileLikeSym f = (False, f)
|
||||
|
||||
|
||||
adirSym :: AnchoredFile FileInfo -> (Bool, AnchoredFile FileInfo)
|
||||
adirSym f = convertViewP dirSym f
|
||||
|
||||
dirSym :: File FileInfo -> (Bool, File FileInfo)
|
||||
dirSym f@(SymLink { sdest = (_ :/ s@(SymLink {}) )})
|
||||
= case (dirSym s) of
|
||||
(True, _) -> (True, f)
|
||||
_ -> (False, f)
|
||||
dirSym f@(SymLink { sdest = (_ :/ Dir {} )}) = (True, f)
|
||||
dirSym f = (False, f)
|
||||
|
||||
---- Filenames ----
|
||||
|
||||
invalidFileName :: Path Fn -> (Bool, Path Fn)
|
||||
invalidFileName p@(Path "") = (True, p)
|
||||
|
|
@ -315,32 +315,79 @@ invalidFileName p@(Path "..") = (True, p)
|
|||
invalidFileName p@(Path fn) = (elem pathSeparator fn, p)
|
||||
|
||||
|
||||
abrokenSymlink :: AnchoredFile FileInfo -> (Bool, AnchoredFile FileInfo)
|
||||
abrokenSymlink f = convertViewP brokenSymlink f
|
||||
|
||||
brokenSymlink :: File FileInfo -> (Bool, File FileInfo)
|
||||
brokenSymlink f = (isBrokenSymlink f, f)
|
||||
|
||||
|
||||
-- |Matches on invalid filesnames, such as ".", ".." and anything
|
||||
-- that contains a path separator.
|
||||
pattern InvFN <- (invalidFileName -> (True,_))
|
||||
-- |Opposite of `InvFN`.
|
||||
pattern ValFN f <- (invalidFileName -> (False, f))
|
||||
|
||||
-- |Like `InvFN`, but for AnchoredFile.
|
||||
pattern AFileInvFN <- (fst . invalidFileName . name . file -> True)
|
||||
-- |Like `InvFN`, but for File.
|
||||
pattern FileInvFN <- (fst . invalidFileName . name -> True)
|
||||
|
||||
|
||||
---- Symlinks ----
|
||||
|
||||
abrokenSymlink :: AnchoredFile FileInfo -> (Bool, AnchoredFile FileInfo)
|
||||
abrokenSymlink f = convertViewP brokenSymlink f
|
||||
|
||||
|
||||
brokenSymlink :: File FileInfo -> (Bool, File FileInfo)
|
||||
brokenSymlink f = (isBrokenSymlink f, f)
|
||||
|
||||
|
||||
afileLikeSym :: AnchoredFile FileInfo -> (Bool, AnchoredFile FileInfo)
|
||||
afileLikeSym f = convertViewP fileLikeSym f
|
||||
|
||||
|
||||
fileLikeSym :: File FileInfo -> (Bool, File FileInfo)
|
||||
fileLikeSym f@SymLink{ sdest = (_ :/ s@SymLink{} )}
|
||||
= case (fileLikeSym s) of
|
||||
(True, _) -> (True, f)
|
||||
_ -> (False, f)
|
||||
fileLikeSym f@SymLink{ sdest = (_ :/ RegFile {} )} = (True, f)
|
||||
fileLikeSym f@SymLink{ sdest = (_ :/ BlockDev {} )} = (True, f)
|
||||
fileLikeSym f@SymLink{ sdest = (_ :/ CharDev {} )} = (True, f)
|
||||
fileLikeSym f@SymLink{ sdest = (_ :/ NamedPipe {} )} = (True, f)
|
||||
fileLikeSym f@SymLink{ sdest = (_ :/ Socket {} )} = (True, f)
|
||||
fileLikeSym f = (False, f)
|
||||
|
||||
|
||||
adirSym :: AnchoredFile FileInfo -> (Bool, AnchoredFile FileInfo)
|
||||
adirSym f = convertViewP dirSym f
|
||||
|
||||
|
||||
dirSym :: File FileInfo -> (Bool, File FileInfo)
|
||||
dirSym f@SymLink{ sdest = (_ :/ s@SymLink{} )}
|
||||
= case (dirSym s) of
|
||||
(True, _) -> (True, f)
|
||||
_ -> (False, f)
|
||||
dirSym f@SymLink{ sdest = (_ :/ Dir {} )} = (True, f)
|
||||
dirSym f = (False, f)
|
||||
|
||||
|
||||
-- |Matches on symlinks pointing to file-like files only.
|
||||
pattern AFileLikeSym f <- (afileLikeSym -> (True, f))
|
||||
-- |Like `AFileLikeSym`, except on File.
|
||||
pattern FileLikeSym f <- (fileLikeSym -> (True, f))
|
||||
|
||||
-- |Matches on broken symbolic links.
|
||||
pattern ABrokenSymlink f <- (abrokenSymlink -> (True, f))
|
||||
-- |Like `ABrokenSymlink`, except on File.
|
||||
pattern BrokenSymlink f <- (brokenSymlink -> (True, f))
|
||||
|
||||
-- |Matches on directories or symlinks pointing to directories.
|
||||
-- If the symlink is pointing to a symlink pointing to a directory, then
|
||||
-- it will return True, but also return the first element in the symlink-
|
||||
-- chain, not the last.
|
||||
pattern ADirOrSym f <- (sadir -> (True, f))
|
||||
-- |Like `ADirOrSym`, except on File.
|
||||
pattern DirOrSym f <- (sdir -> (True, f))
|
||||
|
||||
-- |Matches on symlinks pointing to directories only.
|
||||
pattern ADirSym f <- (adirSym -> (True, f))
|
||||
-- |Like `ADirSym`, except on File.
|
||||
pattern DirSym f <- (dirSym -> (True, f))
|
||||
|
||||
-- |Matches on any non-directory kind of files or symlinks pointing to
|
||||
|
|
@ -349,28 +396,9 @@ pattern DirSym f <- (dirSym -> (True, f))
|
|||
-- it will return True, but also return the first element in the symlink-
|
||||
-- chain, not the last.
|
||||
pattern AFileLikeOrSym f <- (safileLike -> (True, f))
|
||||
-- |Like `AFileLikeOrSym`, except on File.
|
||||
pattern FileLikeOrSym f <- (sfileLike -> (True, f))
|
||||
|
||||
-- |Matches on any non-directory kind of files, excluding symlinks.
|
||||
pattern AFileLike f <- (afileLike -> (True, f))
|
||||
pattern FileLike f <- (fileLike -> (True, f))
|
||||
|
||||
-- |Matches on symlinks pointing to file-like files only.
|
||||
pattern AFileLikeSym f <- (afileLikeSym -> (True, f))
|
||||
pattern FileLikeSym f <- (fileLikeSym -> (True, f))
|
||||
|
||||
-- |Matches on broken symbolic links.
|
||||
pattern ABrokenSymlink f <- (abrokenSymlink -> (True, f))
|
||||
pattern BrokenSymlink f <- (brokenSymlink -> (True, f))
|
||||
|
||||
-- |Matches a list of directories or symlinks pointing to directories.
|
||||
pattern DirList fs <- (\fs -> (foldr (&&) True . fmap (fst . sadir) $ fs, fs)
|
||||
-> (True, fs))
|
||||
-- |Matches a list of any non-directory kind of files or symlinks
|
||||
-- pointing to such.
|
||||
pattern FileLikeList fs <- (\fs -> (foldr (&&) True
|
||||
. fmap (fst . safileLike)
|
||||
$ fs, fs) -> (True, fs))
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue