From efd2535ef9d49274c88d599b65d52998d5de3ec8 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Wed, 30 Mar 2016 19:38:06 +0200 Subject: [PATCH] LIB: cleanup ViewPatterns/PatternSynonyms --- src/Data/DirTree.hs | 162 ++++++++++++++++++++++++++------------------ 1 file changed, 95 insertions(+), 67 deletions(-) diff --git a/src/Data/DirTree.hs b/src/Data/DirTree.hs index 784525f..70d68e5 100644 --- a/src/Data/DirTree.hs +++ b/src/Data/DirTree.hs @@ -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))