Win32 2.14.0.0 → 2.14.1.0

raw patch · 11 files changed

+235/−11 lines, 11 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ System.Win32.Console: getEnv :: String -> IO (Maybe String)

+ System.Win32.Console: getEnvironment :: IO [(String, String)]

+ System.Win32.File: getTempFileName :: String -> String -> Maybe UINT -> IO (String, UINT)

+ System.Win32.Types: eERROR_ENVVAR_NOT_FOUND :: ErrCode

+ System.Win32.WindowsString.Console: getEnv :: WindowsString -> IO (Maybe WindowsString)

+ System.Win32.WindowsString.Console: getEnvironment :: IO [(WindowsString, WindowsString)]

+ System.Win32.WindowsString.File: getTempFileName :: WindowsString -> WindowsString -> Maybe UINT -> IO (WindowsString, UINT)

+ System.Win32.WindowsString.Types: eERROR_ENVVAR_NOT_FOUND :: ErrCode

Files

System/Win32/Console.hsc +82/−4
System/Win32/Console/Internal.hsc +9/−0
System/Win32/File.hsc +18/−0
System/Win32/File/Internal.hsc +3/−0
System/Win32/Types.hsc +2/−0
System/Win32/WindowsString/Console.hsc +92/−3
System/Win32/WindowsString/File.hsc +20/−0
System/Win32/WindowsString/String.hs +1/−1
System/Win32/WindowsString/Types.hsc +1/−1
Win32.cabal +1/−2
changelog.md +6/−0

System/Win32/Console.hsc view

@@ -1,5 +1,5 @@ #if __GLASGOW_HASKELL__ >= 709
-{-# LANGUAGE Safe #-}
+{-# LANGUAGE Trustworthy #-}
 #else
 {-# LANGUAGE Trustworthy #-}
 #endif
@@ -56,7 +56,11 @@         getConsoleScreenBufferInfo,
         getCurrentConsoleScreenBufferInfo,
         getConsoleScreenBufferInfoEx,
-        getCurrentConsoleScreenBufferInfoEx
+        getCurrentConsoleScreenBufferInfoEx,
+
+        -- * Env
+        getEnv,
+        getEnvironment
   ) where
 
 #include <windows.h>
@@ -64,14 +68,20 @@ ##include "windows_cconv.h"
 #include "wincon_compat.h"
 
+import Data.Char (chr)
 import System.Win32.Types
+import System.Win32.String
 import System.Win32.Console.Internal
 import Graphics.Win32.Misc
 import Graphics.Win32.GDI.Types (COLORREF)
 
-import Foreign.C.String (withCWString)
+import GHC.IO (bracket)
+import GHC.IO.Exception (IOException(..), IOErrorType(OtherError))
+import Foreign.Ptr (plusPtr)
+import Foreign.C.Types (CWchar)
+import Foreign.C.String (withCWString, CWString)
 import Foreign.Storable (Storable(..))
-import Foreign.Marshal.Array (peekArray)
+import Foreign.Marshal.Array (peekArray, peekArray0)
 import Foreign.Marshal.Alloc (alloca)
 
 
@@ -154,3 +164,71 @@ getCurrentConsoleScreenBufferInfoEx = do
     h <- failIf (== nullHANDLE) "getStdHandle" $ getStdHandle sTD_OUTPUT_HANDLE
     getConsoleScreenBufferInfoEx h
+
+
+-- c_GetEnvironmentVariableW :: LPCWSTR -> LPWSTR -> DWORD -> IO DWORD
+getEnv :: String -> IO (Maybe String)
+getEnv name =
+  withCWString name $ \c_name -> withTStringBufferLen maxLength $ \(buf, len) -> do
+    let c_len = fromIntegral len
+    c_len' <- c_GetEnvironmentVariableW c_name buf c_len
+    case c_len' of
+      0 -> do
+        err_code <- getLastError
+        if err_code  == eERROR_ENVVAR_NOT_FOUND
+        then return Nothing
+        else errorWin "GetEnvironmentVariableW"
+      _ | c_len' > fromIntegral maxLength ->
+            -- shouldn't happen, because we provide maxLength
+            ioError (IOError Nothing OtherError "GetEnvironmentVariableW" ("Unexpected return code: " <> show c_len') Nothing Nothing)
+        | otherwise -> do
+            let len' = fromIntegral c_len'
+            Just <$> peekTStringLen (buf, len')
+ where
+  -- according to https://learn.microsoft.com/en-us/windows/win32/api/processenv/nf-processenv-getenvironmentvariablew
+  -- max characters (wide chars): 32767
+  -- => bytes = 32767 * 2 = 65534
+  -- +1 byte for NUL (although not needed I think)
+  maxLength :: Int
+  maxLength = 65535
+
+
+getEnvironment :: IO [(String, String)]
+getEnvironment = bracket c_GetEnvironmentStringsW c_FreeEnvironmentStrings $ \lpwstr -> do
+    strs <- builder lpwstr
+    return (divvy <$> strs)
+ where
+  divvy :: String -> (String, String)
+  divvy str =
+    case break (=='=') str of
+      (xs,[])        -> (xs,[]) -- don't barf (like Posix.getEnvironment)
+      (name,_:value) -> (name,value)
+
+  builder :: LPWSTR -> IO [String]
+  builder ptr = go 0
+   where
+    go :: Int -> IO [String]
+    go off = do
+      (str, l) <- peekCWStringOff ptr off
+      if l == 0
+      then pure []
+      else (str:) <$> go (((l + 1) * 2) + off)
+
+
+peekCWStringOff :: CWString -> Int -> IO (String, Int)
+peekCWStringOff cp off = do
+  cs <- peekArray0 wNUL (cp `plusPtr` off)
+  return (cWcharsToChars cs, length cs)
+
+wNUL :: CWchar
+wNUL = 0
+
+cWcharsToChars :: [CWchar] -> [Char]
+cWcharsToChars = map chr . fromUTF16 . map fromIntegral
+ where
+  fromUTF16 (c1:c2:wcs)
+    | 0xd800 <= c1 && c1 <= 0xdbff && 0xdc00 <= c2 && c2 <= 0xdfff =
+      ((c1 - 0xd800)*0x400 + (c2 - 0xdc00) + 0x10000) : fromUTF16 wcs
+  fromUTF16 (c:wcs) = c : fromUTF16 wcs
+  fromUTF16 [] = []
+

System/Win32/Console/Internal.hsc view

@@ -66,6 +66,15 @@ foreign import WINDOWS_CCONV unsafe "processenv.h GetCommandLineW"         getCommandLineW :: IO LPWSTR +foreign import WINDOWS_CCONV unsafe "processenv.h GetEnvironmentVariableW"+        c_GetEnvironmentVariableW :: LPCWSTR -> LPWSTR -> DWORD -> IO DWORD++foreign import WINDOWS_CCONV unsafe "processenv.h GetEnvironmentStringsW"+        c_GetEnvironmentStringsW :: IO LPWSTR++foreign import WINDOWS_CCONV unsafe "processenv.h FreeEnvironmentStringsW"+  c_FreeEnvironmentStrings :: LPWSTR -> IO Bool+ data CONSOLE_SCREEN_BUFFER_INFO = CONSOLE_SCREEN_BUFFER_INFO     { dwSize              :: COORD     , dwCursorPosition    :: COORD

System/Win32/File.hsc view

@@ -189,6 +189,7 @@     , createDirectoryEx     , removeDirectory     , getBinaryType+    , getTempFileName        -- * HANDLE operations     , createFile@@ -245,6 +246,7 @@ import Foreign hiding (void) import Control.Monad import Control.Concurrent+import Data.Maybe (fromMaybe)  ##include "windows_cconv.h" @@ -344,6 +346,22 @@   failIfFalse_ (unwords ["GetBinaryType",show name]) $     c_GetBinaryType c_name p_btype   peek p_btype++-- | Get a unique temporary filename.+--+-- Calls 'GetTempFileNameW'.+getTempFileName :: String     -- ^ directory for the temporary file (must be at most MAX_PATH - 14 characters long)+                -> String     -- ^ prefix for the temporary file name+                -> Maybe UINT -- ^ if 'Nothing', a unique name is generated+                              --   otherwise a non-zero value is used as the unique part+                -> IO (String, UINT)+getTempFileName dir prefix unique = allocaBytes ((#const MAX_PATH) * sizeOf (undefined :: TCHAR)) $ \c_buf -> do+  uid <- withFilePath dir $ \c_dir ->+    withFilePath prefix $ \ c_prefix -> do+      failIfZero "getTempFileName" $+        c_GetTempFileNameW c_dir c_prefix (fromMaybe 0 unique) c_buf+  fname <- peekTString c_buf+  return (fname, uid)  ---------------------------------------------------------------- -- HANDLE operations

System/Win32/File/Internal.hsc view

@@ -399,6 +399,9 @@ foreign import WINDOWS_CCONV unsafe "windows.h GetFileInformationByHandle"     c_GetFileInformationByHandle :: HANDLE -> Ptr BY_HANDLE_FILE_INFORMATION -> IO BOOL +foreign import WINDOWS_CCONV unsafe "windows.h GetTempFileNameW"+    c_GetTempFileNameW :: LPCWSTR -> LPCWSTR -> UINT -> LPWSTR -> IO UINT+ ---------------------------------------------------------------- -- Read/write files ----------------------------------------------------------------

System/Win32/Types.hsc view

@@ -456,6 +456,8 @@ eRROR_PROC_NOT_FOUND :: ErrCode eRROR_PROC_NOT_FOUND = #const ERROR_PROC_NOT_FOUND +eERROR_ENVVAR_NOT_FOUND :: ErrCode+eERROR_ENVVAR_NOT_FOUND = #const ERROR_ENVVAR_NOT_FOUND  errorWin :: String -> IO a errorWin fn_name = do

System/Win32/WindowsString/Console.hsc view

@@ -1,3 +1,5 @@+{-# LANGUAGE PackageImports #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  System.Win32.WindowsString.Console@@ -51,7 +53,11 @@         getConsoleScreenBufferInfo,         getCurrentConsoleScreenBufferInfo,         getConsoleScreenBufferInfoEx,-        getCurrentConsoleScreenBufferInfoEx+        getCurrentConsoleScreenBufferInfoEx,++        -- * Env+        getEnv,+        getEnvironment   ) where  #include <windows.h>@@ -60,15 +66,36 @@ #include "wincon_compat.h"  import System.Win32.WindowsString.Types+import System.Win32.WindowsString.String (withTStringBufferLen) import System.Win32.Console.Internal-import System.Win32.Console hiding (getArgs, commandLineToArgv)+import System.Win32.Console hiding (getArgs, commandLineToArgv, getEnv, getEnvironment) import System.OsString.Windows+import System.OsString.Internal.Types +import Foreign.C.Types (CWchar)+import Foreign.C.String (CWString)+import Foreign.Ptr (plusPtr) import Foreign.Storable (Storable(..))-import Foreign.Marshal.Array (peekArray)+import Foreign.Marshal.Array (peekArray, peekArray0) import Foreign.Marshal.Alloc (alloca)+import GHC.IO (bracket)+import GHC.IO.Exception (IOException(..), IOErrorType(OtherError)) +import Prelude hiding (break, length, tail)+import qualified Prelude as P +#if !MIN_VERSION_filepath(1,5,0)+import Data.Coerce+import qualified "filepath" System.OsPath.Data.ByteString.Short.Word16 as BC++tail :: WindowsString -> WindowsString+tail = coerce BC.tail++break :: (WindowsChar -> Bool) -> WindowsString -> (WindowsString, WindowsString)+break = coerce BC.break+#endif++ -- | This function can be used to parse command line arguments and return --   the split up arguments as elements in a list. commandLineToArgv :: WindowsString -> IO [WindowsString]@@ -88,4 +115,66 @@ getArgs :: IO [WindowsString] getArgs = do   getCommandLineW >>= peekTString >>= commandLineToArgv+++-- c_GetEnvironmentVariableW :: LPCWSTR -> LPWSTR -> DWORD -> IO DWORD+getEnv :: WindowsString -> IO (Maybe WindowsString)+getEnv name =+  withTString name $ \c_name -> withTStringBufferLen maxLength $ \(buf, len) -> do+    let c_len = fromIntegral len+    c_len' <- c_GetEnvironmentVariableW c_name buf c_len+    case c_len' of+      0 -> do+        err_code <- getLastError+        if err_code  == eERROR_ENVVAR_NOT_FOUND+        then return Nothing+        else errorWin "GetEnvironmentVariableW"+      _ | c_len' > fromIntegral maxLength ->+            -- shouldn't happen, because we provide maxLength+            ioError (IOError Nothing OtherError "GetEnvironmentVariableW" ("Unexpected return code: " <> show c_len') Nothing Nothing)+        | otherwise -> do+            let len' = fromIntegral c_len'+            Just <$> peekTStringLen (buf, len')+ where+  -- according to https://learn.microsoft.com/en-us/windows/win32/api/processenv/nf-processenv-getenvironmentvariablew+  -- max characters (wide chars): 32767+  -- => bytes = 32767 * 2 = 65534+  -- +1 byte for NUL (although not needed I think)+  maxLength :: Int+  maxLength = 65535+++getEnvironment :: IO [(WindowsString, WindowsString)]+getEnvironment = bracket c_GetEnvironmentStringsW c_FreeEnvironmentStrings $ \lpwstr -> do+    strs <- builder lpwstr+    return (divvy <$> strs)+ where+  divvy :: WindowsString -> (WindowsString, WindowsString)+  divvy str =+    case break (== unsafeFromChar '=') str of+      (xs,ys)+        | ys == mempty -> (xs,ys) -- don't barf (like Posix.getEnvironment)+      (name, ys) -> let value = tail ys in (name,value)++  builder :: LPWSTR -> IO [WindowsString]+  builder ptr = go 0+   where+    go :: Int -> IO [WindowsString]+    go off = do+      (str, l) <- peekCWStringOff ptr off+      if l == 0+      then pure []+      else (str:) <$> go (((l + 1) * 2) + off)+++peekCWStringOff :: CWString -> Int -> IO (WindowsString, Int)+peekCWStringOff cp off = do+  cs <- peekArray0 wNUL (cp `plusPtr` off)+  return (cWcharsToChars cs, P.length cs)++wNUL :: CWchar+wNUL = 0++cWcharsToChars :: [CWchar] -> WindowsString+cWcharsToChars = pack . fmap (WindowsChar . fromIntegral)

System/Win32/WindowsString/File.hsc view

@@ -26,6 +26,7 @@     , setFileAttributes
     , getFileAttributes
     , getFileAttributesExStandard
+    , getTempFileName
     , findFirstChangeNotification
     , getFindDataFileName
     , findFirstFile
@@ -52,6 +53,7 @@   , setFileAttributes
   , getFileAttributes
   , getFileAttributesExStandard
+  , getTempFileName
   , findFirstChangeNotification
   , getFindDataFileName
   , findFirstFile
@@ -64,6 +66,7 @@ import System.Win32.WindowsString.Types
 import System.OsString.Windows
 import Unsafe.Coerce (unsafeCoerce)
+import Data.Maybe (fromMaybe)
 
 import Foreign hiding (void)
 
@@ -160,6 +163,23 @@     failIfFalseWithRetry_ "getFileAttributesExStandard" $
       c_GetFileAttributesEx c_name (unsafeCoerce getFileExInfoStandard) res
   peek res
+
+-- | Get a unique temporary filename.
+--
+-- Calls 'GetTempFileNameW'.
+getTempFileName :: WindowsString     -- ^ directory for the temporary file (must be at most MAX_PATH - 14 characters long)
+                -> WindowsString     -- ^ prefix for the temporary file name
+                -> Maybe UINT        -- ^ if 'Nothing', a unique name is generated
+                                     --   otherwise a non-zero value is used as the unique part
+                -> IO (WindowsString, UINT)
+getTempFileName dir prefix unique = allocaBytes ((#const MAX_PATH) * sizeOf (undefined :: TCHAR)) $ \c_buf -> do
+  uid <- withFilePath dir $ \c_dir ->
+    withFilePath prefix $ \ c_prefix -> do
+      failIfZero "getTempFileName" $
+        c_GetTempFileNameW c_dir c_prefix (fromMaybe 0 unique) c_buf
+  fname <- peekTString c_buf
+  pure (fname, uid)
+
 
 
 ----------------------------------------------------------------

System/Win32/WindowsString/String.hs view

@@ -30,7 +30,7 @@   )
 import System.Win32.WindowsString.Types
 import System.OsString.Internal.Types
-#if MIN_VERSION_filepath(1, 5, 0)
+#if MIN_VERSION_filepath(1,5,0)
 import qualified "os-string" System.OsString.Data.ByteString.Short as SBS
 #else
 import qualified "filepath" System.OsPath.Data.ByteString.Short as SBS

System/Win32/WindowsString/Types.hsc view

@@ -49,7 +49,7 @@ import System.OsPath.Windows (WindowsPath)
 import System.OsString.Windows (decodeWith, encodeWith)
 import System.OsString.Internal.Types
-#if MIN_VERSION_filepath(1, 5, 0)
+#if MIN_VERSION_filepath(1,5,0)
 import "os-string" System.OsString.Encoding.Internal (decodeWithBaseWindows)
 import qualified "os-string" System.OsString.Data.ByteString.Short.Word16 as SBS
 import "os-string" System.OsString.Data.ByteString.Short.Word16 (

Win32.cabal view

@@ -1,6 +1,6 @@ cabal-version:  2.0 name:           Win32-version:        2.14.0.0+version:        2.14.1.0 license:        BSD3 license-file:   LICENSE author:         Alastair Reid, shelarcy, Tamar Christina@@ -154,7 +154,6 @@         "user32", "gdi32", "winmm", "advapi32", "shell32", "shfolder", "shlwapi", "msimg32", "imm32"     ghc-options:      -Wall     include-dirs:     include-    includes:         "alphablend.h", "diatemp.h", "dumpBMP.h", "ellipse.h", "errors.h", "HsGDI.h", "HsWin32.h", "Win32Aux.h", "win32debug.h", "windows_cconv.h", "WndProc.h", "alignment.h"     install-includes: "HsWin32.h", "HsGDI.h", "WndProc.h", "windows_cconv.h", "alphablend.h", "wincon_compat.h", "winternl_compat.h", "winuser_compat.h", "winreg_compat.h", "tlhelp32_compat.h", "winnls_compat.h", "winnt_compat.h", "namedpipeapi_compat.h"     c-sources:         cbits/HsGDI.c

changelog.md view

@@ -1,5 +1,11 @@ # Changelog for [`Win32` package](http://hackage.haskell.org/package/Win32) +## 2.14.1.0 November 2024++* Add getTempFileName+* Add WindowsString variant for getEnv etc+* Implement getEnv and getEnvironment+ ## 2.14.0.0 January 2023  * Add support for named pipes [#220](https://github.com/haskell/win32/pull/220)