module GHC.Windows (
BOOL,
LPBOOL,
BYTE,
DWORD,
UINT,
ErrCode,
HANDLE,
LPWSTR,
LPTSTR,
iNFINITE,
iNVALID_HANDLE_VALUE,
throwGetLastError,
failWith,
getLastError,
getErrorMessage,
errCodeToIOError,
failIf,
failIf_,
failIfNull,
failIfZero,
failIfFalse_,
failUnlessSuccess,
failUnlessSuccessOr,
c_maperrno,
c_maperrno_func,
) where
import Data.Char
import Data.List
import Data.Maybe
import Data.Word
import Foreign.C.Error
import Foreign.C.String
import Foreign.C.Types
import Foreign.Ptr
import GHC.Base
import GHC.IO
import GHC.Num
import System.IO.Error
import qualified Numeric
#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
type BOOL = Bool
type LPBOOL = Ptr BOOL
type BYTE = Word8
type DWORD = Word32
type UINT = Word32
type ErrCode = DWORD
type HANDLE = Ptr ()
type LPWSTR = Ptr CWchar
type LPTSTR = LPWSTR
iNFINITE :: DWORD
iNFINITE = 0xFFFFFFFF
iNVALID_HANDLE_VALUE :: HANDLE
iNVALID_HANDLE_VALUE = wordPtrToPtr (1)
throwGetLastError :: String -> IO a
throwGetLastError where_from =
getLastError >>= failWith where_from
failWith :: String -> ErrCode -> IO a
failWith fn_name err_code =
errCodeToIOError fn_name err_code >>= throwIO
errCodeToIOError :: String -> ErrCode -> IO IOError
errCodeToIOError fn_name err_code = do
msg <- getErrorMessage err_code
let errno = c_maperrno_func err_code
let msg' = reverse $ dropWhile isSpace $ reverse msg
ioerror = errnoToIOError fn_name errno Nothing Nothing
`ioeSetErrorString` msg'
return ioerror
getErrorMessage :: ErrCode -> IO String
getErrorMessage err_code =
mask_ $ do
c_msg <- c_getErrorMessage err_code
if c_msg == nullPtr
then return $ "Error 0x" ++ Numeric.showHex err_code ""
else do msg <- peekCWString c_msg
_ <- localFree c_msg
return msg
failIf :: (a -> Bool) -> String -> IO a -> IO a
failIf p wh act = do
v <- act
if p v then throwGetLastError wh else return v
failIf_ :: (a -> Bool) -> String -> IO a -> IO ()
failIf_ p wh act = do
v <- act
if p v then throwGetLastError wh else return ()
failIfNull :: String -> IO (Ptr a) -> IO (Ptr a)
failIfNull = failIf (== nullPtr)
failIfZero :: (Eq a, Num a) => String -> IO a -> IO a
failIfZero = failIf (== 0)
failIfFalse_ :: String -> IO Bool -> IO ()
failIfFalse_ = failIf_ not
failUnlessSuccess :: String -> IO ErrCode -> IO ()
failUnlessSuccess fn_name act = do
r <- act
if r == 0 then return () else failWith fn_name r
failUnlessSuccessOr :: ErrCode -> String -> IO ErrCode -> IO Bool
failUnlessSuccessOr val fn_name act = do
r <- act
if r == 0 then return False
else if r == val then return True
else failWith fn_name r
foreign import ccall unsafe "maperrno"
c_maperrno :: IO ()
foreign import ccall unsafe "maperrno_func"
c_maperrno_func :: ErrCode -> Errno
foreign import ccall unsafe "base_getErrorMessage"
c_getErrorMessage :: DWORD -> IO LPWSTR
foreign import WINDOWS_CCONV unsafe "windows.h LocalFree"
localFree :: Ptr a -> IO (Ptr a)
foreign import WINDOWS_CCONV unsafe "windows.h GetLastError"
getLastError :: IO ErrCode