Win32 2.14.1.0 → 2.14.2.0

raw patch · 10 files changed

+260/−13 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Graphics/Win32/Window.hsc +2/−2
• System/Win32/Console.hsc +20/−2
• System/Win32/Console/Internal.hsc +147/−1
• System/Win32/DebugApi.hsc +53/−5
• System/Win32/File.hsc +5/−0
• System/Win32/File/Internal.hsc +13/−0
• System/Win32/WindowsString/File.hsc +12/−1
• Win32.cabal +1/−1
• changelog.md +6/−0
• include/windows_cconv.h +1/−1

@@ -238,7 +238,7 @@ -} #if defined(i386_HOST_ARCH) foreign import WINDOWS_CCONV unsafe "windows.h SetWindowLongW"-#elif defined(x86_64_HOST_ARCH)+#elif defined(x86_64_HOST_ARCH) || defined(aarch64_HOST_ARCH) foreign import WINDOWS_CCONV unsafe "windows.h SetWindowLongPtrW" #else # error Unknown mingw32 arch@@ -247,7 +247,7 @@  #if defined(i386_HOST_ARCH) foreign import WINDOWS_CCONV unsafe "windows.h GetWindowLongW"-#elif defined(x86_64_HOST_ARCH)+#elif defined(x86_64_HOST_ARCH) || defined(aarch64_HOST_ARCH) foreign import WINDOWS_CCONV unsafe "windows.h GetWindowLongPtrW" #else # error Unknown mingw32 arch

@@ -60,7 +60,15 @@ 
         -- * Env
         getEnv,
-        getEnvironment
+        getEnvironment,
+        -- * Console I/O
+        KEY_EVENT_RECORD(..),
+        MOUSE_EVENT_RECORD(..),
+        WINDOW_BUFFER_SIZE_RECORD(..),
+        MENU_EVENT_RECORD(..),
+        FOCUS_EVENT_RECORD(..),
+        INPUT_RECORD(..),
+        readConsoleInput
   ) where
 
 #include <windows.h>
@@ -77,7 +85,7 @@ 
 import GHC.IO (bracket)
 import GHC.IO.Exception (IOException(..), IOErrorType(OtherError))
-import Foreign.Ptr (plusPtr)
+import Foreign.Ptr (plusPtr, Ptr)
 import Foreign.C.Types (CWchar)
 import Foreign.C.String (withCWString, CWString)
 import Foreign.Storable (Storable(..))
@@ -232,3 +240,13 @@   fromUTF16 (c:wcs) = c : fromUTF16 wcs
   fromUTF16 [] = []
 
+-- | Reads all available input records up to the amount specified by the
+-- len parameter.
+readConsoleInput :: HANDLE -> Int -> Ptr INPUT_RECORD -> IO Int
+readConsoleInput handle len inputRecordPtr =
+  alloca $ \numEventsReadPtr -> do
+    poke numEventsReadPtr 0
+    failIfFalse_ "ReadConsoleInput" $
+      c_ReadConsoleInput handle inputRecordPtr (fromIntegral len) numEventsReadPtr
+    numEvents <- peek numEventsReadPtr
+    return $ fromIntegral numEvents

@@ -27,7 +27,7 @@ import System.Win32.Types import Graphics.Win32.GDI.Types (COLORREF) -import Foreign.C.Types (CInt(..))+import Foreign.C.Types (CInt(..), CWchar) import Foreign.C.String (CWString) import Foreign.Ptr (Ptr, plusPtr) import Foreign.Storable (Storable(..))@@ -188,3 +188,149 @@ foreign import WINDOWS_CCONV safe "windows.h GetConsoleScreenBufferInfoEx"     c_GetConsoleScreenBufferInfoEx :: HANDLE -> Ptr CONSOLE_SCREEN_BUFFER_INFOEX -> IO BOOL +-- | This type represents a keyboard input event. The structure is documented here:+-- https://learn.microsoft.com/en-us/windows/console/key-event-record-str+data KEY_EVENT_RECORD = KEY_EVENT_RECORD+    { keyDown          :: BOOL+    , repeatCount      :: WORD+    , virtualKeyCode   :: WORD+    , virtualScanCode  :: WORD+    , uChar            :: CWchar+    , controlKeyStateK :: DWORD+    } deriving (Eq, Show)++-- | This type represents a mouse event. The structure is documented here:+-- https://learn.microsoft.com/en-us/windows/console/mouse-event-record-str+data MOUSE_EVENT_RECORD = MOUSE_EVENT_RECORD+  { mousePosition    :: COORD+  , buttonState      :: DWORD+  , controlKeyStateM :: DWORD+  , eventFlags       :: DWORD+  } deriving (Eq, Show)++-- | This type represents a window size change event. The structure is documented here:+-- https://learn.microsoft.com/en-us/windows/console/window-buffer-size-record-str+newtype WINDOW_BUFFER_SIZE_RECORD = WINDOW_BUFFER_SIZE_RECORD+  { windowSize :: COORD+  } deriving (Eq, Show)++-- | This type represents a window menu event. (Current ignored by VTY). The structure+-- is documented here: https://learn.microsoft.com/en-us/windows/console/menu-event-record-str+newtype MENU_EVENT_RECORD = MENU_EVENT_RECORD+  { commandId :: UINT+  } deriving (Eq, Show)++-- | This type represents a window focus change event. The structure is documented here:+-- https://learn.microsoft.com/en-us/windows/console/focus-event-record-str+newtype FOCUS_EVENT_RECORD = FOCUS_EVENT_RECORD+  { setFocus :: BOOL+  } deriving (Eq, Show)++-- | Description of a Windows console input event. Documented here:+-- https://learn.microsoft.com/en-us/windows/console/input-record-str+data INPUT_RECORD =+    KeyEvent KEY_EVENT_RECORD+  | MouseEvent MOUSE_EVENT_RECORD+  | WindowBufferSizeEvent WINDOW_BUFFER_SIZE_RECORD+  | MenuEvent MENU_EVENT_RECORD+  | FocusEvent FOCUS_EVENT_RECORD+  deriving (Eq, Show)++instance Storable KEY_EVENT_RECORD where+    sizeOf = const #{size KEY_EVENT_RECORD}+    alignment _ = #alignment KEY_EVENT_RECORD+    poke buf input = do+        (#poke KEY_EVENT_RECORD, bKeyDown)          buf (keyDown input)+        (#poke KEY_EVENT_RECORD, wRepeatCount)      buf (repeatCount input)+        (#poke KEY_EVENT_RECORD, wVirtualKeyCode)   buf (virtualKeyCode input)+        (#poke KEY_EVENT_RECORD, wVirtualScanCode)  buf (virtualScanCode input)+        (#poke KEY_EVENT_RECORD, uChar)             buf (uChar input)+        (#poke KEY_EVENT_RECORD, dwControlKeyState) buf (controlKeyStateK input)+    peek buf = do+        keyDown'          <- (#peek KEY_EVENT_RECORD, bKeyDown) buf+        repeatCount'      <- (#peek KEY_EVENT_RECORD, wRepeatCount) buf+        virtualKeyCode'   <- (#peek KEY_EVENT_RECORD, wVirtualKeyCode) buf+        virtualScanCode'  <- (#peek KEY_EVENT_RECORD, wVirtualScanCode) buf+        uChar'            <- (#peek KEY_EVENT_RECORD, uChar) buf+        controlKeyStateK' <- (#peek KEY_EVENT_RECORD, dwControlKeyState) buf+        return $ KEY_EVENT_RECORD keyDown' repeatCount' virtualKeyCode' virtualScanCode' uChar' controlKeyStateK'++instance Storable MOUSE_EVENT_RECORD where+    sizeOf = const #{size MOUSE_EVENT_RECORD}+    alignment _ = #alignment MOUSE_EVENT_RECORD+    poke buf input = do+        (#poke MOUSE_EVENT_RECORD, dwMousePosition)   buf (mousePosition input)+        (#poke MOUSE_EVENT_RECORD, dwButtonState)     buf (buttonState input)+        (#poke MOUSE_EVENT_RECORD, dwControlKeyState) buf (controlKeyStateM input)+        (#poke MOUSE_EVENT_RECORD, dwEventFlags)      buf (eventFlags input)+    peek buf = do+        mousePosition'    <- (#peek MOUSE_EVENT_RECORD, dwMousePosition) buf+        buttonState'      <- (#peek MOUSE_EVENT_RECORD, dwButtonState) buf+        controlKeyStateM' <- (#peek MOUSE_EVENT_RECORD, dwControlKeyState) buf+        eventFlags'       <- (#peek MOUSE_EVENT_RECORD, dwEventFlags) buf+        return $ MOUSE_EVENT_RECORD mousePosition' buttonState' controlKeyStateM' eventFlags'++instance Storable WINDOW_BUFFER_SIZE_RECORD where+    sizeOf = const #{size WINDOW_BUFFER_SIZE_RECORD}+    alignment _ = #alignment WINDOW_BUFFER_SIZE_RECORD+    poke buf input = do+        (#poke WINDOW_BUFFER_SIZE_RECORD, dwSize) buf (windowSize input)+    peek buf = do+        size' <- (#peek WINDOW_BUFFER_SIZE_RECORD, dwSize) buf+        return $ WINDOW_BUFFER_SIZE_RECORD size'++instance Storable MENU_EVENT_RECORD where+    sizeOf = const #{size MENU_EVENT_RECORD}+    alignment _ = #alignment MENU_EVENT_RECORD+    poke buf input = do+        (#poke MENU_EVENT_RECORD, dwCommandId) buf (commandId input)+    peek buf = do+        commandId' <- (#peek MENU_EVENT_RECORD, dwCommandId) buf+        return $ MENU_EVENT_RECORD commandId'++instance Storable FOCUS_EVENT_RECORD where+    sizeOf = const #{size FOCUS_EVENT_RECORD}+    alignment _ = #alignment FOCUS_EVENT_RECORD+    poke buf input = do+        (#poke FOCUS_EVENT_RECORD, bSetFocus) buf (setFocus input)+    peek buf = do+        setFocus' <- (#peek FOCUS_EVENT_RECORD, bSetFocus) buf+        return $ FOCUS_EVENT_RECORD setFocus'++instance Storable INPUT_RECORD where+    sizeOf = const #{size INPUT_RECORD}+    alignment _ = #alignment INPUT_RECORD++    poke buf (KeyEvent key) = do+        (#poke INPUT_RECORD, EventType) buf (#{const KEY_EVENT} :: WORD)+        (#poke INPUT_RECORD, Event) buf key+    poke buf (MouseEvent mouse) = do+        (#poke INPUT_RECORD, EventType) buf (#{const MOUSE_EVENT} :: WORD)+        (#poke INPUT_RECORD, Event) buf mouse+    poke buf (WindowBufferSizeEvent window) = do+        (#poke INPUT_RECORD, EventType) buf (#{const WINDOW_BUFFER_SIZE_EVENT} :: WORD)+        (#poke INPUT_RECORD, Event) buf window+    poke buf (MenuEvent menu) = do+        (#poke INPUT_RECORD, EventType) buf (#{const MENU_EVENT} :: WORD)+        (#poke INPUT_RECORD, Event) buf menu+    poke buf (FocusEvent focus) = do+        (#poke INPUT_RECORD, EventType) buf (#{const FOCUS_EVENT} :: WORD)+        (#poke INPUT_RECORD, Event) buf focus++    peek buf = do+        event <- (#peek INPUT_RECORD, EventType) buf :: IO WORD+        case event of+          #{const KEY_EVENT} ->+              KeyEvent `fmap` (#peek INPUT_RECORD, Event) buf+          #{const MOUSE_EVENT} ->+              MouseEvent `fmap` (#peek INPUT_RECORD, Event) buf+          #{const WINDOW_BUFFER_SIZE_EVENT} ->+              WindowBufferSizeEvent `fmap` (#peek INPUT_RECORD, Event) buf+          #{const MENU_EVENT} ->+              MenuEvent `fmap` (#peek INPUT_RECORD, Event) buf+          #{const FOCUS_EVENT} ->+              FocusEvent `fmap` (#peek INPUT_RECORD, Event) buf+          _ -> error $ "Unknown input event type " ++ show event++foreign import WINDOWS_CCONV unsafe "windows.h ReadConsoleInputW"+    c_ReadConsoleInput :: HANDLE -> Ptr INPUT_RECORD -> DWORD -> LPDWORD -> IO BOOL

@@ -54,14 +54,22 @@     , useAllRegs     , withThreadContext -#if __i386__+#if defined(i386_HOST_ARCH)     , eax, ebx, ecx, edx, esi, edi, ebp, eip, esp-#elif __x86_64__+#elif defined(x86_64_HOST_ARCH)     , rax, rbx, rcx, rdx, rsi, rdi, rbp, rip, rsp #endif+#if defined(x86_64_HOST_ARCH) || defined(i386_HOST_ARCH)     , segCs, segDs, segEs, segFs, segGs     , eFlags     , dr+#endif+#if defined(aarch64_HOST_ARCH)+    , x0,   x1,  x2,  x3,  x4,  x5,  x6,  x7,  x8+    , x9,  x10, x11, x12, x13, x14, x15, x16, x17+    , x18, x19, x20, x21, x22, x23, x24, x25, x26+    , x27, x28,  fp,  lr,  sp,  pc+#endif     , setReg, getReg, modReg     , makeModThreadContext     , modifyThreadContext@@ -331,7 +339,7 @@             (act buf)  -#if __i386__+#if defined(i386_HOST_ARCH) eax, ebx, ecx, edx :: Int esi, edi :: Int ebp, eip, esp :: Int@@ -344,7 +352,7 @@ ebp = (#offset CONTEXT, Ebp) eip = (#offset CONTEXT, Eip) esp = (#offset CONTEXT, Esp)-#elif __x86_64__+#elif defined(x86_64_HOST_ARCH) rax, rbx, rcx, rdx :: Int rsi, rdi :: Int rbp, rip, rsp :: Int@@ -357,10 +365,49 @@ rbp = (#offset CONTEXT, Rbp) rip = (#offset CONTEXT, Rip) rsp = (#offset CONTEXT, Rsp)+#elif defined(aarch64_HOST_ARCH)+x0,   x1,  x2,  x3,  x4,  x5,  x6,  x7,  x8 :: Int+x9,  x10, x11, x12, x13, x14, x15, x16, x17 :: Int+x18, x19, x20, x21, x22, x23, x24, x25, x26 :: Int+x27, x28,  fp,  lr,  sp,  pc                :: Int+x0  = (#offset CONTEXT, X0 )+x1  = (#offset CONTEXT, X1 )+x2  = (#offset CONTEXT, X2 )+x3  = (#offset CONTEXT, X3 )+x4  = (#offset CONTEXT, X4 )+x5  = (#offset CONTEXT, X5 )+x6  = (#offset CONTEXT, X6 )+x7  = (#offset CONTEXT, X7 )+x8  = (#offset CONTEXT, X8 )+x9  = (#offset CONTEXT, X9 )+x10 = (#offset CONTEXT, X10)+x11 = (#offset CONTEXT, X11)+x12 = (#offset CONTEXT, X12)+x13 = (#offset CONTEXT, X13)+x14 = (#offset CONTEXT, X14)+x15 = (#offset CONTEXT, X15)+x16 = (#offset CONTEXT, X16)+x17 = (#offset CONTEXT, X17)+x18 = (#offset CONTEXT, X18)+x19 = (#offset CONTEXT, X19)+x20 = (#offset CONTEXT, X20)+x21 = (#offset CONTEXT, X21)+x22 = (#offset CONTEXT, X22)+x23 = (#offset CONTEXT, X23)+x24 = (#offset CONTEXT, X24)+x25 = (#offset CONTEXT, X25)+x26 = (#offset CONTEXT, X26)+x27 = (#offset CONTEXT, X27)+x28 = (#offset CONTEXT, X28)+fp  = (#offset CONTEXT, Fp)+lr  = (#offset CONTEXT, Lr)+sp  = (#offset CONTEXT, Sp)+pc  = (#offset CONTEXT, Pc) #else-#error Unsupported architecture+#error Unknown mingw32 arch #endif +#if defined(x86_64_HOST_ARCH) || defined(i386_HOST_ARCH) segCs, segDs, segEs, segFs, segGs :: Int segCs = (#offset CONTEXT, SegCs) segDs = (#offset CONTEXT, SegDs)@@ -380,6 +427,7 @@     6 -> (#offset CONTEXT, Dr6)     7 -> (#offset CONTEXT, Dr7)     _ -> undefined+#endif  setReg :: Ptr a -> Int -> DWORD -> IO () setReg = pokeByteOff

@@ -190,6 +190,7 @@     , removeDirectory     , getBinaryType     , getTempFileName+    , replaceFile        -- * HANDLE operations     , createFile@@ -418,6 +419,10 @@ getFileInformationByHandle h = alloca $ \res -> do     failIfFalseWithRetry_ "GetFileInformationByHandle" $ c_GetFileInformationByHandle h res     peek res++replaceFile :: LPCWSTR -> LPCWSTR -> LPCWSTR -> DWORD -> IO ()+replaceFile replacedFile replacementFile backupFile replaceFlags =+  failIfFalse_ "ReplaceFile" $ c_ReplaceFile replacedFile replacementFile backupFile replaceFlags nullPtr nullPtr  ---------------------------------------------------------------- -- Read/write files

@@ -193,6 +193,16 @@  ---------------------------------------------------------------- +type ReplaceType = DWORD++#{enum ReplaceType,+ , rEPLACEFILE_WRITE_THROUGH       = REPLACEFILE_WRITE_THROUGH+ , rEPLACEFILE_IGNORE_MERGE_ERRORS = REPLACEFILE_IGNORE_MERGE_ERRORS+ , rEPLACEFILE_IGNORE_ACL_ERRORS   = REPLACEFILE_IGNORE_ACL_ERRORS+ }++----------------------------------------------------------------+ type FileNotificationFlag = DWORD  #{enum FileNotificationFlag,@@ -366,6 +376,9 @@  foreign import WINDOWS_CCONV unsafe "windows.h GetBinaryTypeW"   c_GetBinaryType :: LPCTSTR -> Ptr DWORD -> IO Bool++foreign import WINDOWS_CCONV unsafe "windows.h ReplaceFileW"+  c_ReplaceFile :: LPCWSTR -> LPCWSTR -> LPCWSTR -> DWORD -> LPVOID -> LPVOID -> IO Bool  ---------------------------------------------------------------- -- HANDLE operations

@@ -35,6 +35,7 @@     , setVolumeLabel
     , getFileExInfoStandard
     , getFileExMaxInfoLevel
+    , replaceFile
     , module System.Win32.File
     ) where
 
@@ -62,6 +63,7 @@   , setVolumeLabel
   , getFileExInfoStandard
   , getFileExMaxInfoLevel
+  , replaceFile
   )
 import System.Win32.WindowsString.Types
 import System.OsString.Windows
@@ -180,7 +182,16 @@   fname <- peekTString c_buf
   pure (fname, uid)
 
-
+replaceFile :: WindowsString -> WindowsString -> Maybe WindowsString -> DWORD -> IO ()
+replaceFile replacedFile replacementFile mBackupFile replaceFlags =
+  withFilePath replacedFile $ \ c_replacedFile ->
+    withFilePath replacementFile $ \ c_replacementFile ->
+      let getResult f = 
+            case mBackupFile of
+              Nothing -> f nullPtr
+              Just backupFile -> withFilePath backupFile f
+      in getResult $ \ c_backupFile ->
+           failIfFalse_ "ReplaceFile" $ c_ReplaceFile c_replacedFile c_replacementFile c_backupFile replaceFlags nullPtr nullPtr
 
 ----------------------------------------------------------------
 -- File Notifications

@@ -1,6 +1,6 @@ cabal-version:  2.0 name:           Win32-version:        2.14.1.0+version:        2.14.2.0 license:        BSD3 license-file:   LICENSE author:         Alastair Reid, shelarcy, Tamar Christina

@@ -1,5 +1,11 @@ # Changelog for [`Win32` package](http://hackage.haskell.org/package/Win32) +## 2.14.2.0 November 2024++* Add ReplaceFileW+* Add support for Windows on Arm+* Add ReadConsoleInput+ ## 2.14.1.0 November 2024  * Add getTempFileName

@@ -3,7 +3,7 @@  #if defined(i386_HOST_ARCH) # define WINDOWS_CCONV stdcall-#elif defined(x86_64_HOST_ARCH)+#elif defined(x86_64_HOST_ARCH) || defined(aarch64_HOST_ARCH) # define WINDOWS_CCONV ccall #else # error Unknown mingw32 arch