winerror (empty) → 0.1
raw patch · 6 files changed
+293/−0 lines, 6 filesdep +basesetup-changed
Dependencies added: base
Files
- LICENSE +25/−0
- Setup.hs +4/−0
- System/Windows/Error.hs +202/−0
- cbits/HsWinError.c +29/−0
- include/HsWinError.h +12/−0
- winerror.cabal +21/−0
+ LICENSE view
@@ -0,0 +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.
+ Setup.hs view
@@ -0,0 +1,4 @@+#!/usr/bin/env runhaskell++import Distribution.Simple+main = defaultMain
+ System/Windows/Error.hs view
@@ -0,0 +1,202 @@+{-# LANGUAGE CPP, DeriveDataTypeable, ForeignFunctionInterface #-}+{-# INCLUDE "HsWinError.h" #-}+{-# CFILES "cbits/HsWinError.c" #-}+{- |+ Module : System.Windows.Error+ Copyright : 2008 Felix Martini+ License : BSD-style++ Maintainer : fmartini@gmail.com+ Stability : Provisional+ Portability : Portable++ Error handling for foreign calls to the Windows API.+-}++module System.Windows.Error+ ( 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+-- <http://msdn2.microsoft.com/en-us/library/ms681381.aspx>. If you regularly+-- use an error code please contact the maintainer of this package to have it+-- included.++ errorSuccess, errorInvalidFunction, errorFileNotFound,+ errorPathNotFound, errorTooManyOpenFiles, errorAccessDenied,+ errorInvalidHandle, errorArenaTrashed, errorNotEnoughMemory,+ errorInvalidBlock, errorBadEnvironment, errorBadFormat,+ errorInvalidAccess, errorInvalidData, errorOutOfMemory,+ errorInvalidDrive, errorCurrentDirectory, errorNotReady,+ errorHandleEOF,++ ) where++import Data.Word (Word32)+import Foreign.Ptr (Ptr)+import Foreign.C.String (CWString, peekCWString)+import System.IO.Error (mkIOError)++#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++newtype WinError = WinError Word32+#ifdef __GLASGOW_HASKELL__+ deriving (Eq, Typeable)+#else+ deriving Eq+#endif++instance Show WinError where+ show (WinError err) = "Windows error " ++ show 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 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.+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+ res <- act+ if predicate res+ then do err <- c_GetLastError+ throwWinError (WinError err) loc+ 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+ -> IO ()+throwWinErrorIfFalse loc act = do+ res <- act+ if not res+ then do err <- c_GetLastError+ throwWinError (WinError err) loc+ 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+ -> IO (Ptr a)+throwWinErrorIfInvalidHandle loc act = do+ res <- act+ if res == invalidHandleValue+ then do err <- c_GetLastError+ throwWinError (WinError err) loc+ 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 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
+ cbits/HsWinError.c view
@@ -0,0 +1,29 @@+#if (defined(_WIN32) || defined(__MINGW32__))++#include "HsWinError.h"+#include <windows.h>++LPWSTR GetErrorMessageW(DWORD dwError)+{+ LPWSTR lpMsgBuf = NULL;+ DWORD res;++ res = FormatMessageW(+ FORMAT_MESSAGE_ALLOCATE_BUFFER | /* free buffer with LocalFree */+ FORMAT_MESSAGE_FROM_SYSTEM |+ FORMAT_MESSAGE_IGNORE_INSERTS,+ NULL,+ dwError,+ 0,+ (LPWSTR)&lpMsgBuf,+ 0,+ NULL);+ if (res == 0) {+ lpMsgBuf = (LPWSTR) L"[No description available]";+ }+ return lpMsgBuf;+}++HANDLE invalidHandleValue(void) {return INVALID_HANDLE_VALUE;}++#endif
+ include/HsWinError.h view
@@ -0,0 +1,12 @@+#if (defined(_WIN32) || defined(__MINGW32__))++#ifndef HSWINERROR_H+#define HSWINERROR_H++#include <windows.h>++LPWSTR GetErrorMessageW(DWORD dwError);+HANDLE invalidHandleValue(void);++#endif+#endif
+ winerror.cabal view
@@ -0,0 +1,21 @@+name: winerror+version: 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.+tested-with: GHC == 6.8.2, Hugs == 2006-09+build-type: Simple+cabal-version: >= 1.2++library+ if os(windows)+ build-depends: base+ exposed-modules: System.Windows.Error+ include-dirs: include+ c-sources: cbits/HsWinError.c+ install-includes: HsWinError.h+ extensions: CPP