Win32 2.13.3.0 → 2.13.4.0
raw patch · 7 files changed
+177/−11 lines, 7 files
Files
- System/Win32/DLL.hsc +2/−2
- System/Win32/DLL/Internal.hsc +2/−2
- System/Win32/File.hsc +13/−4
- System/Win32/Semaphore.hsc +146/−0
- System/Win32/WindowsString/DLL.hsc +2/−2
- Win32.cabal +2/−1
- changelog.md +10/−0
System/Win32/DLL.hsc view
@@ -62,12 +62,12 @@ withCAString procname $ \ c_procname -> failIfNull "GetProcAddress" $ c_GetProcAddress hmod c_procname -loadLibrary :: String -> IO HINSTANCE+loadLibrary :: String -> IO HMODULE loadLibrary name = withTString name $ \ c_name -> failIfNull "LoadLibrary" $ c_LoadLibrary c_name -loadLibraryEx :: String -> HANDLE -> LoadLibraryFlags -> IO HINSTANCE+loadLibraryEx :: String -> HANDLE -> LoadLibraryFlags -> IO HMODULE loadLibraryEx name h flags = withTString name $ \ c_name -> failIfNull "LoadLibraryEx" $ c_LoadLibraryEx c_name h flags
System/Win32/DLL/Internal.hsc view
@@ -41,7 +41,7 @@ c_GetProcAddress :: HMODULE -> LPCSTR -> IO Addr foreign import WINDOWS_CCONV unsafe "windows.h LoadLibraryW"- c_LoadLibrary :: LPCTSTR -> IO HINSTANCE+ c_LoadLibrary :: LPCTSTR -> IO HMODULE type LoadLibraryFlags = DWORD @@ -51,7 +51,7 @@ } foreign import WINDOWS_CCONV unsafe "windows.h LoadLibraryExW"- c_LoadLibraryEx :: LPCTSTR -> HANDLE -> LoadLibraryFlags -> IO HINSTANCE+ c_LoadLibraryEx :: LPCTSTR -> HANDLE -> LoadLibraryFlags -> IO HMODULE foreign import WINDOWS_CCONV unsafe "windows.h SetDllDirectoryW" c_SetDllDirectory :: LPTSTR -> IO BOOL
System/Win32/File.hsc view
@@ -192,6 +192,7 @@ -- * HANDLE operations , createFile+ , createFile_NoRetry , closeHandle , getFileType , flushFileBuffers@@ -254,9 +255,9 @@ -- File operations ---------------------------------------------------------------- --- | like failIfFalse_, but retried on sharing violations.+-- | like failIf, but retried on sharing violations. -- This is necessary for many file operations; see--- http://support.microsoft.com/kb/316609+-- https://www.betaarchive.com/wiki/index.php/Microsoft_KB_Archive/316609 -- failIfWithRetry :: (a -> Bool) -> String -> IO a -> IO a failIfWithRetry cond msg action = retryOrFail retries@@ -349,10 +350,18 @@ ---------------------------------------------------------------- createFile :: String -> AccessMode -> ShareMode -> Maybe LPSECURITY_ATTRIBUTES -> CreateMode -> FileAttributeOrFlag -> Maybe HANDLE -> IO HANDLE-createFile name access share mb_attr mode flag mb_h =+createFile = createFile' failIfWithRetry++createFile' :: ((HANDLE -> Bool) -> String -> IO HANDLE -> IO HANDLE) -> String -> AccessMode -> ShareMode -> Maybe LPSECURITY_ATTRIBUTES -> CreateMode -> FileAttributeOrFlag -> Maybe HANDLE -> IO HANDLE+createFile' f name access share mb_attr mode flag mb_h = withTString name $ \ c_name ->- failIfWithRetry (==iNVALID_HANDLE_VALUE) (unwords ["CreateFile",show name]) $+ f (==iNVALID_HANDLE_VALUE) (unwords ["CreateFile",show name]) $ c_CreateFile c_name access share (maybePtr mb_attr) mode flag (maybePtr mb_h)++-- | Like createFile, but does not use failIfWithRetry. If another+-- process has the same file open, this will fail.+createFile_NoRetry :: String -> AccessMode -> ShareMode -> Maybe LPSECURITY_ATTRIBUTES -> CreateMode -> FileAttributeOrFlag -> Maybe HANDLE -> IO HANDLE+createFile_NoRetry = createFile' failIf closeHandle :: HANDLE -> IO () closeHandle h =
+ System/Win32/Semaphore.hsc view
@@ -0,0 +1,146 @@+#if __GLASGOW_HASKELL__ >= 709+{-# LANGUAGE Safe #-}+#else+{-# LANGUAGE Trustworthy #-}+#endif++-----------------------------------------------------------------------------+-- |+-- Module : System.Win32.Semaphore+-- Copyright : (c) Sam Derbyshire, 2022+-- License : BSD-style (see the file libraries/base/LICENSE)+--+-- Maintainer : Sam Derbyshire+-- Stability : provisional+-- Portability : portable+--+-- Windows Semaphore objects and operations+--+-----------------------------------------------------------------------------++module System.Win32.Semaphore+ ( -- * Semaphores+ Semaphore(..)++ -- * Access modes+ , AccessMode+ , sEMAPHORE_ALL_ACCESS+ , sEMAPHORE_MODIFY_STATE++ -- * Managing semaphores+ , createSemaphore+ , openSemaphore+ , releaseSemaphore+ ) where++import System.Win32.File+import System.Win32.Types++import Data.Maybe (fromMaybe)+import Foreign hiding (void)+import Foreign.C (withCAString)++##include "windows_cconv.h"++#include <windows.h>++----------------------------------------------------------------+-- Semaphore access modes+----------------------------------------------------------------++#{enum AccessMode,+ , sEMAPHORE_ALL_ACCESS = SEMAPHORE_ALL_ACCESS+ , sEMAPHORE_MODIFY_STATE = SEMAPHORE_MODIFY_STATE+ }++----------------------------------------------------------------+-- Semaphores+----------------------------------------------------------------++-- | A Windows semaphore.+--+-- To obtain a 'Semaphore', use 'createSemaphore' to create a new one,+-- or 'openSemaphore' to open an existing one.+--+-- To wait on a semaphore, use 'System.Win32.Event.waitForSingleObject'.+--+-- To release resources on a semaphore, use 'releaseSemaphore'.+--+-- To free a semaphore, use 'System.Win32.File.closeHandle'.+-- The semaphore object is destroyed when its last handle has been closed.+-- Closing the handle does not affect the semaphore count; therefore, be sure to call+-- 'releaseSemaphore' before closing the handle or before the process terminates.+-- Otherwise, pending wait operations will either time out or continue indefinitely,+-- depending on whether a time-out value has been specified.+newtype Semaphore = Semaphore { semaphoreHandle :: HANDLE }++-- | Open a 'Semaphore' with the given name, or create a new semaphore+-- if no such semaphore exists, with initial count @i@ and maximum count @m@.+--+-- The counts must satisfy @i >= 0@, @m > 0@ and @i <= m@.+--+-- The returned 'Bool' is 'True' if the function found an existing semaphore+-- with the given name, in which case a handle to that semaphore is returned+-- and the counts are ignored.+--+-- Use 'openSemaphore' if you don't want to create a new semaphore.+createSemaphore :: Maybe SECURITY_ATTRIBUTES+ -> LONG -- ^ initial count @i@ with @0 <= i <= m@+ -> LONG -- ^ maximum count @m > 0@+ -> Maybe String -- ^ (optional) semaphore name+ -- (case-sensitive, limited to MAX_PATH characters)+ -> IO (Semaphore, Bool)+createSemaphore mb_sec initial_count max_count mb_name =+ maybeWith with mb_sec $ \ c_sec -> do+ maybeWith withCAString mb_name $ \ c_name -> do+ handle <- c_CreateSemaphore c_sec initial_count max_count c_name+ err_code <- getLastError+ already_exists <-+ case err_code of+ (# const ERROR_INVALID_HANDLE) ->+ errorWin $ "createSemaphore: semaphore name '"+ ++ fromMaybe "" mb_name+ ++ "' matches non-semaphore"+ (# const ERROR_ALREADY_EXISTS) ->+ return True+ _ ->+ return False+ if handle == nullPtr+ then errorWin "createSemaphore"+ else return (Semaphore handle, already_exists)++foreign import WINDOWS_CCONV unsafe "windows.h CreateSemaphoreA"+ c_CreateSemaphore :: LPSECURITY_ATTRIBUTES -> LONG -> LONG -> LPCSTR -> IO HANDLE++-- | Open an existing 'Semaphore'.+openSemaphore :: AccessMode -- ^ desired access mode+ -> Bool -- ^ should child processes inherit the handle?+ -> String -- ^ name of the semaphore to open (case-sensitive)+ -> IO Semaphore+openSemaphore amode inherit name =+ withTString name $ \c_name -> do+ handle <- failIfNull ("openSemaphore: '" ++ name ++ "'") $+ c_OpenSemaphore (fromIntegral amode) inherit c_name+ return (Semaphore handle)++foreign import WINDOWS_CCONV unsafe "windows.h OpenSemaphoreW"+ c_OpenSemaphore :: DWORD -> BOOL -> LPCWSTR -> IO HANDLE++-- | Increase the count of the 'Semaphore' by the specified amount.+--+-- Returns the count of the semaphore before the increase.+--+-- Throws an error if the count would exceeded the maximum count+-- of the semaphore.+releaseSemaphore :: Semaphore -> LONG -> IO LONG+releaseSemaphore (Semaphore handle) count =+ with 0 $ \ ptr_prevCount -> do+ failIfFalse_ "releaseSemaphore" $ c_ReleaseSemaphore handle count ptr_prevCount+ peek ptr_prevCount++foreign import WINDOWS_CCONV unsafe "windows.h ReleaseSemaphore"+ c_ReleaseSemaphore :: HANDLE -> LONG -> Ptr LONG -> IO BOOL++----------------------------------------------------------------+-- End+----------------------------------------------------------------
System/Win32/WindowsString/DLL.hsc view
@@ -49,12 +49,12 @@ maybeWith withTString mb_name $ \ c_name -> failIfNull "GetModuleHandle" $ c_GetModuleHandle c_name -loadLibrary :: WindowsString -> IO HINSTANCE +loadLibrary :: WindowsString -> IO HMODULE loadLibrary name = withTString name $ \ c_name -> failIfNull "LoadLibrary" $ c_LoadLibrary c_name -loadLibraryEx :: WindowsString -> HANDLE -> LoadLibraryFlags -> IO HINSTANCE +loadLibraryEx :: WindowsString -> HANDLE -> LoadLibraryFlags -> IO HMODULE loadLibraryEx name h flags = withTString name $ \ c_name -> failIfNull "LoadLibraryEx" $ c_LoadLibraryEx c_name h flags
Win32.cabal view
@@ -1,5 +1,5 @@ name: Win32-version: 2.13.3.0+version: 2.13.4.0 license: BSD3 license-file: LICENSE author: Alastair Reid, shelarcy, Tamar Christina@@ -88,6 +88,7 @@ System.Win32.Time System.Win32.Console System.Win32.Security+ System.Win32.Semaphore System.Win32.Types System.Win32.Shell System.Win32.Automation
changelog.md view
@@ -1,5 +1,15 @@ # Changelog for [`Win32` package](http://hackage.haskell.org/package/Win32) +## 2.13.4.0 October 2022++* Add support for semaphores with `System.Win32.Semaphore` (See #214).+* Add function `createFile_NoRetry` (see #208)+* The type signatures for `loadLibrary` and `loadLibraryEx` now refer to+ `HMODULE` instead of `HINSTANCE` for consistency with the official Win32+ API documentation. Note that `HMODULE` and `HINSTANCE` are both type synonyms+ for the same thing, so this only changes the presentation of these functions'+ type signatures, not their behavior.+ ## 2.13.3.0 July 2022 * Add AFPP support (see #198)