LIB/GTK: refactor File API and add copyFile

src/IO/Error.hs

@@ -7,17 +7,75 @@ module IO.Error where
 import Control.Exception
 import Control.Monad
   (
-    mzero
-  , MonadPlus
+    unless
+  , void
+  , when
   )
 import Data.Typeable
+import System.Directory
+  (
+    doesDirectoryExist
+  , doesFileExist
+  )
+import System.FilePath
+  (
+    equalFilePath
+  , isAbsolute
+  , takeFileName
+  )
 
 
 data FmIOException = FileDoesNotExist String
                    | PathNotAbsolute String
                    | FileNotExecutable String
+                   | SameFile String String
+                   | NotAFile String
+                   | NotADir String
   deriving (Show, Typeable)
 
 
 instance Exception FmIOException
 
+
+-- Throws an exception if the filepath is not absolute
+-- or the file does not exist.
+fileSanityThrow :: FilePath -> IO ()
+fileSanityThrow fp = do
+  throwNotAbsolute fp
+  throwFileDoesNotExist fp
+
+
+-- Throws an exception if the filepath is not absolute
+-- or the dir does not exist.
+dirSanityThrow :: FilePath -> IO ()
+dirSanityThrow fp = do
+  throwNotAbsolute fp
+  throwDirDoesNotExist fp
+
+
+throwNotAbsolute :: FilePath -> IO ()
+throwNotAbsolute fp = unless (isAbsolute fp) (throw $ PathNotAbsolute fp)
+
+
+throwDirDoesExist :: FilePath -> IO ()
+throwDirDoesExist fp = do
+  exists <- doesDirectoryExist fp
+  when exists (throw $ FileDoesNotExist fp)
+
+
+throwDirDoesNotExist :: FilePath -> IO ()
+throwDirDoesNotExist fp = do
+  exists <- doesDirectoryExist fp
+  unless exists (throw $ FileDoesNotExist fp)
+
+
+throwFileDoesNotExist :: FilePath -> IO ()
+throwFileDoesNotExist fp = do
+  exists <- doesFileExist fp
+  unless exists (throw $ FileDoesNotExist fp)
+
+
+throwSameFile :: FilePath -- ^ should be canonicalized
+              -> FilePath -- ^ should be canonicalized
+              -> IO ()
+throwSameFile fp1 fp2 = when (equalFilePath fp1 fp2) (throw $ SameFile fp1 fp2)