Win32-errors 0.2.2.1 → 0.2.2.3

raw patch · 11 files changed

+500/−428 lines, 11 filesdep +QuickCheckdep +Win32-errorsdep +hspecdep ~Win32dep ~basedep ~template-haskellsetup-changednew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: QuickCheck, Win32-errors, hspec

Dependency ranges changed: Win32, base, template-haskell

API changes (from Hackage documentation)

Files

• ChangeLog +8/−1
• Setup.hs +2/−2
• System/Win32/Error.hs +40/−40
• System/Win32/Error/Foreign.hs +168/−168
• System/Win32/Error/Mapping.hs +49/−49
• System/Win32/Error/TH.hs +77/−65
• System/Win32/Error/Types.hs +81/−81
• Win32-errors.cabal +20/−6
• include/windows_cconv.h +16/−16
• test/ErrorSpec.hs +36/−0
• test/Spec.hs +3/−0

@@ -1,3 +1,11 @@+## 0.2.3
+
+* Support for GHC 8.2.x and GHC 8.4.x
+
+## 0.2.2
+
+* Support for GHC 8.0.x
+
 ## 0.2.1
 
 * Support for GHC 7.8.x
@@ -6,4 +14,3 @@ 
 * Add several additional error codes.
 * Update constraints on base package.
-

@@ -1,2 +1,2 @@-import Distribution.Simple
-main = defaultMain
+import Distribution.Simple+main = defaultMain

@@ -1,40 +1,40 @@-{-# LANGUAGE Trustworthy #-}
-{-# OPTIONS_GHC -fno-warn-unused-imports #-}
-
--- |
--- module: System.Win32.Error
--- copyright: (c) Michael Steele, 2014
--- license: BSD3
--- maintainer: mikesteele81@gmail.com
--- stability: experimental
--- portability: Windows
---
--- This package assumes that you will be using strict `T.Text` values for string
--- handling. Consider using the following language pragma and import
--- statements:
---
--- > {-# LANGUAGE OverloadedStrings #-}
--- >
--- > module Main where
--- >
--- > import Data.Text (Text)
--- > import qualified Data.Text as T
--- > import qualified Data.Text.Foreign as T
---
--- This module is intended to be imported qualified.
---
--- > import System.Win32.Errors (ErrCode, Win32Exception)
--- > import qualified System.Win32.Errors as E
---
--- See the 'Win32Exception' type's documentation for an instructions on
--- working with functions that may throw exceptions of this type.
-module System.Win32.Error
-  ( Win32Exception (..)
-  , tryWin32
-  , toDWORD
-  , fromDWORD
-  , ErrCode (..)
-  ) where
-
-import qualified Data.Text as T
-import System.Win32.Error.Types
+{-# LANGUAGE Trustworthy #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}++-- |+-- module: System.Win32.Error+-- copyright: (c) Michael Steele, 2014+-- license: BSD3+-- maintainer: mikesteele81@gmail.com+-- stability: experimental+-- portability: Windows+--+-- This package assumes that you will be using strict `T.Text` values for string+-- handling. Consider using the following language pragma and import+-- statements:+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > module Main where+-- >+-- > import Data.Text (Text)+-- > import qualified Data.Text as T+-- > import qualified Data.Text.Foreign as T+--+-- This module is intended to be imported qualified.+--+-- > import System.Win32.Errors (ErrCode, Win32Exception)+-- > import qualified System.Win32.Errors as E+--+-- See the 'Win32Exception' type's documentation for an instructions on+-- working with functions that may throw exceptions of this type.+module System.Win32.Error+  ( Win32Exception (..)+  , tryWin32+  , toDWORD+  , fromDWORD+  , ErrCode (..)+  ) where++import qualified Data.Text as T+import System.Win32.Error.Types

@@ -1,168 +1,168 @@-{-# LANGUAGE CPP #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE Trustworthy #-}
-
--- |
--- module: System.Win32.Error.Foreign
--- copyright: (c) Michael Steele, 2014
--- license: BSD3
--- maintainer: mikesteele81@gmail.com
--- stability: experimental
--- portability: Windows
---
--- This module provides functions which can be used as drop-in replacements
--- for Win32 when writing wrappers to foreign imports.
---
--- You will likely need to import modules from Win32 as well. To avoid
--- accidentally calling the standard error handling functions it's a good idea
--- to hide a few names:
---
--- > import qualified System.Win32.Error.Foreign as E
--- > import System.Win32 hiding (failIfFalse_, failIf, failUnlessSuccess, failWith)
---
--- Handling error conditions in Windows revolves around a thread-local
--- global variable representing the most recent error condition. Functions
--- indicate that an error occurred in various ways. The C++ programmer will
--- observe that a function failed, and immediately call GetLastError to
--- retrieve details on the possible cause or to get a localized error message
--- which can be relayed to a human in some way.
---
--- There are some cases where an error code may mean different things
--- depending on varying context, but in general these codes are globally
--- unique. Microsoft documents which error codes may be expected for any
--- given function.
---
--- When working with functions exported by Win32, error conditions are dealt
--- with using the `IOError` exception type. Most native Win32 functions return
--- an error code which can be used to determine whether something went wrong
--- during its execution. By convention these functions are all named something
--- of the form "c_DoSomething" where "DoSomething" matches the name given by
--- Microsoft. A haskell wrapper function named "doSomething" will typically,
--- among other things, check this error code. Based on its value the operating
--- system will be queried for additional error information, and a Haskell
--- exception will be thrown.
---
--- Consider the `System.Win32.File.createFile` function used to
--- open existing files which may or may not actually exist.
---
--- > createFile "c:\\nofilehere.txt" gENERIC_READ
--- >            fILE_SHARE_NONE Nothing oPEN_EXISTING 0 Nothing
---
--- If no file by that name exists the underlying `Win32.c_CreateFile` call will
--- return `Win32.iNVALID_HANDLE_VALUE`. This will result in an `IOError` exception
--- being thrown with a `String` value indicating the function and file name.
--- Internally, the `IOError` will also contain the error code, which will be
--- converted to a general Haskell value.
---
--- The Win32-errors package works similarly. A (simplified) wrapper around
--- c_CreateFile could be written as follows. Source code
--- from the Win32 package often provides a good starting point:
---
--- > createFile name access mode = withTString name $ \ c_name ->
--- >     E.failIf (== E.toDWORD E.InvalidHandle) "CreateFile" $
--- >     c_CreateFile c_name access fILE_SHARE_NONE nullPtr
--- >                  mode 0 nullPtr
---
-module System.Win32.Error.Foreign
-  ( failIf
-  , failIfFalse_
-  , failIfNull
-  , failUnlessSuccess
-  , failWith
-  , errorWin
-  ) where
-
-import Control.Exception
-import Data.Char
-import Data.Text as T
-import Data.Text.Foreign as T
-import Foreign
-import Numeric
-import System.Win32 (DWORD, LPTSTR)
-import qualified System.Win32 as Win32
-
-import System.Win32.Error.Types
-
-#include "windows_cconv.h"
-
--- |This function mirrors the Win32 package's 'System.Win32.Types.failIfFalse_'
--- function.
-failIfFalse_ :: Text -> IO Bool -> IO ()
-failIfFalse_ wh act = failIf not wh act >> return ()
-
--- |Copied from the Win32 package. Use this to throw a Win32 exception
--- when an action returns a value satisfying the given predicate.
--- The exception thrown will depend on a thead-local global error condition.
--- The supplied `Text` value should be set to the human-friendly name of the
--- action that triggered the error.
-failIf :: (a -> Bool) -> Text -> IO a -> IO a
-failIf p wh act = do
-    v <- act
-    if p v then errorWin wh else return v
-
--- |This function mirrors the Win32 package's 'System.Win32.Types.failIfNull'
--- function.
-failIfNull :: Text -> IO (Ptr a) -> IO (Ptr a)
-failIfNull = failIf (== nullPtr)
-
--- |Perform the supplied action, and throw a `Win32Exception` exception if the
--- return code is anything other than `Success`. The supplied action returns
--- a `DWORD` instead of an `ErrCode` so that foreign imports can be used more
--- conveniently.
-failUnlessSuccess :: Text -> IO DWORD -> IO ()
-failUnlessSuccess fn_name act = do
-    r <- act
-    if r == toDWORD Success then return () else failWith' fn_name r
-
--- |Windows maintains a thread-local value representing the previously triggered
--- error code. Calling `errorWin` will look up the value, and throw a `Win32Exception`
--- exception. The supplied `Text` argument should be set to the name of the function
--- which triggered the error condition.
---
--- Calling this action when no error has occurred (0x00000000 -- ERROR_SUCCESS) will
--- result in an exception being thrown for the `Success` error code.
-errorWin :: Text -> IO a
-errorWin fn_name = Win32.getLastError >>= failWith' fn_name
-
--- |Like failWith, but avoid multiple conversions to and from 'ErrCode'.
-failWith' :: Text -> DWORD -> IO a
-failWith' fn_name err_code = do
-    msg <- formatMessage err_code
-    -- drop trailing \n
-    let msg' = T.reverse . T.dropWhile isSpace . T.reverse $ msg
-    throw $ Win32Exception fn_name (fromDWORD err_code) msg'
-
--- |Throw a `Win32Exception` exception for the given function name and error code.
-failWith :: Text -> ErrCode -> IO a
-failWith fn_name err_code = failWith' fn_name $ toDWORD err_code
-
-#define FORMAT_MESSAGE_FROM_SYSTEM     0x00001000
-#define FORMAT_MESSAGE_ALLOCATE_BUFFER 0x00000100
-
--- |This function doesn't belong in Win32-errors, which is why it isn't
--- exported. FormatMessage is required to get the standard system message
--- associated with an error code.
-formatMessage :: DWORD -> IO Text
-formatMessage err =
-    -- Specifying FORMAT_MESSAGE_ALLOCATE_BUFFER changes the lpBuffer argument
-    -- to a pointer to LPTSTR
-    alloca $ \ ppBuffer -> do
-    len <- c_FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM .|. FORMAT_MESSAGE_ALLOCATE_BUFFER)
-                             nullPtr err 0 (castPtr ppBuffer) 0 nullPtr
-    pBuffer <- peek ppBuffer
-    if (len == 0 || pBuffer == nullPtr)
-       then return $ "Error 0x" `T.append` T.pack (Numeric.showHex err "")
-       else fromPtr pBuffer (fromIntegral len)
-
--- DWORD WINAPI FormatMessage(
---   _In_      DWORD dwFlags,
---   _In_opt_  LPCVOID lpSource,
---   _In_      DWORD dwMessageId,
---   _In_      DWORD dwLanguageId,
---   _Out_     LPTSTR lpBuffer,
---   _In_      DWORD nSize,
---   _In_opt_  va_list *Arguments
--- );
-foreign import WINDOWS_CCONV "Windows.h FormatMessageW"
-    c_FormatMessage :: DWORD -> Ptr () -> DWORD -> DWORD -> LPTSTR -> DWORD
-                    -> Ptr () -> IO DWORD
+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Trustworthy #-}++-- |+-- module: System.Win32.Error.Foreign+-- copyright: (c) Michael Steele, 2014+-- license: BSD3+-- maintainer: mikesteele81@gmail.com+-- stability: experimental+-- portability: Windows+--+-- This module provides functions which can be used as drop-in replacements+-- for Win32 when writing wrappers to foreign imports.+--+-- You will likely need to import modules from Win32 as well. To avoid+-- accidentally calling the standard error handling functions it's a good idea+-- to hide a few names:+--+-- > import qualified System.Win32.Error.Foreign as E+-- > import System.Win32 hiding (failIfFalse_, failIf, failUnlessSuccess, failWith)+--+-- Handling error conditions in Windows revolves around a thread-local+-- global variable representing the most recent error condition. Functions+-- indicate that an error occurred in various ways. The C++ programmer will+-- observe that a function failed, and immediately call GetLastError to+-- retrieve details on the possible cause or to get a localized error message+-- which can be relayed to a human in some way.+--+-- There are some cases where an error code may mean different things+-- depending on varying context, but in general these codes are globally+-- unique. Microsoft documents which error codes may be expected for any+-- given function.+--+-- When working with functions exported by Win32, error conditions are dealt+-- with using the `IOError` exception type. Most native Win32 functions return+-- an error code which can be used to determine whether something went wrong+-- during its execution. By convention these functions are all named something+-- of the form "c_DoSomething" where "DoSomething" matches the name given by+-- Microsoft. A haskell wrapper function named "doSomething" will typically,+-- among other things, check this error code. Based on its value the operating+-- system will be queried for additional error information, and a Haskell+-- exception will be thrown.+--+-- Consider the `System.Win32.File.createFile` function used to+-- open existing files which may or may not actually exist.+--+-- > createFile "c:\\nofilehere.txt" gENERIC_READ+-- >            fILE_SHARE_NONE Nothing oPEN_EXISTING 0 Nothing+--+-- If no file by that name exists the underlying `Win32.c_CreateFile` call will+-- return `Win32.iNVALID_HANDLE_VALUE`. This will result in an `IOError` exception+-- being thrown with a `String` value indicating the function and file name.+-- Internally, the `IOError` will also contain the error code, which will be+-- converted to a general Haskell value.+--+-- The Win32-errors package works similarly. A (simplified) wrapper around+-- c_CreateFile could be written as follows. Source code+-- from the Win32 package often provides a good starting point:+--+-- > createFile name access mode = withTString name $ \ c_name ->+-- >     E.failIf (== E.toDWORD E.InvalidHandle) "CreateFile" $+-- >     c_CreateFile c_name access fILE_SHARE_NONE nullPtr+-- >                  mode 0 nullPtr+--+module System.Win32.Error.Foreign+  ( failIf+  , failIfFalse_+  , failIfNull+  , failUnlessSuccess+  , failWith+  , errorWin+  ) where++import Control.Exception+import Data.Char+import Data.Text as T+import Data.Text.Foreign as T+import Foreign+import Numeric+import System.Win32 (DWORD, LPTSTR)+import qualified System.Win32 as Win32++import System.Win32.Error.Types++#include "windows_cconv.h"++-- |This function mirrors the Win32 package's 'System.Win32.Types.failIfFalse_'+-- function.+failIfFalse_ :: Text -> IO Bool -> IO ()+failIfFalse_ wh act = failIf not wh act >> return ()++-- |Copied from the Win32 package. Use this to throw a Win32 exception+-- when an action returns a value satisfying the given predicate.+-- The exception thrown will depend on a thead-local global error condition.+-- The supplied `Text` value should be set to the human-friendly name of the+-- action that triggered the error.+failIf :: (a -> Bool) -> Text -> IO a -> IO a+failIf p wh act = do+    v <- act+    if p v then errorWin wh else return v++-- |This function mirrors the Win32 package's 'System.Win32.Types.failIfNull'+-- function.+failIfNull :: Text -> IO (Ptr a) -> IO (Ptr a)+failIfNull = failIf (== nullPtr)++-- |Perform the supplied action, and throw a `Win32Exception` exception if the+-- return code is anything other than `Success`. The supplied action returns+-- a `DWORD` instead of an `ErrCode` so that foreign imports can be used more+-- conveniently.+failUnlessSuccess :: Text -> IO DWORD -> IO ()+failUnlessSuccess fn_name act = do+    r <- act+    if r == toDWORD Success then return () else failWith' fn_name r++-- |Windows maintains a thread-local value representing the previously triggered+-- error code. Calling `errorWin` will look up the value, and throw a `Win32Exception`+-- exception. The supplied `Text` argument should be set to the name of the function+-- which triggered the error condition.+--+-- Calling this action when no error has occurred (0x00000000 -- ERROR_SUCCESS) will+-- result in an exception being thrown for the `Success` error code.+errorWin :: Text -> IO a+errorWin fn_name = Win32.getLastError >>= failWith' fn_name++-- |Like failWith, but avoid multiple conversions to and from 'ErrCode'.+failWith' :: Text -> DWORD -> IO a+failWith' fn_name err_code = do+    msg <- formatMessage err_code+    -- drop trailing \n+    let msg' = T.reverse . T.dropWhile isSpace . T.reverse $ msg+    throw $ Win32Exception fn_name (fromDWORD err_code) msg'++-- |Throw a `Win32Exception` exception for the given function name and error code.+failWith :: Text -> ErrCode -> IO a+failWith fn_name err_code = failWith' fn_name $ toDWORD err_code++#define FORMAT_MESSAGE_FROM_SYSTEM     0x00001000+#define FORMAT_MESSAGE_ALLOCATE_BUFFER 0x00000100++-- |This function doesn't belong in Win32-errors, which is why it isn't+-- exported. FormatMessage is required to get the standard system message+-- associated with an error code.+formatMessage :: DWORD -> IO Text+formatMessage err =+    -- Specifying FORMAT_MESSAGE_ALLOCATE_BUFFER changes the lpBuffer argument+    -- to a pointer to LPTSTR+    alloca $ \ ppBuffer -> do+    len <- c_FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM .|. FORMAT_MESSAGE_ALLOCATE_BUFFER)+                             nullPtr err 0 (castPtr ppBuffer) 0 nullPtr+    pBuffer <- peek ppBuffer+    if (len == 0 || pBuffer == nullPtr)+       then return $ "Error 0x" `T.append` T.pack (Numeric.showHex err "")+       else fromPtr pBuffer (fromIntegral len)++-- DWORD WINAPI FormatMessage(+--   _In_      DWORD dwFlags,+--   _In_opt_  LPCVOID lpSource,+--   _In_      DWORD dwMessageId,+--   _In_      DWORD dwLanguageId,+--   _Out_     LPTSTR lpBuffer,+--   _In_      DWORD nSize,+--   _In_opt_  va_list *Arguments+-- );+foreign import WINDOWS_CCONV "Windows.h FormatMessageW"+    c_FormatMessage :: DWORD -> Ptr () -> DWORD -> DWORD -> LPTSTR -> DWORD+                    -> Ptr () -> IO DWORD

@@ -1,49 +1,49 @@-module System.Win32.Error.Mapping
-  ( mapping
-  ) where
-
-import Language.Haskell.TH (mkName, Name)
-
-import System.Win32.Types (DWORD)
-
-mapping :: [(DWORD, Name)]
-mapping = map (fmap mkName) $
-    [ -- INVALID_HANDLE_VALUE is -1 for compatibility with 16-bit windows
-      (fromIntegral (-1 :: Int), "InvalidHandleValue")
-    , (0x00000000, "Success")
-    , (0x00000002, "FileNotFound")
-    , (0x00000003, "PathNotFound")
-    , (0x00000005, "AccessDenied")
-    , (0x00000006, "InvalidHandle")
-    , (0x0000000d, "InvalidData")
-    , (0x0000000f, "InvalidDrive")
-    , (0x00000010, "CurrentDirectory")
-    , (0x00000012, "NoMoreFiles")
-    , (0x00000078, "CallNotImplemented")
-    , (0x000000ea, "MoreData")
-    , (0x00000103, "NoMoreItems")
-    , (0x00000420, "ServiceAlreadyRunning")
-    , (0x00000422, "ServiceDisabled")
-    , (0x00000424, "ServiceDoesNotExist")
-    , (0x00000425, "ServiceCannotAcceptCtrl")
-    , (0x00000426, "ServiceNotActive")
-    , (0x00000427, "FailedServiceControllerConnect")
-    , (0x00000428, "ExceptionInService")
-    , (0x0000042a, "ServiceSpecificError")
-    , (0x0000043b, "ServiceNotInExe")
-    , (0x000006ba, "RPCSServerUnavailable")
-    , (0x000006bb, "RPCSServerTooBusy")
-    , (0x00001126, "NotAReparsePoint")
-    , (0x00004e25, "DhcpSubnetNotPresent")
-    , (0x00004e27, "DhcpElementCantRemove")
-    , (0x00004e2a, "DhcpOptionNotPresent")
-    , (0x00004e2d, "DhcpJetError")
-    , (0x00004e32, "DhcpNotReservedClient")
-    , (0x00004e33, "DhcpReservedClient")
-    , (0x00004e35, "DhcpIprangeExists")
-    , (0x00004e36, "DhcpReservedipExists")
-    , (0x00004e37, "DhcpInvalidRange")
-    , (0x00004e51, "DhcpIprangeConvIllegal")
-    , (0x00004e90, "ScopeRangePolicyRangeConflict")
-    , (0x00004ea1, "DhcpFoIprangeTypeConvIllegal")
-    ]
+module System.Win32.Error.Mapping+  ( mapping+  ) where++import Language.Haskell.TH (mkName, Name)++import System.Win32.Types (DWORD)++mapping :: [(DWORD, Name)]+mapping = map (fmap mkName) $+    [ -- INVALID_HANDLE_VALUE is -1 for compatibility with 16-bit windows+      (fromIntegral (-1 :: Int), "InvalidHandleValue")+    , (0x00000000, "Success")+    , (0x00000002, "FileNotFound")+    , (0x00000003, "PathNotFound")+    , (0x00000005, "AccessDenied")+    , (0x00000006, "InvalidHandle")+    , (0x0000000d, "InvalidData")+    , (0x0000000f, "InvalidDrive")+    , (0x00000010, "CurrentDirectory")+    , (0x00000012, "NoMoreFiles")+    , (0x00000078, "CallNotImplemented")+    , (0x000000ea, "MoreData")+    , (0x00000103, "NoMoreItems")+    , (0x00000420, "ServiceAlreadyRunning")+    , (0x00000422, "ServiceDisabled")+    , (0x00000424, "ServiceDoesNotExist")+    , (0x00000425, "ServiceCannotAcceptCtrl")+    , (0x00000426, "ServiceNotActive")+    , (0x00000427, "FailedServiceControllerConnect")+    , (0x00000428, "ExceptionInService")+    , (0x0000042a, "ServiceSpecificError")+    , (0x0000043b, "ServiceNotInExe")+    , (0x000006ba, "RPCSServerUnavailable")+    , (0x000006bb, "RPCSServerTooBusy")+    , (0x00001126, "NotAReparsePoint")+    , (0x00004e25, "DhcpSubnetNotPresent")+    , (0x00004e27, "DhcpElementCantRemove")+    , (0x00004e2a, "DhcpOptionNotPresent")+    , (0x00004e2d, "DhcpJetError")+    , (0x00004e32, "DhcpNotReservedClient")+    , (0x00004e33, "DhcpReservedClient")+    , (0x00004e35, "DhcpIprangeExists")+    , (0x00004e36, "DhcpReservedipExists")+    , (0x00004e37, "DhcpInvalidRange")+    , (0x00004e51, "DhcpIprangeConvIllegal")+    , (0x00004e90, "ScopeRangePolicyRangeConflict")+    , (0x00004ea1, "DhcpFoIprangeTypeConvIllegal")+    ]

@@ -1,65 +1,77 @@-{-# LANGUAGE TemplateHaskell #-}
-
-module System.Win32.Error.TH
-  ( genErrCode
-  , gentoDWORD
-  , genfromDWORD
-  ) where
-
-import Language.Haskell.TH
-import System.Win32 (DWORD)
-
-import System.Win32.Error.Mapping
-
-errCode :: Name
-errCode = mkName "ErrCode"
-
-errOther :: Name
-errOther = mkName "Other"
-
--- |Given something like [(undefined, "Success")], the following will be produced:
---     data ErrCode
---         = Success
---         | Other !DWORD
---         deriving (Eq, Show)
-genErrCode :: Q [Dec]
-genErrCode = return [DataD [] errCode [] cons [''Eq, ''Show]]
-  where
-    con name = NormalC name []
-    cons = map (con . snd) mapping ++ [NormalC errOther [(IsStrict, ConT ''DWORD)]]
-
--- toDWORD :: ErrCode -> DWORD
--- toDWORD (ErrorOther x) = x
--- toDWORD errorSomethingElse = #
--- toDWORD errorSomethingElse = #
--- toDWORD errorSomethingElse = #
-gentoDWORD :: Q [Dec]
-gentoDWORD  = do
-    x <- newName "x"
-    return [ SigD toDWORD (AppT (AppT ArrowT (ConT errCode)) (ConT ''DWORD))
-           , FunD toDWORD $ Clause [ConP errOther [VarP x]] (NormalB (VarE x)) [] : map genClause mapping
-           ]
-  where
-    toDWORD = mkName "toDWORD"
-    genClause :: (DWORD, Name) -> Clause
-    genClause (dw, err) = Clause [ConP err []] (NormalB (LitE . litDWORD $ dw)) []
-
--- fromDWORD :: DWORD -> ErrCode
--- fromDWORD 0 = ErrorSuccess
--- fromDWORD # = ErrorSomethingElse
--- fromDWORD # = ErrorSomethingElse
--- fromDWORD # = ErrorSomethingElse
--- fromDWORD x = ErrorOther x
-genfromDWORD :: Q [Dec]
-genfromDWORD = do
-    x <- newName "x"
-    return [ SigD fromDWORD (AppT (AppT ArrowT (ConT ''DWORD)) (ConT errCode))
-           , FunD fromDWORD $ map genClause mapping ++ [Clause [VarP x] (NormalB (AppE (ConE errOther) (VarE x))) []]
-           ]
-  where
-    fromDWORD = mkName "fromDWORD"
-    genClause :: (DWORD, Name) -> Clause
-    genClause (dw, err) = Clause [LitP $ litDWORD dw] (NormalB (ConE  err)) []
-
-litDWORD :: DWORD -> Lit
-litDWORD = IntegerL . toInteger
+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}++module System.Win32.Error.TH+  ( genErrCode+  , gentoDWORD+  , genfromDWORD+  ) where++import Language.Haskell.TH+import System.Win32 (DWORD)++import System.Win32.Error.Mapping++errCode :: Name+errCode = mkName "ErrCode"++errOther :: Name+errOther = mkName "Other"++-- |Given something like [(undefined, "Success")], the following will be produced:+--     data ErrCode+--         = Success+--         | Other !DWORD+--         deriving (Eq, Show)+genErrCode :: Q [Dec]++#if MIN_VERSION_template_haskell(2,12,0)+genErrCode = return [DataD [] errCode []  Nothing cons [(DerivClause Nothing $ map ConT [''Eq, ''Show])]]+#elif MIN_VERSION_template_haskell(2,11,0)+genErrCode = return [DataD [] errCode []  Nothing cons (map ConT [''Eq, ''Show])]+#else+genErrCode = return [DataD [] errCode [] cons [''Eq, ''Show]]+#endif+  where+    con name = NormalC name []+#if __GLASGOW_HASKELL__ < 800+    cons = map (con . snd) mapping ++ [NormalC errOther [(IsStrict, ConT ''DWORD)]]+#else+    cons = map (con . snd) mapping ++ [NormalC errOther [(Bang NoSourceUnpackedness SourceStrict, ConT ''DWORD)]]+#endif++-- toDWORD :: ErrCode -> DWORD+-- toDWORD (ErrorOther x) = x+-- toDWORD errorSomethingElse = #+-- toDWORD errorSomethingElse = #+-- toDWORD errorSomethingElse = #+gentoDWORD :: Q [Dec]+gentoDWORD  = do+    x <- newName "x"+    return [ SigD toDWORD (AppT (AppT ArrowT (ConT errCode)) (ConT ''DWORD))+           , FunD toDWORD $ Clause [ConP errOther [VarP x]] (NormalB (VarE x)) [] : map genClause mapping+           ]+  where+    toDWORD = mkName "toDWORD"+    genClause :: (DWORD, Name) -> Clause+    genClause (dw, err) = Clause [ConP err []] (NormalB (LitE . litDWORD $ dw)) []++-- fromDWORD :: DWORD -> ErrCode+-- fromDWORD 0 = ErrorSuccess+-- fromDWORD # = ErrorSomethingElse+-- fromDWORD # = ErrorSomethingElse+-- fromDWORD # = ErrorSomethingElse+-- fromDWORD x = ErrorOther x+genfromDWORD :: Q [Dec]+genfromDWORD = do+    x <- newName "x"+    return [ SigD fromDWORD (AppT (AppT ArrowT (ConT ''DWORD)) (ConT errCode))+           , FunD fromDWORD $ map genClause mapping ++ [Clause [VarP x] (NormalB (AppE (ConE errOther) (VarE x))) []]+           ]+  where+    fromDWORD = mkName "fromDWORD"+    genClause :: (DWORD, Name) -> Clause+    genClause (dw, err) = Clause [LitP $ litDWORD dw] (NormalB (ConE  err)) []++litDWORD :: DWORD -> Lit+litDWORD = IntegerL . toInteger

@@ -1,81 +1,81 @@-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE TemplateHaskell #-}
-
-module System.Win32.Error.Types where
-
-import Control.Exception
-import Data.Text
-import Data.Typeable
-import Foreign
-import System.Win32.Types (DWORD)
-
-import System.Win32.Error.TH
-
--- |Win32 actions typically return an error code to indicate success or failure.
--- These codes are intended to be globally unique, though there may be some overlap.
--- MSDN documents which errors may be returned by any given action.
---
--- The naming of errors follows a convention. An error such as ERROR_SUCCESS
--- becomes `Success`, ERROR_FILE_NOT_FOUND becomes `FileNotFound`, and so
--- on. There are thousands of errors, so it would be impractical to add them
--- all. The `Other` constructor is used to represent error codes which are not
--- handled specifically.
---
--- User's of this library are encouraged to submit new error codes. Add new entries to
--- System.Win32.Errors.Mapping. Send your pull requests along with a link to relevent
--- documentation to
--- <https://github.com/mikesteele81/Win32-errors.git https://github.com/mikesteele81/Win32-errors.git>.
-genErrCode
-
--- |Convert an `ErrCode` into a `DWORD`.
-gentoDWORD
-
--- |Convert a `DWORD` into an `ErrCode`. Values which don't have a
--- corresponding constructor will end up becoming an `Other`.
-genfromDWORD
-
--- |Performs marshalling by converting to and from `DWORD`.
-instance Storable ErrCode where
-  sizeOf _ = sizeOf (undefined :: DWORD)
-  alignment _ = alignment (undefined :: DWORD)
-  peek ptr = (peek . castPtr) ptr >>= return . fromDWORD
-  poke ptr ec = poke (castPtr ptr) (toDWORD ec)
-
--- |Exception type for Win32 errors.
---
--- This type will be thrown as an extensible exception when a foreign call out
--- to part of the Win32 indicates that an error has occurred. In most cases you
--- should wrap an IO computation in a call to `tryWin32`.
---
--- The following example uses the custom 'createFile' function described in
--- "System.Win32.Error.Foreign":
---
--- > eHandle <- do
--- >     h <- E.tryWin32 $ createFile "c:\\missing.txt" gENERIC_READ oPEN_EXISTING
--- >     -- perform other actions
--- >     return h
--- > case eHandle of
--- >   Right handle -> do
--- >     -- do something with the file handle
--- >   Left w32Err -> do
--- >     case E.errCode w32Err of
--- >       E.InvalidHandle -> do
--- >         -- perform cleanup
--- >       -- handle other error codes.
--- >     T.putStrLn $ E.systemMessage w32Err
-data Win32Exception = Win32Exception
-    { function :: Text
-    -- ^ The foreign action which triggered this exception.
-    , errCode  :: ErrCode
-    -- ^ The error code
-    , systemMessage :: Text
-    -- ^ The standard system message associated with the error code.
-    } deriving (Typeable, Show)
-
-instance Exception Win32Exception
-
--- |Actions calling out to Win32 may throw exceptions. Wrapping the action in
--- `tryWin32` will catch `Win32Exception` exceptions, but will allow any other
--- exception type to pass through.
-tryWin32 :: IO a -> IO (Either Win32Exception a)
-tryWin32 = try
+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TemplateHaskell #-}++module System.Win32.Error.Types where++import Control.Exception+import Data.Text+import Data.Typeable+import Foreign+import System.Win32.Types (DWORD)++import System.Win32.Error.TH++-- |Win32 actions typically return an error code to indicate success or failure.+-- These codes are intended to be globally unique, though there may be some overlap.+-- MSDN documents which errors may be returned by any given action.+--+-- The naming of errors follows a convention. An error such as ERROR_SUCCESS+-- becomes `Success`, ERROR_FILE_NOT_FOUND becomes `FileNotFound`, and so+-- on. There are thousands of errors, so it would be impractical to add them+-- all. The `Other` constructor is used to represent error codes which are not+-- handled specifically.+--+-- User's of this library are encouraged to submit new error codes. Add new entries to+-- System.Win32.Errors.Mapping. Send your pull requests along with a link to relevent+-- documentation to+-- <https://github.com/mikesteele81/Win32-errors.git https://github.com/mikesteele81/Win32-errors.git>.+genErrCode++-- |Convert an `ErrCode` into a `DWORD`.+gentoDWORD++-- |Convert a `DWORD` into an `ErrCode`. Values which don't have a+-- corresponding constructor will end up becoming an `Other`.+genfromDWORD++-- |Performs marshalling by converting to and from `DWORD`.+instance Storable ErrCode where+  sizeOf _ = sizeOf (undefined :: DWORD)+  alignment _ = alignment (undefined :: DWORD)+  peek ptr = (peek . castPtr) ptr >>= return . fromDWORD+  poke ptr ec = poke (castPtr ptr) (toDWORD ec)++-- |Exception type for Win32 errors.+--+-- This type will be thrown as an extensible exception when a foreign call out+-- to part of the Win32 indicates that an error has occurred. In most cases you+-- should wrap an IO computation in a call to `tryWin32`.+--+-- The following example uses the custom 'createFile' function described in+-- "System.Win32.Error.Foreign":+--+-- > eHandle <- do+-- >     h <- E.tryWin32 $ createFile "c:\\missing.txt" gENERIC_READ oPEN_EXISTING+-- >     -- perform other actions+-- >     return h+-- > case eHandle of+-- >   Right handle -> do+-- >     -- do something with the file handle+-- >   Left w32Err -> do+-- >     case E.errCode w32Err of+-- >       E.InvalidHandle -> do+-- >         -- perform cleanup+-- >       -- handle other error codes.+-- >     T.putStrLn $ E.systemMessage w32Err+data Win32Exception = Win32Exception+    { function :: Text+    -- ^ The foreign action which triggered this exception.+    , errCode  :: ErrCode+    -- ^ The error code+    , systemMessage :: Text+    -- ^ The standard system message associated with the error code.+    } deriving (Typeable, Show)++instance Exception Win32Exception++-- |Actions calling out to Win32 may throw exceptions. Wrapping the action in+-- `tryWin32` will catch `Win32Exception` exceptions, but will allow any other+-- exception type to pass through.+tryWin32 :: IO a -> IO (Either Win32Exception a)+tryWin32 = try

@@ -1,5 +1,5 @@ name:                Win32-errors-version:             0.2.2.1+version:             0.2.2.3 synopsis:            Alternative error handling for Win32 foreign calls description:     This package provides an alternative to the Win32 library's error handling@@ -18,23 +18,27 @@ copyright:     Michael Steele, 2014 - 2015 category:      System build-type:    Simple-cabal-version: >=1.16+cabal-version: 1.16 homepage:      http://github.com/mikesteele81/win32-errors bug-reports:   http://github.com/mikesteele81/win32-errors/issues-tested-with:   GHC == 7.8.3, GHC == 7.10.1+tested-with:   GHC == 8.0.1, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3 extra-source-files:     include/windows_cconv.h     ChangeLog +source-repository head+  type:     git+  location: http://github.com/mikesteele81/win32-errors+ library     default-language: Haskell2010     ghc-options: -Wall     cc-options:  -fno-strict-aliasing     build-depends:-          base             >= 4.6  && < 4.9-        , template-haskell >= 2.8  && < 2.11+          base             >= 4.6  && < 5.0+        , template-haskell >= 2.8  && < 2.14         , text             >= 0.11 && < 1.3-        , Win32            >= 2.2  && < 2.4+        , Win32            >= 2.2  && < 2.8     exposed-modules:         System.Win32.Error         System.Win32.Error.Foreign@@ -43,3 +47,13 @@         System.Win32.Error.TH         System.Win32.Error.Types     include-dirs: include++test-suite Win32-errors-test+  default-language:    Haskell2010+  ghc-options: -Wall+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  other-modules:       ErrorSpec+  main-is:             Spec.hs+  build-depends:+        base, hspec, QuickCheck, Win32-errors, Win32

@@ -1,16 +1,16 @@-/* Taken from Win32. 64-bit Windows uses the 'ccall' calling convention
-   instead of 'stdcall'
-*/
-
-#ifndef __WINDOWS_CCONV_H
-#define __WINDOWS_CCONV_H
-
-#if defined(i386_HOST_ARCH)
-# define WINDOWS_CCONV stdcall
-#elif defined(x86_64_HOST_ARCH)
-# define WINDOWS_CCONV ccall
-#else
-# error Unknown mingw32 arch
-#endif
-
-#endif
+/* Taken from Win32. 64-bit Windows uses the 'ccall' calling convention+   instead of 'stdcall'+*/++#ifndef __WINDOWS_CCONV_H+#define __WINDOWS_CCONV_H++#if defined(i386_HOST_ARCH)+# define WINDOWS_CCONV stdcall+#elif defined(x86_64_HOST_ARCH)+# define WINDOWS_CCONV ccall+#else+# error Unknown mingw32 arch+#endif++#endif

@@ -0,0 +1,36 @@+{-# LANGUAGE OverloadedStrings #-}
+
+module ErrorSpec where
+
+import Test.Hspec
+import Test.QuickCheck hiding (Success) -- Success is a constructor for ErrCode
+import System.Win32.Error (toDWORD, fromDWORD, ErrCode(..))
+
+-- I have made changes to TH.hs so I have made some simple tests for
+-- the parts generated by TH.hs: ErrCode, toDWORD and fromDWORD.
+
+-- errCode :: Win32Exception -> ErrCode
+-- toDWORD :: ErrCode -> DWORD
+-- fromDWORD :: DWORD -> ErrCode
+
+spec :: Spec
+spec = do
+  describe "TH.toDWORD" $ do
+    it "it converts an ErrorCode Success to DWORD 0" $ do
+      d <- return $ toDWORD Success
+      d `shouldBe` 0
+  describe "TH.toDWORD" $ do
+    it "it converts an ErrorCode AccessDenied to DWORD 5" $ do
+      d <- return $ toDWORD AccessDenied
+      d `shouldBe` 0x00000005
+  describe "TH.fromDWORD" $ do
+    it "it converts a DWORD 0 to a ErrorCode Success" $ do
+      e <- return $ fromDWORD 0
+      e `shouldBe` Success
+  describe "TH.fromDWORD" $ do
+    it "it converts a DWORD 99999 to a ErrorCode Other" $ do
+      e <- return $ fromDWORD 99999
+      e `shouldBe` Other 99999
+  describe "toDWORD and fromDWORD" $ do
+    it "are inverses i.e. toDWORD (fromDWORD d) == d" $ do
+       property $ \d -> toDWORD (fromDWORD d) == d

@@ -0,0 +1,3 @@+
+-- file test/Spec.hs
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}