ghc-dup: 51764dc5df16053b8a7690dbc194c4ce1dec0c4f

     1: {-# LANGUAGE CPP, ForeignFunctionInterface #-}
     2: module WinCBindings where
     3: 
     4: #if defined(mingw32_HOST_OS)
     5: 
     6: import Foreign
     7: import System.Win32.File
     8: import System.Win32.Types
     9: 
    10: #include <windows.h>
    11: 
    12: type LPPROCESS_INFORMATION = Ptr PROCESS_INFORMATION
    13: data PROCESS_INFORMATION = PROCESS_INFORMATION
    14:     { piProcess :: HANDLE
    15:     , piThread :: HANDLE
    16:     , piProcessId :: DWORD
    17:     , piThreadId :: DWORD
    18:     } deriving Show
    19: 
    20: instance Storable PROCESS_INFORMATION where
    21:     sizeOf = const #size PROCESS_INFORMATION
    22:     alignment = sizeOf
    23:     poke buf pi = do
    24:         (#poke PROCESS_INFORMATION, hProcess)    buf (piProcess   pi)
    25:         (#poke PROCESS_INFORMATION, hThread)     buf (piThread    pi)
    26:         (#poke PROCESS_INFORMATION, dwProcessId) buf (piProcessId pi)
    27:         (#poke PROCESS_INFORMATION, dwThreadId)  buf (piThreadId  pi)
    28: 
    29:     peek buf = do
    30:         vhProcess    <- (#peek PROCESS_INFORMATION, hProcess)    buf
    31:         vhThread     <- (#peek PROCESS_INFORMATION, hThread)     buf
    32:         vdwProcessId <- (#peek PROCESS_INFORMATION, dwProcessId) buf
    33:         vdwThreadId  <- (#peek PROCESS_INFORMATION, dwThreadId)  buf
    34:         return $ PROCESS_INFORMATION {
    35:             piProcess   = vhProcess,
    36:             piThread    = vhThread,
    37:             piProcessId = vdwProcessId,
    38:             piThreadId  = vdwThreadId}
    39: 
    40: type LPSTARTUPINFO = Ptr STARTUPINFO
    41: data STARTUPINFO = STARTUPINFO
    42:     { siCb :: DWORD
    43:     , siDesktop :: LPTSTR
    44:     , siTitle :: LPTSTR
    45:     , siX :: DWORD
    46:     , siY :: DWORD
    47:     , siXSize :: DWORD
    48:     , siYSize :: DWORD
    49:     , siXCountChars :: DWORD
    50:     , siYCountChars :: DWORD
    51:     , siFillAttribute :: DWORD
    52:     , siFlags :: DWORD
    53:     , siShowWindow :: WORD
    54:     , siStdInput :: HANDLE
    55:     , siStdOutput :: HANDLE
    56:     , siStdError :: HANDLE
    57:     } deriving Show
    58: 
    59: instance Storable STARTUPINFO where
    60:     sizeOf = const #size STARTUPINFO
    61:     alignment = sizeOf
    62:     poke buf si = do
    63:         (#poke STARTUPINFO, cb)              buf (siCb si)
    64:         (#poke STARTUPINFO, lpDesktop)       buf (siDesktop si)
    65:         (#poke STARTUPINFO, lpTitle)         buf (siTitle si)
    66:         (#poke STARTUPINFO, dwX)             buf (siX si)
    67:         (#poke STARTUPINFO, dwY)             buf (siY si)
    68:         (#poke STARTUPINFO, dwXSize)         buf (siXSize si)
    69:         (#poke STARTUPINFO, dwYSize)         buf (siYSize si)
    70:         (#poke STARTUPINFO, dwXCountChars)   buf (siXCountChars si)
    71:         (#poke STARTUPINFO, dwYCountChars)   buf (siYCountChars si)
    72:         (#poke STARTUPINFO, dwFillAttribute) buf (siFillAttribute si)
    73:         (#poke STARTUPINFO, dwFlags)         buf (siFlags si)
    74:         (#poke STARTUPINFO, wShowWindow)     buf (siShowWindow si)
    75:         (#poke STARTUPINFO, hStdInput)       buf (siStdInput si)
    76:         (#poke STARTUPINFO, hStdOutput)      buf (siStdOutput si)
    77:         (#poke STARTUPINFO, hStdError)       buf (siStdError si)
    78: 
    79:     peek buf = do
    80:         vcb              <- (#peek STARTUPINFO, cb)              buf
    81:         vlpDesktop       <- (#peek STARTUPINFO, lpDesktop)       buf
    82:         vlpTitle         <- (#peek STARTUPINFO, lpTitle)         buf
    83:         vdwX             <- (#peek STARTUPINFO, dwX)             buf
    84:         vdwY             <- (#peek STARTUPINFO, dwY)             buf
    85:         vdwXSize         <- (#peek STARTUPINFO, dwXSize)         buf
    86:         vdwYSize         <- (#peek STARTUPINFO, dwYSize)         buf
    87:         vdwXCountChars   <- (#peek STARTUPINFO, dwXCountChars)   buf
    88:         vdwYCountChars   <- (#peek STARTUPINFO, dwYCountChars)   buf
    89:         vdwFillAttribute <- (#peek STARTUPINFO, dwFillAttribute) buf
    90:         vdwFlags         <- (#peek STARTUPINFO, dwFlags)         buf
    91:         vwShowWindow     <- (#peek STARTUPINFO, wShowWindow)     buf
    92:         vhStdInput       <- (#peek STARTUPINFO, hStdInput)       buf
    93:         vhStdOutput      <- (#peek STARTUPINFO, hStdOutput)      buf
    94:         vhStdError       <- (#peek STARTUPINFO, hStdError)       buf
    95:         return $ STARTUPINFO {
    96:             siCb            =  vcb,
    97:             siDesktop       =  vlpDesktop,
    98:             siTitle         =  vlpTitle,
    99:             siX             =  vdwX,
   100:             siY             =  vdwY,
   101:             siXSize         =  vdwXSize,
   102:             siYSize         =  vdwYSize,
   103:             siXCountChars   =  vdwXCountChars,
   104:             siYCountChars   =  vdwYCountChars,
   105:             siFillAttribute =  vdwFillAttribute,
   106:             siFlags         =  vdwFlags,
   107:             siShowWindow    =  vwShowWindow,
   108:             siStdInput      =  vhStdInput,
   109:             siStdOutput     =  vhStdOutput,
   110:             siStdError      =  vhStdError}
   111: 
   112: foreign import stdcall unsafe "windows.h WaitForSingleObject"
   113:     waitForSingleObject :: HANDLE -> DWORD -> IO DWORD
   114: 
   115: cWAIT_ABANDONED :: DWORD
   116: cWAIT_ABANDONED = #const WAIT_ABANDONED
   117: 
   118: cWAIT_OBJECT_0 :: DWORD
   119: cWAIT_OBJECT_0 = #const WAIT_OBJECT_0
   120: 
   121: cWAIT_TIMEOUT :: DWORD
   122: cWAIT_TIMEOUT = #const WAIT_TIMEOUT
   123: 
   124: foreign import stdcall unsafe "windows.h GetExitCodeProcess"
   125:     getExitCodeProcess :: HANDLE -> LPDWORD -> IO BOOL
   126: 
   127: foreign import stdcall unsafe "windows.h TerminateJobObject"
   128:     terminateJobObject :: HANDLE -> UINT -> IO BOOL
   129: 
   130: foreign import stdcall unsafe "windows.h AssignProcessToJobObject"
   131:     assignProcessToJobObject :: HANDLE -> HANDLE -> IO BOOL
   132: 
   133: foreign import stdcall unsafe "windows.h CreateJobObjectW"
   134:     createJobObjectW :: LPSECURITY_ATTRIBUTES -> LPCTSTR -> IO HANDLE
   135: 
   136: foreign import stdcall unsafe "windows.h CreateProcessW"
   137:     createProcessW :: LPCTSTR -> LPTSTR
   138:                    -> LPSECURITY_ATTRIBUTES -> LPSECURITY_ATTRIBUTES
   139:                    -> BOOL -> DWORD -> LPVOID -> LPCTSTR -> LPSTARTUPINFO
   140:                    -> LPPROCESS_INFORMATION -> IO BOOL
   141: 
   142: #endif
   143: