LIB: cleanup ViewPatterns/PatternSynonyms

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@Dir{} = (True, f)
-sdir f          = (False, f)
+sdir f       = (False, f)
 
 
-safileLike :: AnchoredFile FileInfo -> (Bool, AnchoredFile FileInfo)
+-- |Matches on any non-directory kind of files, excluding symlinks.
-safileLike f = convertViewP sfileLike f
+pattern AFileLike f <- (afileLike -> (True, f))
+-- |Like `AFileLike`, except on File.
+pattern FileLike  f <- (fileLike  -> (True, f))
 
-sfileLike :: File FileInfo -> (Bool, File FileInfo)
+-- |Matches a list of directories or symlinks pointing to directories.
-sfileLike f@RegFile{}   = (True, f)
+pattern DirList fs <- (\fs -> (and . fmap (fst . sadir) $ fs, fs)
-sfileLike f@BlockDev{}  = (True, f)
+                                -> (True, fs))
-sfileLike f@CharDev{}   = (True, f)
+
-sfileLike f@NamedPipe{} = (True, f)
+-- |Matches a list of any non-directory kind of files or symlinks
-sfileLike f@Socket{}    = (True, f)
+-- pointing to such.
-sfileLike f             = fileLikeSym f
+pattern FileLikeList fs <- (\fs -> (and
+                                     . fmap (fst . safileLike)
+                                     $ fs, fs) -> (True, fs))
 
 
-afileLikeSym :: AnchoredFile FileInfo -> (Bool, AnchoredFile FileInfo)
+---- Filenames ----
-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)
-
 
 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))