content: {-# LANGUAGE Trustworthy #-}
  {-# LANGUAGE CPP #-}
  {-# LANGUAGE NoImplicitPrelude #-}
  
  -----------------------------------------------------------------------------
  -- |
  -- Module      :  GHC.Internal.Windows
  -- Copyright   :  (c) The University of Glasgow, 2009
  -- License     :  see libraries/base/LICENSE
  --
  -- Maintainer  :  libraries@haskell.org
  -- Stability   :  internal
  -- Portability :  non-portable
  --
  -- Windows functionality used by several modules.
  --
  -- ToDo: this just duplicates part of System.Win32.Types, which isn't
  -- available yet.  We should move some Win32 functionality down here,
  -- maybe as part of the grand reorganisation of the base package...
  --
  -----------------------------------------------------------------------------
  
  module GHC.Internal.Windows (
  #if defined(javascript_HOST_ARCH)
                     ) where
  
  #else
          -- * Types
          BOOL,
          LPBOOL,
          BYTE,
          DWORD,
          DDWORD,
          UINT,
          ULONG,
          ErrCode,
          HANDLE,
          LPWSTR,
          LPTSTR,
          LPCTSTR,
          LPVOID,
          LPDWORD,
          LPSTR,
          LPCSTR,
          LPCWSTR,
          WORD,
          UCHAR,
          NTSTATUS,
  
          -- * Constants
          iNFINITE,
          iNVALID_HANDLE_VALUE,
  
          -- * System errors
          throwGetLastError,
          failWith,
          getLastError,
          getErrorMessage,
          errCodeToIOError,
  
          -- ** Guards for system calls that might fail
          failIf,
          failIf_,
          failIfNull,
          failIfZero,
          failIfFalse_,
          failUnlessSuccess,
          failUnlessSuccessOr,
  
          -- ** Mapping system errors to errno
          -- $errno
          c_maperrno,
          c_maperrno_func,
  
          -- * Misc
          ddwordToDwords,
          dwordsToDdword,
          nullHANDLE,
      ) where
  
  import GHC.Internal.Data.Bits (finiteBitSize, shiftL, shiftR, (.|.), (.&.))
  import GHC.Internal.Unicode (isSpace)
  import GHC.Internal.Data.OldList
  import GHC.Internal.Data.Maybe
  import GHC.Internal.Word
  import GHC.Internal.Int
  import GHC.Internal.Foreign.C.Error
  import GHC.Internal.Foreign.C.String
  import GHC.Internal.Foreign.C.Types
  import GHC.Internal.Foreign.Ptr
  import GHC.Internal.Base
  import GHC.Internal.Enum (maxBound)
  import GHC.Internal.IO
  import GHC.Internal.Num
  import GHC.Internal.Real (fromIntegral)
  import GHC.Internal.System.IO.Error
  
  import qualified GHC.Internal.Numeric
  
  type BOOL     = Bool
  type LPBOOL   = Ptr BOOL
  type BYTE     = Word8
  type DWORD    = Word32
  type UINT     = Word32
  type ULONG    = Word32
  type ErrCode  = DWORD
  type HANDLE   = Ptr ()
  type LPWSTR   = Ptr CWchar
  type LPCTSTR  = LPTSTR
  type LPVOID   = Ptr ()
  type LPDWORD  = Ptr DWORD
  type LPSTR    = Ptr CChar
  type LPCSTR   = LPSTR
  type LPCWSTR  = LPWSTR
  type WORD     = Word16
  type UCHAR    = Word8
  type NTSTATUS = Int32
  
  nullHANDLE :: HANDLE
  nullHANDLE = nullPtr
  
  -- Not really a basic type, but used in many places
  type DDWORD        = Word64
  
  -- | Be careful with this.  LPTSTR can mean either WCHAR* or CHAR*, depending
  -- on whether the UNICODE macro is defined in the corresponding C code.
  -- Consider using LPWSTR instead.
  type LPTSTR = LPWSTR
  
  iNFINITE :: DWORD
  iNFINITE = 0xFFFFFFFF -- urgh
  
  iNVALID_HANDLE_VALUE :: HANDLE
  iNVALID_HANDLE_VALUE = wordPtrToPtr (-1)
  
  -- | Get the last system error, and throw it as an 'IOError' exception.
  throwGetLastError :: String -> IO a
  throwGetLastError where_from =
      getLastError >>= failWith where_from
  
  -- | Convert a Windows error code to an exception, then throw it.
  failWith :: String -> ErrCode -> IO a
  failWith fn_name err_code =
      errCodeToIOError fn_name err_code >>= throwIO
  
  -- | Convert a Windows error code to an exception.
  errCodeToIOError :: String -> ErrCode -> IO IOError
  errCodeToIOError fn_name err_code = do
      msg <- getErrorMessage err_code
  
      -- turn GetLastError() into errno, which errnoToIOError knows
      -- how to convert to an IOException we can throw.
      -- XXX we should really do this directly.
      let errno = c_maperrno_func err_code
  
      let msg' = dropWhileEnd isSpace msg -- drop trailing \n
          ioerror = errnoToIOError fn_name errno Nothing Nothing
                      `ioeSetErrorString` msg'
      return ioerror
  
  -- | Get a string describing a Windows error code.  This uses the
  -- @FormatMessage@ system call.
  getErrorMessage :: ErrCode -> IO String
  getErrorMessage err_code =
      mask_ $ do
          c_msg <- c_getErrorMessage err_code
          if c_msg == nullPtr
            then return $ "Error 0x" ++ GHC.Internal.Numeric.showHex err_code ""
            else do msg <- peekCWString c_msg
                    -- We ignore failure of freeing c_msg, given we're already failing
                    _ <- 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
  
  -- $errno
  --
  -- On Windows, @errno@ is defined by msvcrt.dll for compatibility with other
  -- systems, and is distinct from the system error as returned
  -- by @GetLastError@.
  
  -- | Map the last system error to an errno value, and assign it to @errno@.
  foreign import ccall unsafe "maperrno"             -- in Win32Utils.c
     c_maperrno :: IO ()
  
  -- | Pure function variant of 'c_maperrno' that does not call @GetLastError@
  -- or modify @errno@.
  foreign import ccall unsafe "maperrno_func"        -- in Win32Utils.c
     c_maperrno_func :: ErrCode -> Errno
  
  foreign import ccall unsafe "base_getErrorMessage" -- in Win32Utils.c
      c_getErrorMessage :: DWORD -> IO LPWSTR
  
  foreign import ccall unsafe "windows.h LocalFree"
      localFree :: Ptr a -> IO (Ptr a)
  
  -- | Get the last system error produced in the current thread.
  foreign import ccall unsafe "windows.h GetLastError"
      getLastError :: IO ErrCode
  
  ----------------------------------------------------------------
  -- Misc helpers
  ----------------------------------------------------------------
  
  ddwordToDwords :: DDWORD -> (DWORD,DWORD)
  ddwordToDwords n =
          (fromIntegral (n `shiftR` finiteBitSize (undefined :: DWORD))
          ,fromIntegral (n .&. fromIntegral (maxBound :: DWORD)))
  
  dwordsToDdword:: (DWORD,DWORD) -> DDWORD
  dwordsToDdword (hi,low) = (fromIntegral low) .|. (fromIntegral hi `shiftL` finiteBitSize hi)
  
  #endif
  