diff --git a/System/Windows/Error.hs b/System/Windows/Error.hs --- a/System/Windows/Error.hs +++ b/System/Windows/Error.hs @@ -1,6 +1,4 @@ {-# LANGUAGE CPP, DeriveDataTypeable, ForeignFunctionInterface #-} -{-# INCLUDE "HsWinError.h" #-} -{-# CFILES "cbits/HsWinError.c" #-} {- | Module : System.Windows.Error Copyright : 2008 Felix Martini @@ -8,7 +6,7 @@ Maintainer : fmartini@gmail.com Stability : Provisional - Portability : Portable + Portability : Non-portable (extended exceptions) Error handling for foreign calls to the Windows API. -} @@ -17,21 +15,15 @@ ( WinError(..), getWinError, getWinErrorMessage, - throwWinError, throwWinErrorIf, throwWinErrorIfFalse, throwWinErrorIfInvalidHandle, -#ifdef __GLASGOW_HASKELL__ - catchWinError, -#endif -- ** Common Windows error codes -- | If the error code that you need is not listed below you can create your -- own with the 'WinError' constructor and a numeric error code obtained from -- the MSDN documentation at --- . If you regularly --- use an error code please contact the maintainer of this package to have it --- included. +-- . errorSuccess, errorInvalidFunction, errorFileNotFound, errorPathNotFound, errorTooManyOpenFiles, errorAccessDenied, @@ -43,29 +35,22 @@ ) where -import Data.Word (Word32) -import Foreign.Ptr (Ptr) -import Foreign.C.String (CWString, peekCWString) -import System.IO.Error (mkIOError) +import Prelude hiding (catch) -#ifdef __GLASGOW_HASKELL__ -import GHC.IOBase (IOErrorType(DynIOError)) -import Data.Dynamic (fromDynamic, toDyn) -import Data.Typeable (Typeable) -import System.IO.Error (ioeGetErrorType) -#else -import System.IO.Error (userErrorType) -#endif +import Control.Exception (Exception, throwIO) +import Data.Typeable (Typeable) +import Data.Word (Word32) +import Foreign.Ptr (Ptr) +import Foreign.C.String (CWString, peekCWString) +-- | WinError is an exception that corresponds to a Windows error code. newtype WinError = WinError Word32 -#ifdef __GLASGOW_HASKELL__ deriving (Eq, Typeable) -#else - deriving Eq -#endif +instance Exception WinError + instance Show WinError where - show (WinError err) = "Windows error " ++ show err + showsPrec _ (WinError err) = showString "Windows error " . shows err -- | Get the current thread's last error code. Each OS thread maintains it's -- own last error code. @@ -84,107 +69,84 @@ c_LocalFree msg return str' --- | Throw an 'IOError' corresponding to the Windows error code. For GHC the --- IOError type is DynIOError WinError. For other compilers the IOError type --- is UserError. -throwWinError :: WinError -- ^ Windows error code - -> String -- ^ Textual description of the error location - -> IO a -throwWinError werr loc = do - str <- getWinErrorMessage werr - let loc' = loc ++ ": " ++ str ++ " (" ++ show werr ++ ")" -#ifdef __GLASGOW_HASKELL__ - let ioe = mkIOError (DynIOError (toDyn werr)) loc' Nothing Nothing -#else - let ioe = mkIOError userErrorType loc' Nothing Nothing -#endif - ioError ioe - -#ifdef __GLASGOW_HASKELL__ --- | Catch Windows errors. Other exceptions are not caught. Note that this --- function is available only for GHC. -catchWinError :: IO a -- ^ The 'IO' operation to be executed - -> (WinError -> IO a) -- ^ Exception handler - -> IO a -catchWinError act h = catch act handle - where handle ex = case ioeGetErrorType ex of - DynIOError dyn -> - case fromDynamic dyn of - Just err -> h err - _other -> ioError ex - _other -> ioError ex -#endif - --- | Throw an 'IOError' corresponding to the last error code --- if the result value of the 'IO' action meets the given predicate. +-- | Throw a 'WinError' exception corresponding to the last error code if the +-- result value of the 'IO' action meets the given predicate. throwWinErrorIf :: (a -> Bool) -- ^ Predicate to apply to the result value -- of the 'IO' operation - -> String -- ^ Textual description of the error location -> IO a -- ^ The 'IO' action to be executed -> IO a -throwWinErrorIf predicate loc act = do +throwWinErrorIf predicate act = do res <- act if predicate res then do err <- c_GetLastError - throwWinError (WinError err) loc + throwIO (WinError err) else return res --- | Throw an 'IOError' corresponding to the last error code if the result --- value of the 'IO' action is False. -throwWinErrorIfFalse :: String -- ^ Textual description of the error location - -> IO Bool -- ^ The 'IO' action to be executed +-- | Throw a 'WinError' exception corresponding to the last error code if the +-- result value of the 'IO' action is False. +throwWinErrorIfFalse :: IO Bool -- ^ The 'IO' action to be executed -> IO () -throwWinErrorIfFalse loc act = do +throwWinErrorIfFalse act = do res <- act if not res then do err <- c_GetLastError - throwWinError (WinError err) loc + throwIO (WinError err) else return () --- | Throw an 'IOError' corresponding to the last error code if the result --- value of the 'IO' action is an invalid handle. -throwWinErrorIfInvalidHandle :: String -- ^ Textual description of the - -- error location - -> IO (Ptr a) -- ^ The 'IO' action to be - -- executed +-- | Throw a 'WinError' exception corresponding to the last error code if +-- the result value of the 'IO' action is an invalid handle. +throwWinErrorIfInvalidHandle :: IO (Ptr a) -- ^ The 'IO' action to be + -- executed -> IO (Ptr a) -throwWinErrorIfInvalidHandle loc act = do +throwWinErrorIfInvalidHandle act = do res <- act if res == invalidHandleValue then do err <- c_GetLastError - throwWinError (WinError err) loc + throwIO (WinError err) else return res -- --------------------------------------------------------------------- -- Error codes -errorSuccess, errorInvalidFunction, errorFileNotFound, - errorPathNotFound, errorTooManyOpenFiles, errorAccessDenied, - errorInvalidHandle, errorArenaTrashed, errorNotEnoughMemory, - errorInvalidBlock, errorBadEnvironment, errorBadFormat, - errorInvalidAccess, errorInvalidData, errorOutOfMemory, - errorInvalidDrive, errorCurrentDirectory, errorNotReady, - errorHandleEOF :: WinError +errorSuccess :: WinError +errorInvalidFunction :: WinError +errorFileNotFound :: WinError +errorPathNotFound :: WinError +errorTooManyOpenFiles :: WinError +errorAccessDenied :: WinError +errorInvalidHandle :: WinError +errorArenaTrashed :: WinError +errorNotEnoughMemory :: WinError +errorInvalidBlock :: WinError +errorBadEnvironment :: WinError +errorBadFormat :: WinError +errorInvalidAccess :: WinError +errorInvalidData :: WinError +errorOutOfMemory :: WinError +errorInvalidDrive :: WinError +errorCurrentDirectory :: WinError +errorNotReady :: WinError +errorHandleEOF :: WinError -errorSuccess = WinError 0 -errorInvalidFunction = WinError 1 -errorFileNotFound = WinError 2 -errorPathNotFound = WinError 3 -errorTooManyOpenFiles = WinError 4 -errorAccessDenied = WinError 5 -errorInvalidHandle = WinError 6 -errorArenaTrashed = WinError 7 -errorNotEnoughMemory = WinError 8 -errorInvalidBlock = WinError 9 -errorBadEnvironment = WinError 10 -errorBadFormat = WinError 11 -errorInvalidAccess = WinError 12 -errorInvalidData = WinError 13 -errorOutOfMemory = WinError 14 -errorInvalidDrive = WinError 15 -errorCurrentDirectory = WinError 16 -errorNotReady = WinError 21 -errorHandleEOF = WinError 38 +errorSuccess = WinError 0 +errorInvalidFunction = WinError 1 +errorFileNotFound = WinError 2 +errorPathNotFound = WinError 3 +errorTooManyOpenFiles = WinError 4 +errorAccessDenied = WinError 5 +errorInvalidHandle = WinError 6 +errorArenaTrashed = WinError 7 +errorNotEnoughMemory = WinError 8 +errorInvalidBlock = WinError 9 +errorBadEnvironment = WinError 10 +errorBadFormat = WinError 11 +errorInvalidAccess = WinError 12 +errorInvalidData = WinError 13 +errorOutOfMemory = WinError 14 +errorInvalidDrive = WinError 15 +errorCurrentDirectory = WinError 16 +errorNotReady = WinError 21 +errorHandleEOF = WinError 38 -- --------------------------------------------------------------------- -- Foreign functions diff --git a/cbits/HsWinError.c b/cbits/HsWinError.c --- a/cbits/HsWinError.c +++ b/cbits/HsWinError.c @@ -1,6 +1,5 @@ #if (defined(_WIN32) || defined(__MINGW32__)) -#include "HsWinError.h" #include LPWSTR GetErrorMessageW(DWORD dwError) diff --git a/include/HsWinError.h b/include/HsWinError.h deleted file mode 100644 --- a/include/HsWinError.h +++ /dev/null @@ -1,12 +0,0 @@ -#if (defined(_WIN32) || defined(__MINGW32__)) - -#ifndef HSWINERROR_H -#define HSWINERROR_H - -#include - -LPWSTR GetErrorMessageW(DWORD dwError); -HANDLE invalidHandleValue(void); - -#endif -#endif diff --git a/winerror.cabal b/winerror.cabal --- a/winerror.cabal +++ b/winerror.cabal @@ -1,5 +1,5 @@ name: winerror -version: 0.1 +version: 1.0 copyright: 2008 Felix Martini license: BSD3 license-file: LICENSE @@ -7,15 +7,19 @@ stability: Provisional category: Foreign synopsis: Error handling for foreign calls to the Windows API. -tested-with: GHC == 6.8.2, Hugs == 2006-09 +description: A small library useful for error handling when making + foreign calls to the Windows API. Error codes set by + Windows are converted to Haskell exceptions and can be + thrown and caught with the usual exception handling + functions in Control.Exception. build-type: Simple cabal-version: >= 1.2 library if os(windows) - build-depends: base + build-depends: base >= 4.0.0.0 exposed-modules: System.Windows.Error - include-dirs: include c-sources: cbits/HsWinError.c - install-includes: HsWinError.h extensions: CPP + else + buildable: False