diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,25 +1,25 @@ -Copyright 2008 Felix Martini. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - 1. Redistributions of source code must retain the above copyright notice - this list of conditions and the following disclaimer. - 2. Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in the - documentation and/or other materials provided with the distribution. - 3. Neither the names of the copyright holders nor the names of the - contributors may be used to endorse or promote products derived from - this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE -LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -POSSIBILITY OF SUCH DAMAGE. +Copyright 2008 Felix Martini. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + 1. Redistributions of source code must retain the above copyright notice + this list of conditions and the following disclaimer. + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + 3. Neither the names of the copyright holders nor the names of the + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,4 +1,4 @@ -#!/usr/bin/env runhaskell - -import Distribution.Simple -main = defaultMain +#!/usr/bin/env runhaskell + +import Distribution.Simple +main = defaultMain diff --git a/System/Windows/Error.hs b/System/Windows/Error.hs --- a/System/Windows/Error.hs +++ b/System/Windows/Error.hs @@ -1,164 +1,167 @@ -{-# LANGUAGE CPP, DeriveDataTypeable, ForeignFunctionInterface #-} -{- | - Module : System.Windows.Error - Copyright : 2008 Felix Martini - License : BSD-style - - Maintainer : fmartini@gmail.com - Stability : Provisional - Portability : Non-portable (extended exceptions) - - Error handling for foreign calls to the Windows API. --} - -module System.Windows.Error - ( WinError(..), - getWinError, - getWinErrorMessage, - throwWinErrorIf, - throwWinErrorIfFalse, - throwWinErrorIfInvalidHandle, - --- ** 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 --- . - - errorSuccess, errorInvalidFunction, errorFileNotFound, - errorPathNotFound, errorTooManyOpenFiles, errorAccessDenied, - errorInvalidHandle, errorArenaTrashed, errorNotEnoughMemory, - errorInvalidBlock, errorBadEnvironment, errorBadFormat, - errorInvalidAccess, errorInvalidData, errorOutOfMemory, - errorInvalidDrive, errorCurrentDirectory, errorNotReady, - errorHandleEOF, - - ) where - -import Prelude hiding (catch) - -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 - deriving (Eq, Typeable) - -instance Exception WinError - -instance Show WinError where - 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. -getWinError :: IO WinError -getWinError = do - err <- c_GetLastError - return (WinError err) - --- | Get the error message corresponding to the error code. -getWinErrorMessage :: WinError -- ^ Windows error code - -> IO String -getWinErrorMessage (WinError err) = do - msg <- c_GetErrorMessage err - str <- peekCWString msg - let str' = (unwords . words) str - c_LocalFree msg - return str' - --- | 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 - -> IO a -- ^ The 'IO' action to be executed - -> IO a -throwWinErrorIf predicate act = do - res <- act - if predicate res - then do err <- c_GetLastError - throwIO (WinError err) - else return res - --- | 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 act = do - res <- act - if not res - then do err <- c_GetLastError - throwIO (WinError err) - else return () - --- | 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 act = do - res <- act - if res == invalidHandleValue - then do err <- c_GetLastError - throwIO (WinError err) - else return res - --- --------------------------------------------------------------------- --- Error codes - -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 - --- --------------------------------------------------------------------- --- Foreign functions - -foreign import stdcall unsafe "GetLastError" - c_GetLastError :: IO Word32 - -foreign import ccall unsafe "GetErrorMessageW" - c_GetErrorMessage :: Word32 -> IO CWString - -foreign import stdcall unsafe "LocalFree" - c_LocalFree :: Ptr a -> IO (Ptr a) - -foreign import ccall unsafe "invalidHandleValue" - invalidHandleValue :: Ptr a +{-# LANGUAGE CPP, DeriveDataTypeable, ForeignFunctionInterface #-} +{- | + Module : System.Windows.Error + Copyright : 2008 Felix Martini + License : BSD-style + + Maintainer : fmartini@gmail.com + Stability : Provisional + Portability : Non-portable (extended exceptions) + + Error handling for foreign calls to the Windows API. +-} + +module System.Windows.Error + ( WinError(..), + getWinError, + getWinErrorMessage, + throwWinErrorIf, + throwWinErrorIfFalse, + throwWinErrorIfInvalidHandle, + +-- ** 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 +-- . + + errorSuccess, errorInvalidFunction, errorFileNotFound, + errorPathNotFound, errorTooManyOpenFiles, errorAccessDenied, + errorInvalidHandle, errorArenaTrashed, errorNotEnoughMemory, + errorInvalidBlock, errorBadEnvironment, errorBadFormat, + errorInvalidAccess, errorInvalidData, errorOutOfMemory, + errorInvalidDrive, errorCurrentDirectory, errorNotReady, + errorHandleEOF, + + ) where + +import Prelude hiding (catch) + +import Control.Exception (Exception, throwIO) +import Data.Typeable (Typeable) +import Data.Word (Word32) +import Foreign.Ptr (Ptr) +import Foreign.C.String (CWString, peekCWString) +import System.IO.Unsafe (unsafePerformIO) + +-- | WinError is an exception that corresponds to a Windows error code. +newtype WinError = WinError Word32 + deriving (Eq, Typeable) + +instance Exception WinError + +instance Show WinError where + showsPrec _ e@(WinError err) = + showString "Windows error " . shows err . showString ": " . + showString (unsafePerformIO $ getWinErrorMessage e) + +-- | Get the current thread's last error code. Each OS thread maintains it's +-- own last error code. +getWinError :: IO WinError +getWinError = do + err <- c_GetLastError + return (WinError err) + +-- | Get the error message corresponding to the error code. +getWinErrorMessage :: WinError -- ^ Windows error code + -> IO String +getWinErrorMessage (WinError err) = do + msg <- c_GetErrorMessage err + str <- peekCWString msg + let str' = (unwords . words) str + c_LocalFree msg + return str' + +-- | 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 + -> IO a -- ^ The 'IO' action to be executed + -> IO a +throwWinErrorIf predicate act = do + res <- act + if predicate res + then do err <- c_GetLastError + throwIO (WinError err) + else return res + +-- | 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 act = do + res <- act + if not res + then do err <- c_GetLastError + throwIO (WinError err) + else return () + +-- | 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 act = do + res <- act + if res == invalidHandleValue + then do err <- c_GetLastError + throwIO (WinError err) + else return res + +-- --------------------------------------------------------------------- +-- Error codes + +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 + +-- --------------------------------------------------------------------- +-- Foreign functions + +foreign import stdcall unsafe "GetLastError" + c_GetLastError :: IO Word32 + +foreign import ccall unsafe "GetErrorMessageW" + c_GetErrorMessage :: Word32 -> IO CWString + +foreign import stdcall unsafe "LocalFree" + c_LocalFree :: Ptr a -> IO (Ptr a) + +foreign import ccall unsafe "invalidHandleValue" + invalidHandleValue :: Ptr a diff --git a/winerror.cabal b/winerror.cabal --- a/winerror.cabal +++ b/winerror.cabal @@ -1,25 +1,25 @@ -name: winerror -version: 1.0 -copyright: 2008 Felix Martini -license: BSD3 -license-file: LICENSE -maintainer: fmartini@gmail.com -stability: Provisional -category: Foreign -synopsis: Error handling for foreign calls to the Windows API. -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 >= 4.0.0.0 - exposed-modules: System.Windows.Error - c-sources: cbits/HsWinError.c - extensions: CPP - else - buildable: False +name: winerror +version: 1.0.1 +copyright: 2008 Felix Martini +license: BSD3 +license-file: LICENSE +maintainer: fmartini@gmail.com +stability: Provisional +category: Foreign +synopsis: Error handling for foreign calls to the Windows API. +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 >= 4.0.0.0 + exposed-modules: System.Windows.Error + c-sources: cbits/HsWinError.c + extensions: CPP + else + buildable: False