LIB: add more useful pattern synonyms

src/Data/DirTree.hs

@@ -96,6 +96,7 @@ import System.FilePath
   , equalFilePath
   , isAbsolute
   , joinPath
+  , pathSeparator
   , splitDirectories
   , takeFileName
   , (</>)
@@ -287,6 +288,19 @@ sfile f@(Socket {})    = (True, f)
 sfile f                = (False, f)
 
 
+invalidFileName :: FileName -> (Bool, FileName)
+invalidFileName ""   = (True, "")
+invalidFileName "."  = (True, ".")
+invalidFileName ".." = (True, "..")
+invalidFileName fn   = (elem pathSeparator fn, fn)
+
+
+-- |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))
+
 -- |Matches on symlinks (pointing to anything) or regular files.
 pattern SARegFile <- (saregfile -> (True, _))
 pattern SRegFile  <- (sregfile  -> (True, _))

src/IO/File.hs

@@ -406,9 +406,7 @@ executeFile _ _      = return Nothing
 
 
 createFile :: AnchoredFile FileInfo -> FileName -> IO ()
-createFile _ ""   = return ()
-createFile _ "."  = return ()
-createFile _ ".." = return ()
+createFile _ InvFN = return ()
 createFile (SADir td) fn = do
   let fullp = fullPath td </> fn
   throwFileDoesExist fullp
@@ -417,13 +415,11 @@ createFile (SADir td) fn = do
 
 
 createDir :: AnchoredFile FileInfo -> FileName -> IO ()
-createDir _ ""   = return ()
-createDir _ "."  = return ()
-createDir _ ".." = return ()
-createDir (SADir td) fn = do
+createDir (SADir td) (ValFN fn) = do
   let fullp = fullPath td </> fn
   throwDirDoesExist fullp
   createDirectory fullp newFilePerms
+createDir _ _ = return ()
 
 
 
@@ -435,15 +431,13 @@ createDir (SADir td) fn = do
 
 renameFile :: AnchoredFile FileInfo -> FileName -> IO ()
 renameFile (_ :/ Failed {}) _ = return ()
-renameFile _ ""               = return ()
-renameFile _ "."              = return ()
-renameFile _ ".."             = return ()
-renameFile af fn = do
+renameFile af (ValFN fn) = do
   let fromf = fullPath af
       tof   = anchor af </> fn
   throwFileDoesExist tof
   throwSameFile fromf tof
   rename fromf tof
+renameFile _ _ = return ()