hsfm/src/IO/Error.hs

82 lines
1.8 KiB
Haskell

{-# OPTIONS_HADDOCK ignore-exports #-}
{-# LANGUAGE DeriveDataTypeable #-}
module IO.Error where
import Control.Exception
import Control.Monad
(
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)