Win32 2.9.0.0 → 2.10.0.0

raw patch · 8 files changed

+913/−60 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Graphics/Win32/Window.hsc +5/−2
• System/Win32/Console.hsc +12/−12
• System/Win32/NLS.hsc +479/−30
• System/Win32/Time.hsc +54/−3
• System/Win32/Utils.hs +343/−9
• Win32.cabal +1/−1
• changelog.md +18/−2
• include/alphablend.h +1/−1

@@ -419,7 +419,7 @@   return size' foreign import WINDOWS_CCONV "windows.h GetWindowTextLengthW"   c_GetWindowTextLength :: HWND -> IO Int-+   ---------------------------------------------------------------- -- Paint struct ----------------------------------------------------------------@@ -471,6 +471,9 @@ foreign import WINDOWS_CCONV "windows.h ShowWindow"   showWindow :: HWND  -> ShowWindowControl  -> IO Bool +foreign import WINDOWS_CCONV "windows.h IsWindowVisible"+  isWindowVisible :: HWND -> IO Bool+ ---------------------------------------------------------------- -- Misc ----------------------------------------------------------------@@ -607,7 +610,7 @@  foreign import WINDOWS_CCONV unsafe "windows.h GetForegroundWindow"   getForegroundWindow :: IO HWND-+   getParent :: HWND -> IO HWND getParent wnd =   failIfNull "GetParent" $ c_GetParent wnd

@@ -170,8 +170,8 @@         (#poke CONSOLE_SCREEN_BUFFER_INFO, dwMaximumWindowSize) buf (dwMaximumWindowSize info)
 
 data COORD = COORD
-    { x :: SHORT
-    , y :: SHORT
+    { xPos :: SHORT
+    , yPos :: SHORT
     } deriving (Show, Eq)
 
 instance Storable COORD where
@@ -182,14 +182,14 @@         y' <- (#peek COORD, Y) buf
         return $ COORD x' y'
     poke buf coord = do
-        (#poke COORD, X) buf (x coord)
-        (#poke COORD, Y) buf (y coord)
+        (#poke COORD, X) buf (xPos coord)
+        (#poke COORD, Y) buf (yPos coord)
 
 data SMALL_RECT = SMALL_RECT
-    { left   :: SHORT
-    , top    :: SHORT
-    , right  :: SHORT
-    , bottom :: SHORT
+    { leftPos   :: SHORT
+    , topPos    :: SHORT
+    , rightPos  :: SHORT
+    , bottomPos :: SHORT
     } deriving (Show, Eq)
 
 instance Storable SMALL_RECT where
@@ -202,10 +202,10 @@         bottom' <- (#peek SMALL_RECT, Bottom) buf
         return $ SMALL_RECT left' top' right' bottom'
     poke buf small_rect = do
-        (#poke SMALL_RECT, Left) buf (left small_rect)
-        (#poke SMALL_RECT, Top) buf (top small_rect)
-        (#poke SMALL_RECT, Right) buf (right small_rect)
-        (#poke SMALL_RECT, Bottom) buf (bottom small_rect)
+        (#poke SMALL_RECT, Left) buf (leftPos small_rect)
+        (#poke SMALL_RECT, Top) buf (topPos small_rect)
+        (#poke SMALL_RECT, Right) buf (rightPos small_rect)
+        (#poke SMALL_RECT, Bottom) buf (bottomPos small_rect)
 
 foreign import WINDOWS_CCONV safe "windows.h GetConsoleScreenBufferInfo"
     c_GetConsoleScreenBufferInfo :: HANDLE -> Ptr CONSOLE_SCREEN_BUFFER_INFO -> IO BOOL

@@ -22,17 +22,42 @@         mAKELANGID, pRIMARYLANGID, sUBLANGID         ) where +import System.Win32.String (withTStringBufferLen) import System.Win32.Types+import System.Win32.Utils (trySized) +#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>), (<*>))+#endif+import Control.Monad (when)+import Data.IORef (modifyIORef, newIORef, readIORef) import Foreign import Foreign.C+import Text.Printf (printf)  ##include "windows_cconv.h" +-- Somewhere, WINVER and _WIN32_WINNT are being defined as less than 0x0600 -+-- that is, before Windows Vista. Support for Windows XP was dropped in+-- GHC 8.0.1 of May 2016. This forces them to be at least 0x0600.+#if WINVER < 0x0600+#undef WINVER+#define WINVER 0x0600+#endif+#if _WIN32_WINNT < 0x0600+#undef _WIN32_WINNT+#define _WIN32_WINNT 0x0600+#endif+ #include <windows.h>+#include "alignment.h" #include "errors.h" #include "win32debug.h"+#include "winnls_compat.h"+#include "winnt_compat.h" +type NLS_FUNCTION = DWORD+ #{enum LCID,  , lOCALE_SYSTEM_DEFAULT = LOCALE_SYSTEM_DEFAULT  , lOCALE_USER_DEFAULT   = LOCALE_USER_DEFAULT@@ -60,37 +85,237 @@  type LCTYPE = UINT +-- The following locale information constants are excluded from the `enum` list+-- below, for the reason indicated:+-- LOCALE_IDIALINGCODE -- Introduced in Windows 10 but not supported. Synonym+                       -- for LOCALE_ICOUNTRY.+-- LOCALE_INEGATIVEPERCENT -- Introduced in Windows 7 but not supported.+-- LOCALE_IPOSITIVEPERCENT -- Introduced in Windows 7 but not supported.+-- LOCALE_IREADINGLAYOUT -- Introduced in Windows 7 but not supported.+-- LOCALE_SAM -- Introduced by Windows 10 but not supported. Synonyn for+              -- LOCALE_S1159.+-- LOCALE_SENGLISHDISPLAYNAME -- Introduced in Windows 7 but not supported.+-- LOCALE_SIETFLANGUAGE -- Not supported (deprecated from Windows Vista).+-- LOCALE_SNATIVEDISPLAYNAME -- Introduced in Windows 7 but not supported.+-- LOCALE_SNATIVELANGUAGENAME -- Introduced in Windows 7 but not supported.+-- LOCALE_SPERCENT -- Introduced in Windows 7 but not supported.+-- LOCALE_SPM -- Introduced in Windows 10 but not supported. Synonym for+              -- LOCALE_S2359.+-- LOCALE_SSHORTESTAM -- Not supported.+-- LOCALE_SSHORTESTPM -- Not supported.+-- LOCALE_SSHORTTIME -- Introduced in Windows 7 but not supported.++-- The following locale information constant is included in the list below, but+-- note:+-- LOCALE_IINTLCURRDIGITS -- Not supported by Windows 10, use+                          -- LOCALE_ICURRDIGITS.+ #{enum LCTYPE,+ , lOCALE_FONTSIGNATURE = LOCALE_FONTSIGNATURE  , lOCALE_ICALENDARTYPE = LOCALE_ICALENDARTYPE- , lOCALE_SDATE         = LOCALE_SDATE+ , lOCALE_ICENTURY      = LOCALE_ICENTURY+ , lOCALE_ICOUNTRY      = LOCALE_ICOUNTRY  , lOCALE_ICURRDIGITS   = LOCALE_ICURRDIGITS- , lOCALE_SDECIMAL      = LOCALE_SDECIMAL  , lOCALE_ICURRENCY     = LOCALE_ICURRENCY- , lOCALE_SGROUPING     = LOCALE_SGROUPING+ , lOCALE_IDATE         = LOCALE_IDATE+ , lOCALE_IDAYLZERO     = LOCALE_IDAYLZERO+ , lOCALE_IDEFAULTANSICODEPAGE = LOCALE_IDEFAULTANSICODEPAGE+ , lOCALE_IDEFAULTCODEPAGE = LOCALE_IDEFAULTCODEPAGE+ , lOCALE_IDEFAULTCOUNTRY = LOCALE_IDEFAULTCOUNTRY+ , lOCALE_IDEFAULTEBCDICCODEPAGE = LOCALE_IDEFAULTEBCDICCODEPAGE+ , lOCALE_IDEFAULTLANGUAGE = LOCALE_IDEFAULTLANGUAGE+ , lOCALE_IDEFAULTMACCODEPAGE = LOCALE_IDEFAULTMACCODEPAGE  , lOCALE_IDIGITS       = LOCALE_IDIGITS- , lOCALE_SLIST         = LOCALE_SLIST+ , lOCALE_IDIGITSUBSTITUTION = LOCALE_IDIGITSUBSTITUTION  , lOCALE_IFIRSTDAYOFWEEK = LOCALE_IFIRSTDAYOFWEEK- , lOCALE_SLONGDATE     = LOCALE_SLONGDATE  , lOCALE_IFIRSTWEEKOFYEAR = LOCALE_IFIRSTWEEKOFYEAR- , lOCALE_SMONDECIMALSEP = LOCALE_SMONDECIMALSEP+ , lOCALE_IGEOID        = LOCALE_IGEOID+ , lOCALE_IINTLCURRDIGITS = LOCALE_IINTLCURRDIGITS+ , lOCALE_ILANGUAGE     = LOCALE_ILANGUAGE+ , lOCALE_ILDATE        = LOCALE_ILDATE  , lOCALE_ILZERO        = LOCALE_ILZERO- , lOCALE_SMONGROUPING  = LOCALE_SMONGROUPING  , lOCALE_IMEASURE      = LOCALE_IMEASURE- , lOCALE_SMONTHOUSANDSEP = LOCALE_SMONTHOUSANDSEP+ , lOCALE_IMONLZERO     = LOCALE_IMONLZERO  , lOCALE_INEGCURR      = LOCALE_INEGCURR- , lOCALE_SNEGATIVESIGN = LOCALE_SNEGATIVESIGN  , lOCALE_INEGNUMBER    = LOCALE_INEGNUMBER+ , lOCALE_INEGSEPBYSPACE = LOCALE_INEGSEPBYSPACE+ , lOCALE_INEGSIGNPOSN   = LOCALE_INEGSIGNPOSN+ , lOCALE_INEGSYMPRECEDES = LOCALE_INEGSYMPRECEDES+ , lOCALE_IOPTIONALCALENDAR = LOCALE_IOPTIONALCALENDAR+ , lOCALE_PAPERSIZE     = LOCALE_IPAPERSIZE+ , lOCALE_IPOSSEPBYSPACE = LOCALE_IPOSSEPBYSPACE+ , lOCALE_IPOSSIGNPOSN  = LOCALE_IPOSSIGNPOSN+ , lOCALE_IPSSYMPRECEDES = LOCALE_IPOSSYMPRECEDES+ , lOCALE_ITIME         = LOCALE_ITIME+ , lOCALE_ITIMEMARKPOSN = LOCALE_ITIMEMARKPOSN+ , lOCALE_ITLZERO       = LOCALE_ITLZERO+ , lOCALE_RETURN_NUMBER = LOCALE_RETURN_NUMBER+ , lOCALE_S1159         = LOCALE_S1159+ , lOCALE_S2359         = LOCALE_S2359+ , lOCALE_SABBREVCTRYNAME = LOCALE_SABBREVCTRYNAME+ , lOCALE_SABBREVDAYNAME1 = LOCALE_SABBREVDAYNAME1+ , lOCALE_SABBREVDAYNAME2 = LOCALE_SABBREVDAYNAME2+ , lOCALE_SABBREVDAYNAME3 = LOCALE_SABBREVDAYNAME3+ , lOCALE_SABBREVDAYNAME4 = LOCALE_SABBREVDAYNAME4+ , lOCALE_SABBREVDAYNAME5 = LOCALE_SABBREVDAYNAME5+ , lOCALE_SABBREVDAYNAME6 = LOCALE_SABBREVDAYNAME6+ , lOCALE_SABBREVDAYNAME7 = LOCALE_SABBREVDAYNAME7+ , lOCALE_SABBREVLANGNAME = LOCALE_SABBREVLANGNAME+ , lOCALE_SABBREVMONTHNAME1 = LOCALE_SABBREVMONTHNAME1+ , lOCALE_SABBREVMONTHNAME2 = LOCALE_SABBREVMONTHNAME2+ , lOCALE_SABBREVMONTHNAME3 = LOCALE_SABBREVMONTHNAME3+ , lOCALE_SABBREVMONTHNAME4 = LOCALE_SABBREVMONTHNAME4+ , lOCALE_SABBREVMONTHNAME5 = LOCALE_SABBREVMONTHNAME5+ , lOCALE_SABBREVMONTHNAME6 = LOCALE_SABBREVMONTHNAME6+ , lOCALE_SABBREVMONTHNAME7 = LOCALE_SABBREVMONTHNAME7+ , lOCALE_SABBREVMONTHNAME8 = LOCALE_SABBREVMONTHNAME8+ , lOCALE_SABBREVMONTHNAME9 = LOCALE_SABBREVMONTHNAME9+ , lOCALE_SABBREVMONTHNAME10 = LOCALE_SABBREVMONTHNAME10+ , lOCALE_SABBREVMONTHNAME11 = LOCALE_SABBREVMONTHNAME11+ , lOCALE_SABBREVMONTHNAME12 = LOCALE_SABBREVMONTHNAME12+ , lOCALE_SABBREVMONTHNAME13 = LOCALE_SABBREVMONTHNAME13+ , lOCALE_SCONSOLEFALLBACKNAME = LOCALE_SCONSOLEFALLBACKNAME+ , lOCALE_SCURRENCY     = LOCALE_SCURRENCY+ , lOCALE_SDATE         = LOCALE_SDATE+ , lOCALE_SDAYNAME1     = LOCALE_SDAYNAME1+ , lOCALE_SDAYNAME2     = LOCALE_SDAYNAME2+ , lOCALE_SDAYNAME3     = LOCALE_SDAYNAME3+ , lOCALE_SDAYNAME4     = LOCALE_SDAYNAME4+ , lOCALE_SDAYNAME5     = LOCALE_SDAYNAME5+ , lOCALE_SDAYNAME6     = LOCALE_SDAYNAME6+ , lOCALE_SDAYNAME7     = LOCALE_SDAYNAME7+ , lOCALE_SDECIMAL      = LOCALE_SDECIMAL+ , lOCALE_SDURATION     = LOCALE_SDURATION+ , lOCALE_SENGCURRNAME  = LOCALE_SENGCURRNAME+ , lOCALE_SENGLISHCOUNTRYNAME = LOCALE_SENGLISHCOUNTRYNAME+ , lOCALE_SENGLISHLANGUAGENAME = LOCALE_SENGLISHLANGUAGENAME+ , lOCALE_SGROUPING     = LOCALE_SGROUPING+ , lOCALE_SINTLSYMBOL   = LOCALE_SINTLSYMBOL+ , lOCALE_SISO3166CTRYNAME = LOCALE_SISO3166CTRYNAME+ , lOCALE_SISO3166CTRYNAME2 = LOCALE_SISO3166CTRYNAME2+ , lOCALE_SISO639LANGNAME = LOCALE_SISO639LANGNAME+ , lOCALE_SISO639LANGNAME2 = LOCALE_SISO639LANGNAME2+ , lOCALE_SKEYBOARDSTOINSTALL = LOCALE_SKEYBOARDSTOINSTALL+ , lOCALE_SLIST         = LOCALE_SLIST+ , lOCALE_SLONGDATE     = LOCALE_SLONGDATE+ , lOCALE_SMONDECIMALSEP = LOCALE_SMONDECIMALSEP+ , lOCALE_SMONGROUPING  = LOCALE_SMONGROUPING+ , lOCALE_SMONTHNAME1   = LOCALE_SMONTHNAME1+ , lOCALE_SMONTHNAME2   = LOCALE_SMONTHNAME2+ , lOCALE_SMONTHNAME3   = LOCALE_SMONTHNAME3+ , lOCALE_SMONTHNAME4   = LOCALE_SMONTHNAME4+ , lOCALE_SMONTHNAME5   = LOCALE_SMONTHNAME5+ , lOCALE_SMONTHNAME6   = LOCALE_SMONTHNAME6+ , lOCALE_SMONTHNAME7   = LOCALE_SMONTHNAME7+ , lOCALE_SMONTHNAME8   = LOCALE_SMONTHNAME8+ , lOCALE_SMONTHNAME9   = LOCALE_SMONTHNAME9+ , lOCALE_SMONTHNAME10  = LOCALE_SMONTHNAME10+ , lOCALE_SMONTHNAME11  = LOCALE_SMONTHNAME11+ , lOCALE_SMONTHNAME12  = LOCALE_SMONTHNAME12+ , lOCALE_SMONTHNAME13  = LOCALE_SMONTHNAME13+ , lOCALE_SMONTHOUSANDSEP = LOCALE_SMONTHOUSANDSEP+ , lOCALE_SNAME         = LOCALE_SNAME+ , lOCALE_SNAN          = LOCALE_SNAN+ , lOCALE_SNATIVECOUNTRYNAME = LOCALE_SNATIVECOUNTRYNAME+ , lOCALE_SNATIVECURRNAME = LOCALE_SNATIVECURRNAME+ , lOCALE_SNATIVEDIGITS = LOCALE_SNATIVEDIGITS+ , lOCALE_SNEGATIVESIGN = LOCALE_SNEGATIVESIGN+ , lOCALE_SNEGINFINITY  = LOCALE_SNEGINFINITY+ , lOCALE_SPARENT       = LOCALE_SPARENT+ , lOCALE_SPOSINFINITY  = LOCALE_SPOSINFINITY  , lOCALE_SPOSITIVESIGN = LOCALE_SPOSITIVESIGN+ , lOCALE_SSCRIPTS      = LOCALE_SSCRIPTS  , lOCALE_SSHORTDATE    = LOCALE_SSHORTDATE- , lOCALE_ITIME         = LOCALE_ITIME+ , lOCALE_SSHORTESTDAYNAME1 = LOCALE_SSHORTESTDAYNAME1+ , lOCALE_SSHORTESTDAYNAME2 = LOCALE_SSHORTESTDAYNAME2+ , lOCALE_SSHORTESTDAYNAME3 = LOCALE_SSHORTESTDAYNAME3+ , lOCALE_SSHORTESTDAYNAME4 = LOCALE_SSHORTESTDAYNAME4+ , lOCALE_SSHORTESTDAYNAME5 = LOCALE_SSHORTESTDAYNAME5+ , lOCALE_SSHORTESTDAYNAME6 = LOCALE_SSHORTESTDAYNAME6+ , lOCALE_SSHORTESTDAYNAME7 = LOCALE_SSHORTESTDAYNAME7+ , lOCALE_SSORTNAME     = LOCALE_SSORTNAME  , lOCALE_STHOUSAND     = LOCALE_STHOUSAND- , lOCALE_S1159         = LOCALE_S1159  , lOCALE_STIME         = LOCALE_STIME- , lOCALE_S2359         = LOCALE_S2359  , lOCALE_STIMEFORMAT   = LOCALE_STIMEFORMAT- , lOCALE_SCURRENCY     = LOCALE_SCURRENCY+ , lOCALE_SYEARMONTH    = LOCALE_SYEARMONTH  } +-- |Type representing locale data+data LCData+  -- | Data in the form of a Unicode string.+  = LCTextualData !String+  -- | Data in the form of a number. See 'lOCAL_RETURN_NUMBER' and @LOCAL_I*@+  -- locate information constants.+  | LCNumericData !DWORD+  -- | Data in the fomr of a 'LOCALESIGNATURE'. See 'lOCAL_FONTSIGNATURE' locale+  -- information constant.+  | LCSignatureData !LOCALESIGNATURE+  deriving (Eq, Show)++data LOCALESIGNATURE = LOCALESIGNATURE+  { lsUsb :: !UnicodeSubsetBitfield+  , lsCsbDefault :: !DDWORD+  , lsCsbSupported :: !DDWORD+  } deriving (Eq, Show)++instance Storable LOCALESIGNATURE where+  sizeOf = const #{size LOCALESIGNATURE}+  alignment _ = #alignment LOCALESIGNATURE+  peek buf = do+    lsUsb'          <- (#peek LOCALESIGNATURE, lsUsb) buf+    lsCsbDefault'   <- (#peek LOCALESIGNATURE, lsCsbDefault) buf+    lsCsbSupported' <- (#peek LOCALESIGNATURE, lsCsbSupported) buf+    return $ LOCALESIGNATURE lsUsb' lsCsbDefault' lsCsbSupported'+  poke buf info = do+    (#poke LOCALESIGNATURE, lsUsb) buf (lsUsb info)+    (#poke LOCALESIGNATURE, lsCsbDefault) buf (lsCsbDefault info)+    (#poke LOCALESIGNATURE, lsCsbSupported) buf (lsCsbSupported info)++-- | Type representing 128-bit Unicode subset bitfields, as the @base@ package+-- does include a module exporting a 128-bit unsigned integer type.+data UnicodeSubsetBitfield = UnicodeSubsetBitfield+  { usbLow :: !DDWORD+  , usbHigh :: !DDWORD+  } deriving (Eq, Show)++instance Storable UnicodeSubsetBitfield where+  sizeOf _ = 2 * sizeOf (undefined :: DDWORD)+  alignment _ = alignment (undefined :: DWORD)+  peek buf = do+    usbLow'  <- (peekByteOff buf 0 :: IO DDWORD)+    usbHigh' <- (peekByteOff buf (sizeOf (undefined :: DDWORD)) :: IO DDWORD)+    return $ UnicodeSubsetBitfield usbLow' usbHigh'+  poke buf info = do+    pokeByteOff buf 0 (usbLow info)+    pokeByteOff buf (sizeOf (undefined :: DDWORD)) (usbHigh info)++getLocaleInfoEx :: Maybe String -> LCTYPE -> IO LCData+getLocaleInfoEx locale ty+  | ty == lOCALE_FONTSIGNATURE =+      getLocaleInfoEx' LCSignatureData localSigCharCount++  | ty .&. lOCALE_RETURN_NUMBER /= 0 =+      getLocaleInfoEx' LCNumericData dWORDCharCount++  | otherwise = maybeWith withTString locale $ \c_locale ->+      LCTextualData <$> trySized cFuncName (c_GetLocaleInfoEx c_locale ty)+ where+  cFuncName = "GetLocaleInfoEx"+  -- See https://docs.microsoft.com/en-us/windows/win32/api/winnls/nf-winnls-getlocaleinfoex+  localSigCharCount = (#size LOCALESIGNATURE) `div` (#size WCHAR)+  dWORDCharCount = (#size DWORD) `div` (#size WCHAR)++  getLocaleInfoEx' constructor bufSize = maybeWith withTString locale $+    \c_locale -> do+      value <- alloca $ \buf -> do+        _ <- failIfZero cFuncName+          $ c_GetLocaleInfoEx c_locale ty (castPtr buf) bufSize+        peek buf+      return $ constructor value++foreign import WINDOWS_CCONV unsafe "windows.h GetLocaleInfoEx"+  c_GetLocaleInfoEx :: LPCWSTR -> LCTYPE -> LPWSTR -> CInt -> IO CInt+ setLocaleInfo :: LCID -> LCTYPE -> String -> IO () setLocaleInfo locale ty info =   withTString info $ \ c_info ->@@ -101,25 +326,153 @@ type LCMapFlags = DWORD  #{enum LCMapFlags,- , lCMAP_BYTEREV        = LCMAP_BYTEREV- , lCMAP_FULLWIDTH      = LCMAP_FULLWIDTH- , lCMAP_HALFWIDTH      = LCMAP_HALFWIDTH- , lCMAP_HIRAGANA       = LCMAP_HIRAGANA- , lCMAP_KATAKANA       = LCMAP_KATAKANA- , lCMAP_LOWERCASE      = LCMAP_LOWERCASE- , lCMAP_SORTKEY        = LCMAP_SORTKEY- , lCMAP_UPPERCASE      = LCMAP_UPPERCASE- , nORM_IGNORECASE      = NORM_IGNORECASE- , nORM_IGNORENONSPACE  = NORM_IGNORENONSPACE- , nORM_IGNOREKANATYPE  = NORM_IGNOREKANATYPE- , nORM_IGNORESYMBOLS   = NORM_IGNORESYMBOLS- , nORM_IGNOREWIDTH     = NORM_IGNOREWIDTH- , sORT_STRINGSORT      = SORT_STRINGSORT- , lCMAP_LINGUISTIC_CASING      = LCMAP_LINGUISTIC_CASING- , lCMAP_SIMPLIFIED_CHINESE     = LCMAP_SIMPLIFIED_CHINESE- , lCMAP_TRADITIONAL_CHINESE    = LCMAP_TRADITIONAL_CHINESE+ , lCMAP_BYTEREV              = LCMAP_BYTEREV+ , lCMAP_FULLWIDTH            = LCMAP_FULLWIDTH+ , lCMAP_HALFWIDTH            = LCMAP_HALFWIDTH+ , lCMAP_HIRAGANA             = LCMAP_HIRAGANA+ , lCMAP_KATAKANA             = LCMAP_KATAKANA+ , lCMAP_LINGUISTIC_CASING    = LCMAP_LINGUISTIC_CASING+ , lCMAP_LOWERCASE            = LCMAP_LOWERCASE+ , lCMAP_SIMPLIFIED_CHINESE   = LCMAP_SIMPLIFIED_CHINESE+ , lCMAP_SORTKEY              = LCMAP_SORTKEY+ , lCMAP_TRADITIONAL_CHINESE  = LCMAP_TRADITIONAL_CHINESE+ , lCMAP_UPPERCASE            = LCMAP_UPPERCASE+ , lINGUISTIC_IGNORECASE      = LINGUISTIC_IGNORECASE+ , lINGUISTIC_IGNOREDIACRITIC = LINGUISTIC_IGNOREDIACRITIC+ , nORM_IGNORECASE            = NORM_IGNORECASE+ , nORM_IGNORENONSPACE        = NORM_IGNORENONSPACE+ , nORM_IGNOREKANATYPE        = NORM_IGNOREKANATYPE+ , nORM_IGNORESYMBOLS         = NORM_IGNORESYMBOLS+ , nORM_IGNOREWIDTH           = NORM_IGNOREWIDTH+ , nORM_LINGUISTIC_CASING     = NORM_LINGUISTIC_CASING+ , sORT_STRINGSORT            = SORT_STRINGSORT  } +data NLSVERSIONINFOEX = NLSVERSIONINFOEX+  { dwNLSVersionInfoSize :: DWORD+  , dwNLSVersion :: DWORD+  , dwDefinedVersion :: DWORD+  , dwEffectiveId :: DWORD+  , guidCustomVersion :: GUID+  } deriving (Eq, Show)++instance Storable NLSVERSIONINFOEX where+  sizeOf = const #{size NLSVERSIONINFOEX}+  alignment _ = #alignment NLSVERSIONINFOEX+  peek buf = do+    dwNLSVersionInfoSize' <- (#peek NLSVERSIONINFOEX, dwNLSVersionInfoSize) buf+    dwNLSVersion' <- (#peek NLSVERSIONINFOEX, dwNLSVersion) buf+    dwDefinedVersion' <- (#peek NLSVERSIONINFOEX, dwDefinedVersion) buf+    dwEffectiveId' <- (#peek NLSVERSIONINFOEX, dwEffectiveId) buf+    guidCustomVersion' <- (#peek NLSVERSIONINFOEX, guidCustomVersion) buf+    return $ NLSVERSIONINFOEX dwNLSVersionInfoSize' dwNLSVersion'+               dwDefinedVersion' dwEffectiveId' guidCustomVersion'+  poke buf info = do+    (#poke NLSVERSIONINFOEX, dwNLSVersionInfoSize) buf+      (dwNLSVersionInfoSize info)+    (#poke NLSVERSIONINFOEX, dwNLSVersion) buf (dwNLSVersion info)+    (#poke NLSVERSIONINFOEX, dwDefinedVersion) buf (dwDefinedVersion info)+    (#poke NLSVERSIONINFOEX, dwEffectiveId) buf (dwEffectiveId info)+    (#poke NLSVERSIONINFOEX, guidCustomVersion) buf (guidCustomVersion info)++-- Based on the `UnpackedUUID` type of package `uuid-types`.+data GUID = GUID+  !Word32+  !Word16+  !Word16+  !Word8+  !Word8+  !Word8+  !Word8+  !Word8+  !Word8+  !Word8+  !Word8+  deriving (Eq)++instance Show GUID where+  show (GUID data1 data2 data3 b1 b2 b3 b4 b5 b6 b7 b8) =+    printf "{%.8x-%.4x-%.4x-%.2x%2x-%.2x%.2x%.2x%.2x%.2x%.2x}" data1 data2 data3 b1 b2 b3 b4 b5 b6 b7 b8++instance Storable GUID where+  sizeOf _ = 16+  alignment _ = 4+  peekByteOff p off = GUID+    <$> peekByteOff p off+    <*> peekByteOff p (off + 4)+    <*> peekByteOff p (off + 6)+    <*> peekByteOff p (off + 8)+    <*> peekByteOff p (off + 9)+    <*> peekByteOff p (off + 10)+    <*> peekByteOff p (off + 11)+    <*> peekByteOff p (off + 12)+    <*> peekByteOff p (off + 13)+    <*> peekByteOff p (off + 14)+    <*> peekByteOff p (off + 15)+  pokeByteOff p off (GUID data1 data2 data3 b1 b2 b3 b4 b5 b6 b7 b8) = do+    pokeByteOff p off data1+    pokeByteOff p (off + 4) data2+    pokeByteOff p (off + 6) data3+    pokeByteOff p (off + 8) b1+    pokeByteOff p (off + 9) b2+    pokeByteOff p (off + 10) b3+    pokeByteOff p (off + 11) b4+    pokeByteOff p (off + 12) b5+    pokeByteOff p (off + 13) b6+    pokeByteOff p (off + 14) b7+    pokeByteOff p (off + 15) b8++getNLSVersionEx :: Maybe String -> IO NLSVERSIONINFOEX+getNLSVersionEx locale = maybeWith withTString locale $ \c_locale ->+  with defaultVersionInfo $ \c_versionInfo -> do+    failIfFalse_ "GetNLSVersionEx" $+      c_GetNLSVersionEx function c_locale c_versionInfo+    peek c_versionInfo+ where+  function = #{const COMPARE_STRING}+  defaultVersionInfo = NLSVERSIONINFOEX+    { dwNLSVersionInfoSize = #{size NLSVERSIONINFOEX}+    , dwNLSVersion = 0+    , dwDefinedVersion = 0+    , dwEffectiveId = 0+    , guidCustomVersion = GUID 0 0 0 0 0 0 0 0 0 0 0+    }+foreign import WINDOWS_CCONV unsafe "windows.h GetNLSVersionEx"+  c_GetNLSVersionEx :: NLS_FUNCTION+                    -> LPCWSTR+                    -> Ptr NLSVERSIONINFOEX+                    -> IO Bool++lCMapStringEx :: Maybe String+              -> LCMapFlags+              -> String+              -> NLSVERSIONINFOEX+              -> IO String+lCMapStringEx locale flags src versionInfo =+  maybeWith withTString locale $ \c_locale ->+    withTStringLen src $ \(c_src, src_len) ->+      with versionInfo $ \c_versionInfo -> do+        let c_src_len = fromIntegral src_len+            c_func s l = c_LCMapStringEx c_locale+                                         flags+                                         c_src c_src_len+                                         s l+                                         c_versionInfo+                                         nullPtr -- Reserved, must be NULL+                                         0 -- Reserved, must be 0+        trySized "LCMapStringEx" c_func+foreign import WINDOWS_CCONV unsafe "windows.h LCMapStringEx"+  c_LCMapStringEx :: LPCWSTR+                  -> LCMapFlags+                  -> LPCWSTR+                  -> CInt+                  -> LPWSTR+                  -> CInt+                  -> Ptr NLSVERSIONINFOEX+                  -> LPVOID+                  -> LPARAM+                  -> IO CInt+ lCMapString :: LCID -> LCMapFlags -> String -> Int -> IO String lCMapString locale flags src dest_size =   withTStringLen src $ \ (c_src, src_len) ->@@ -137,9 +490,63 @@  , lCID_SUPPORTED       = LCID_SUPPORTED  } +isValidLocaleName :: Maybe String -> IO Bool+isValidLocaleName lpLocaleName =+  maybeWith withTString lpLocaleName c_IsValidLocaleName+foreign import WINDOWS_CCONV unsafe "windows.h IsValidLocaleName"+  c_IsValidLocaleName :: LPCWSTR -> IO Bool+ foreign import WINDOWS_CCONV unsafe "windows.h IsValidLocale"   isValidLocale :: LCID -> LocaleTestFlags -> IO Bool +type EnumLocalesFlag = DWORD++-- The following locale enumeration flag constants are excluded from the `enum`+-- list below, for the reason indicated:+-- LOCALE_NEUTRALDATA -- Introduced in Windows 7 but not supported.++#{enum EnumLocalesFlag,+ , lOCALE_ALL             = LOCALE_ALL+ , lOCALE_ALTERNATE_SORTS = LOCALE_ALTERNATE_SORTS+ , lOCALE_REPLACEMENT     = LOCALE_REPLACEMENT+ , lOCALE_SUPPLEMENTAL    = LOCALE_SUPPLEMENTAL+ , lOCALE_WINDOWS         = LOCALE_WINDOWS+ }++type LOCALE_ENUMPROCEX = LPWSTR -> EnumLocalesFlag -> LPARAM -> IO BOOL+foreign import WINDOWS_CCONV "wrapper"+  mkLOCALE_ENUMPROCEX :: LOCALE_ENUMPROCEX -> IO (FunPtr LOCALE_ENUMPROCEX)++enumSystemLocalesEx :: LOCALE_ENUMPROCEX -> EnumLocalesFlag -> LPARAM -> IO ()+enumSystemLocalesEx callback dwFlags lParam = do+  c_callback <- mkLOCALE_ENUMPROCEX callback+  failIfFalse_ "EnumSystemLocalesEx" $+    c_EnumSystemLocalesEx c_callback dwFlags lParam nullPtr+  freeHaskellFunPtr c_callback+foreign import WINDOWS_CCONV safe "windows.h EnumSystemLocalesEx"+  c_EnumSystemLocalesEx :: (FunPtr LOCALE_ENUMPROCEX)+                        -> DWORD+                        -> LPARAM+                        -> LPVOID+                        -> IO Bool++enumSystemLocalesEx' :: EnumLocalesFlag+                     -> Maybe Bool+                     -- ^ Maybe include (or exclude) replacement locales?+                     -> IO [String]+enumSystemLocalesEx' dwFlags mIsReplacement = do+  store <- newIORef []+  let localeEnumProcEx c_locale arg2 _ = do+        locale <- peekTString c_locale+        case mIsReplacement of+          Nothing -> modifyIORef store (locale:)+          Just isReplacement ->+            when (isReplacement == (arg2 .&. lOCALE_REPLACEMENT /= 0)) $+              modifyIORef store (locale:)+        return True+  enumSystemLocalesEx localeEnumProcEx dwFlags 0+  reverse <$> readIORef store+ foreign import WINDOWS_CCONV unsafe "windows.h IsValidCodePage"   isValidCodePage :: CodePage -> IO Bool @@ -149,6 +556,42 @@ foreign import WINDOWS_CCONV unsafe "windows.h GetUserDefaultLangID"   getUserDefaultLangID :: LANGID +-- #define LOCALE_NAME_INVARIANT L""+lOCALE_NAME_INVARIANT :: Maybe String+lOCALE_NAME_INVARIANT = Just ""++ -- #define LOCALE_NAME_SYSTEM_DEFAULT L"!x-sys-default-locale"+lOCALE_NAME_SYSTEM_DEFAULT :: Maybe String+lOCALE_NAME_SYSTEM_DEFAULT = Just "!x-sys-default-locale"++ -- #define LOCALE_NAME_USER_DEFAULT NULL+lOCALE_NAME_USER_DEFAULT :: Maybe String+lOCALE_NAME_USER_DEFAULT = Nothing++getUserDefaultLocaleName :: IO String+getUserDefaultLocaleName =+  getDefaultLocaleName "GetUserDefaultLocaleName" c_GetUserDefaultLocaleName+foreign import WINDOWS_CCONV unsafe "windows.h GetUserDefaultLocaleName"+  c_GetUserDefaultLocaleName :: LPWSTR -> CInt -> IO CInt++#{enum CInt,+ , lOCALE_NAME_MAX_LENGTH = LOCALE_NAME_MAX_LENGTH+ }++-- |Helper function for use with 'c_GetUserDefaultLocaleName' or+-- 'c_GetSystemDefaultLocaleName'. See 'getUserDefaultLocaleName' and+-- 'getSystemUserDefaultLocaleName'.+getDefaultLocaleName :: String -> (LPWSTR -> CInt -> IO CInt) -> IO String+getDefaultLocaleName cDefaultLocaleFuncName cDefaultLocaleFunc =+  withTStringBufferLen maxLength $ \(buf, len) -> do+    let c_len = fromIntegral len+    c_len' <- failIfZero cDefaultLocaleFuncName $+      cDefaultLocaleFunc buf c_len+    let len' = fromIntegral c_len'+    peekTStringLen (buf, len' - 1) -- Drop final null character+ where+  maxLength = fromIntegral lOCALE_NAME_MAX_LENGTH+ foreign import WINDOWS_CCONV unsafe "windows.h GetThreadLocale"   getThreadLocale :: IO LCID @@ -157,6 +600,12 @@  foreign import WINDOWS_CCONV unsafe "windows.h GetSystemDefaultLangID"   getSystemDefaultLangID :: LANGID++getSystemDefaultLocaleName :: IO String+getSystemDefaultLocaleName =+  getDefaultLocaleName "GetSystemDefaultLocaleName" c_GetSystemDefaultLocaleName+foreign import WINDOWS_CCONV unsafe "windows.h GetSystemDefaultLocaleName"+  c_GetSystemDefaultLocaleName :: LPWSTR -> CInt -> IO CInt  foreign import WINDOWS_CCONV unsafe "windows.h GetOEMCP"   getOEMCP :: CodePage

@@ -18,9 +18,12 @@ ----------------------------------------------------------------------------- module System.Win32.Time where -import System.Win32.Types   ( DWORD, WORD, LONG, BOOL, failIf, failIf_, HANDLE-                            , peekTStringLen, LCID, LPTSTR, LPCTSTR, DDWORD-                            , LARGE_INTEGER, ddwordToDwords, dwordsToDdword )+import System.Win32.String  ( peekTStringLen, withTString )+import System.Win32.Types   ( BOOL, DDWORD, DWORD, HANDLE, LARGE_INTEGER, LCID+                            , LONG, LPCTSTR, LPCWSTR, LPTSTR, LPWSTR, UINT, WORD+                            , dwordsToDdword, ddwordToDwords, failIf+                            , failIfFalse_, failIf_ )+import System.Win32.Utils   ( trySized )  import Control.Monad    ( when, liftM3, liftM ) import Data.Word        ( Word8 )@@ -35,6 +38,7 @@ ##include "windows_cconv.h" #include <windows.h> #include "alignment.h"+#include "winnls_compat.h"  ---------------------------------------------------------------- -- data types@@ -59,6 +63,8 @@ data TimeZoneId = TzIdUnknown | TzIdStandard | TzIdDaylight     deriving (Show, Eq, Ord) +data LASTINPUTINFO = LASTINPUTINFO DWORD deriving (Show)+ ---------------------------------------------------------------- -- Instances ----------------------------------------------------------------@@ -128,6 +134,16 @@         dnam <- peekCWString (plusPtr buf (#offset TIME_ZONE_INFORMATION, DaylightName))         return $ TIME_ZONE_INFORMATION bias snam sdat sbia dnam ddat dbia +instance Storable LASTINPUTINFO where+    sizeOf = const (#size LASTINPUTINFO)+    alignment = sizeOf+    poke buf (LASTINPUTINFO t) = do+        (#poke LASTINPUTINFO, cbSize) buf ((#size LASTINPUTINFO) :: UINT)+        (#poke LASTINPUTINFO, dwTime) buf t+    peek buf = do+        t <- (#peek LASTINPUTINFO, dwTime) buf+        return $ LASTINPUTINFO t+ foreign import WINDOWS_CCONV "windows.h GetSystemTime"     c_GetSystemTime :: Ptr SYSTEMTIME -> IO () getSystemTime :: IO SYSTEMTIME@@ -177,6 +193,21 @@  foreign import WINDOWS_CCONV "windows.h GetTickCount" getTickCount :: IO DWORD +foreign import WINDOWS_CCONV unsafe "windows.h GetLastInputInfo"+  c_GetLastInputInfo :: Ptr LASTINPUTINFO -> IO Bool+getLastInputInfo :: IO DWORD+getLastInputInfo =+  with (LASTINPUTINFO 0) $ \lii_p -> do+  failIfFalse_ "GetLastInputInfo" $ c_GetLastInputInfo lii_p+  LASTINPUTINFO lii <- peek lii_p+  return lii++getIdleTime :: IO Integer+getIdleTime = do+  lii <- getLastInputInfo+  now <- getTickCount+  return $ fromIntegral $ now - lii+ foreign import WINDOWS_CCONV "windows.h SetSystemTimeAdjustment"     c_SetSystemTimeAdjustment :: DWORD -> BOOL -> IO BOOL setSystemTimeAdjustment :: Maybe Int -> IO ()@@ -303,6 +334,26 @@     , tIME_NOTIMEMARKER     = TIME_NOTIMEMARKER     , tIME_FORCE24HOURFORMAT= TIME_FORCE24HOURFORMAT     }++getTimeFormatEx :: Maybe String+                -> GetTimeFormatFlags+                -> Maybe SYSTEMTIME+                -> Maybe String+                -> IO String+getTimeFormatEx locale flags st fmt =+    maybeWith withTString locale $ \c_locale ->+        maybeWith with st $ \c_st ->+            maybeWith withTString fmt $ \c_fmt -> do+                let c_func = c_GetTimeFormatEx c_locale flags c_st c_fmt+                trySized "GetTimeFormatEx" c_func+foreign import WINDOWS_CCONV "windows.h GetTimeFormatEx"+    c_GetTimeFormatEx :: LPCWSTR+                      -> GetTimeFormatFlags+                      -> Ptr SYSTEMTIME+                      -> LPCWSTR+                      -> LPWSTR+                      -> CInt+                      -> IO CInt  foreign import WINDOWS_CCONV "windows.h GetTimeFormatW"     c_GetTimeFormat :: LCID -> GetTimeFormatFlags -> Ptr SYSTEMTIME -> LPCTSTR -> LPTSTR -> CInt -> IO CInt

@@ -10,24 +10,34 @@    Utilities for calling Win32 API
 -}
 module System.Win32.Utils
-  ( try, tryWithoutNull, try'
+  ( try, tryWithoutNull, trySized, try'
   -- * Maybe values
   , maybePtr, ptrToMaybe, maybeNum, numToMaybe
   , peekMaybe, withMaybe
+  -- * Format picture translation
+  , fromDateFormatPicture
+  , fromTimeFormatPicture
   ) where
+
 import Control.Monad               ( unless )
+import Foreign.C.Types             ( CInt )
 import Foreign.Marshal.Array       ( allocaArray, peekArray )
 import Foreign.Marshal.Utils       ( with )
 import Foreign.Ptr                 ( Ptr, nullPtr )
 import Foreign.Storable            ( Storable(..) )
-import System.Win32.Types          ( failIfZero
-                                   , failWith, getLastError, eRROR_INSUFFICIENT_BUFFER )
+import Text.ParserCombinators.ReadP ( ReadP, (<++), between, char, count
+                                    , readP_to_S, satisfy )
+
+
+import System.Win32.String         ( LPTSTR, peekTString, peekTStringLen
+                                   , withTStringBufferLen )
+import System.Win32.Types          ( BOOL, UINT, eRROR_INSUFFICIENT_BUFFER
+                                   , failIfZero, failWith, getLastError
+                                   , maybeNum, maybePtr, numToMaybe
+                                   , ptrToMaybe )
 import qualified System.Win32.Types ( try )
-import System.Win32.String         ( LPTSTR, peekTString )
-import System.Win32.Types          ( BOOL, UINT, maybePtr, ptrToMaybe, maybeNum, numToMaybe )
 import System.Win32.Word           ( DWORD, PDWORD )
 
-
 -- | Support for API calls that are passed a fixed-size buffer and tell
 -- you via the return value if the buffer was too small.  In that
 -- case, we extend the buffer size and try again.
@@ -39,7 +49,7 @@ tryWithoutNull loc f n = do
    e <- allocaArray (fromIntegral n) $ \lptstr -> do
           r <- failIfZero loc $ f lptstr n
-          if (r > n) then return (Left r) else do
+          if r > n then return (Left r) else do
             str <- peekTString lptstr
             return (Right str)
    case e of
@@ -56,16 +66,28 @@             unless (err_code == eRROR_INSUFFICIENT_BUFFER)
               $ failWith loc err_code
           r   <- peek n'
-          if (r > n) then return (Left r) else do
+          if r > n then return (Left r) else do
             str <- peekArray (fromIntegral r) lptstr
             return (Right str)
    case e of
         Left r'   -> try' loc f r'
         Right str -> return str
 
+-- | Support for API calls that return the required size, in characters
+-- including a null character, of the buffer when passed a buffer size of zero.
+trySized :: String -> (LPTSTR -> CInt -> IO CInt) -> IO String
+trySized wh f = do
+    c_len <- failIfZero wh $ f nullPtr 0
+    let len = fromIntegral c_len
+    withTStringBufferLen len $ \(buf', len') -> do
+        let c_len' = fromIntegral len'
+        c_len'' <- failIfZero wh $ f buf' c_len'
+        let len'' = fromIntegral c_len''
+        peekTStringLen (buf', len'' - 1) -- Drop final null character
+
 -- | See also: 'Foreign.Marshal.Utils.maybePeek' function.
 peekMaybe :: Storable a => Ptr a -> IO (Maybe a)
-peekMaybe p = 
+peekMaybe p =
   if p == nullPtr
     then return Nothing
     else Just `fmap` peek p
@@ -74,3 +96,315 @@ withMaybe :: Storable a => Maybe a -> (Ptr a -> IO b) -> IO b
 withMaybe Nothing  action = action nullPtr
 withMaybe (Just x) action = with x action
+
+-- | Type representing components of a Windows API day, month, year and era
+-- format picture.
+data DateFormatPicture
+  = Day
+  | Day0 -- Padded with zeros
+  | DayShort
+  | DayLong
+  | Month
+  | Month0 -- Padded with zeros
+  | MonthShort
+  | MonthLong
+  | YearVeryShort -- Year represented only by the last digit
+  | YearShort
+  | Year
+  | Era
+  | DateOther String
+  deriving (Eq, Show)
+
+fromDFP :: DateFormatPicture -> String
+fromDFP Day = "%-e" -- No padding
+fromDFP Day0 = "%d" -- Padded with zeros
+fromDFP DayShort = "%a" -- eg Tue
+fromDFP DayLong = "%A" -- eg Tuesday
+fromDFP Month = "%-m" -- No padding
+fromDFP Month0 = "%m" -- Padded with zeros
+fromDFP MonthShort = "%b" -- eg Jan
+fromDFP MonthLong = "%B" -- eg January
+fromDFP YearVeryShort = "%-y" -- No direct equivalent of a one digit year, so
+                              -- do not distinguish from a short year without
+                              -- padding
+fromDFP YearShort = "%y"
+fromDFP Year = "%Y"
+fromDFP Era = "" -- No equivalent
+fromDFP (DateOther cs) = escape cs
+
+escape :: String -> String
+escape [] = []
+escape (c:cs) = escape' c ++ escape cs
+ where
+  escape' '%' = "%%"
+  escape' '\t' = "%t"
+  escape' '\n' = "%n"
+  escape' c' = [c']
+
+d :: ReadP Char
+d = char 'd'
+
+day :: ReadP DateFormatPicture
+day = do
+  _ <- d
+  return Day
+
+day0 :: ReadP DateFormatPicture
+day0 = do
+  _ <- count 2 d
+  return Day0
+
+dayShort :: ReadP DateFormatPicture
+dayShort = do
+  _ <- count 3 d
+  return DayShort
+
+dayLong :: ReadP DateFormatPicture
+dayLong = do
+  _ <- count 4 d
+  return DayLong
+
+days :: ReadP DateFormatPicture
+days = dayLong <++ dayShort <++ day0 <++ day
+
+bigM :: ReadP Char
+bigM = char 'M'
+
+month :: ReadP DateFormatPicture
+month = do
+  _ <- bigM
+  return Month
+
+month0 :: ReadP DateFormatPicture
+month0 = do
+  _ <- count 2 bigM
+  return Month0
+
+monthShort :: ReadP DateFormatPicture
+monthShort = do
+  _ <- count 3 bigM
+  return MonthShort
+
+monthLong :: ReadP DateFormatPicture
+monthLong = do
+  _ <- count 4 bigM
+  return MonthLong
+
+months :: ReadP DateFormatPicture
+months = monthLong <++ monthShort <++ month0 <++ month
+
+y :: ReadP Char
+y = char 'y'
+
+yearVeryShort :: ReadP DateFormatPicture
+yearVeryShort = do
+  _ <- y
+  return YearVeryShort
+
+yearShort :: ReadP DateFormatPicture
+yearShort = do
+  _ <- count 2 y
+  return YearShort
+
+year :: ReadP DateFormatPicture
+year = do
+  _ <- count 5 y <++ count 4 y
+  return Year
+
+years :: ReadP DateFormatPicture
+years = year <++ yearShort <++ yearVeryShort
+
+g :: ReadP Char
+g = char 'g'
+
+era :: ReadP DateFormatPicture
+era = do
+  _ <- count 2 g <++ count 1 g
+  return Era
+
+quote :: ReadP Char
+quote = char '\''
+
+notQuote :: ReadP Char
+notQuote = satisfy (/= '\'')
+
+escQuote :: ReadP Char
+escQuote = do
+  _ <- count 2 quote
+  return '\''
+
+quotedChars :: ReadP String
+quotedChars = between quote quote $ greedy (escQuote <++ notQuote)
+
+-- | Although not documented at
+-- https://docs.microsoft.com/en-us/windows/win32/intl/day--month--year--and-era-format-pictures
+-- the format pictures used by Windows do not require all such characters to be
+-- enclosed in single quotation marks.
+nonDateSpecial :: ReadP Char
+nonDateSpecial = satisfy (\c -> c `notElem` ['d', 'M', 'y', 'g', '\''])
+
+nonDateSpecials :: ReadP String
+nonDateSpecials = greedy1 nonDateSpecial
+
+dateOther :: ReadP DateFormatPicture
+dateOther = do
+  chars <- greedy1 (nonDateSpecials <++ quotedChars)
+  return $ DateOther $ concat chars
+
+datePicture :: ReadP [DateFormatPicture]
+datePicture = greedy (days <++ months <++ years <++ era <++ dateOther)
+
+-- | Type representing components of a Windows API hours, minute, and second
+-- format picture.
+data TimeFormatPicture
+  = Hours12
+  | Hours012 -- Padded with zeros
+  | Hours24
+  | Hours024 -- Padded with zeros
+  | Minutes
+  | Minutes0 -- Padded with zeros
+  | Seconds
+  | Seconds0 -- Padded with zeros
+  | TimeMarkerShort -- One-character time marker string, eg "A" and "P"
+  | TimeMarker -- Multi-character time marker string, eg "AM" and "PM"
+  | TimeOther String
+  deriving (Eq, Show)
+
+fromTFP :: TimeFormatPicture -> String
+fromTFP Hours12 = "%-l" -- No padding
+fromTFP Hours012 = "%I" -- Padded with zeros
+fromTFP Hours24 = "%-k" -- No padding
+fromTFP Hours024 = "%H" -- Padded with zeros
+fromTFP Minutes = "%-M" -- No padding
+fromTFP Minutes0 = "%M" -- Padded with zeros
+fromTFP Seconds = "%-S" -- No padding
+fromTFP Seconds0 = "%S" -- Padded with zeros
+fromTFP TimeMarkerShort = "%p" -- No direct equivalent, so do not distinguish
+                               -- from TimeMarker
+fromTFP TimeMarker = "%p"
+fromTFP (TimeOther cs) = escape cs
+
+h :: ReadP Char
+h = char 'h'
+
+hours12 :: ReadP TimeFormatPicture
+hours12 = do
+  _ <- h
+  return Hours12
+
+hours012 :: ReadP TimeFormatPicture
+hours012 = do
+  _ <- count 2 h
+  return Hours012
+
+bigH :: ReadP Char
+bigH = char 'H'
+
+hours24 :: ReadP TimeFormatPicture
+hours24 = do
+  _ <- bigH
+  return Hours24
+
+hours024 :: ReadP TimeFormatPicture
+hours024 = do
+  _ <- count 2 bigH
+  return Hours024
+
+hours :: ReadP TimeFormatPicture
+hours = hours012 <++ hours12 <++ hours024 <++ hours24
+
+m :: ReadP Char
+m = char 'm'
+
+minute :: ReadP TimeFormatPicture
+minute = do
+  _ <- m
+  return Minutes
+
+minute0 :: ReadP TimeFormatPicture
+minute0 = do
+  _ <- count 2 m
+  return Minutes0
+
+minutes :: ReadP TimeFormatPicture
+minutes = minute0 <++ minute
+
+s :: ReadP Char
+s = char 's'
+
+second :: ReadP TimeFormatPicture
+second = do
+  _ <- s
+  return Seconds
+
+second0 :: ReadP TimeFormatPicture
+second0 = do
+  _ <- count 2 s
+  return Seconds0
+
+seconds :: ReadP TimeFormatPicture
+seconds = second0 <++ second
+
+t :: ReadP Char
+t = char 't'
+
+timeMarkerShort :: ReadP TimeFormatPicture
+timeMarkerShort = do
+  _ <- t
+  return TimeMarkerShort
+
+timeMarker :: ReadP TimeFormatPicture
+timeMarker = do
+  _ <- count 2 t
+  return TimeMarker
+
+timeMarkers :: ReadP TimeFormatPicture
+timeMarkers = timeMarker <++ timeMarkerShort
+
+-- | Although not documented at
+-- https://docs.microsoft.com/en-us/windows/win32/intl/hour--minute--and-second-format-pictures
+-- the format pictures used by Windows do not require all such characters to be
+-- enclosed in single quotation marks.
+nonTimeSpecial :: ReadP Char
+nonTimeSpecial = satisfy (\c -> c `notElem` ['h', 'H', 'm', 's', 't', '\''])
+
+nonTimeSpecials :: ReadP String
+nonTimeSpecials = greedy1 nonTimeSpecial
+
+timeOther :: ReadP TimeFormatPicture
+timeOther = do
+  chars <- greedy1 (nonTimeSpecials <++ quotedChars)
+  return $ TimeOther $ concat chars
+
+timePicture :: ReadP [TimeFormatPicture]
+timePicture = greedy (hours <++ minutes <++ seconds <++ timeMarkers <++
+                     timeOther)
+
+greedy :: ReadP a -> ReadP [a]
+greedy p = greedy1 p <++ return []
+
+greedy1 :: ReadP a -> ReadP [a]
+greedy1 p = do
+  first <- p
+  rest <- greedy p
+  return (first : rest)
+
+parseMaybe :: ReadP a -> String -> Maybe a
+parseMaybe parser input =
+  case readP_to_S parser input of
+    [] -> Nothing
+    ((result, _):_) -> Just result
+
+-- | Translate from a Windows API day, month, year, and era format picture to
+-- the closest corresponding format string used by
+-- 'Data.Time.Format.formatTime'.
+fromDateFormatPicture :: String -> Maybe String
+fromDateFormatPicture dfp =
+  fmap (concatMap fromDFP) $ parseMaybe datePicture dfp
+
+-- | Translate from a Windows API hours, minute, and second format picture to
+-- the closest corresponding format string used by
+-- 'Data.Time.Format.formatTime'.
+fromTimeFormatPicture :: String -> Maybe String
+fromTimeFormatPicture tfp =
+  fmap (concatMap fromTFP) $ parseMaybe timePicture tfp

@@ -1,5 +1,5 @@ name:           Win32-version:        2.9.0.0+version:        2.10.0.0 license:        BSD3 license-file:   LICENSE author:         Alastair Reid, shelarcy, Tamar Christina

@@ -1,12 +1,28 @@ # Changelog for [`Win32` package](http://hackage.haskell.org/package/Win32) +## 2.10.0.0 September 2020++* Add function `isWindowVisible`+* Add function `getLastInputInfo`+* Add function `getTickCount`+* Add function `getIdleTime`+* Add `enumSystemLocalesEx`, `enumSystemLocalesEx'`,+  `getSystemDefaultLocaleName`, `getUserDefaultLocaleName`, `isValidLocaleName`,+  `getLocaleInfoEx`, `getTimeFormatEx` and `lCMapStringEx`+* Add `trySized` - similar to `try` but for API calls that return the required+  size of the buffer when passed a buffer size of zero.+* Add `fromDateFormatPciture` and `fromTimeFormatPicture`, to translate from+  Windows date and time format pictures to format strings used by the `time`+  package.+* Renamed fields of `COORD` and `SMALL_RECT` to avoid name clashes. (See #157)+ ## 2.9.0.0 June 2020  * `setWindowClosure` now returns the old window closure.-* `defWindowProc` now assumes the data stored in `GWLP\_USERDATA` +* `defWindowProc` now assumes the data stored in `GWLP\_USERDATA`   is the window closure (in line with `setWindowClosure` and   the supplied C `genericWndProc`)-* `defWindowProc` now frees the window closure +* `defWindowProc` now frees the window closure * `getMessage` and `peekMessage` test for -1 to identify the error condition * Support creating symbolic links without Administrator privilege (See #147) * Support for `winio` the new Windows I/O manager.

@@ -1,6 +1,6 @@ #ifndef _ALPHABLEND_H #define _ALPHABLEND_H-#define WINVER 0x0500+ #include <windows.h>  BOOL c_AlphaBlend ( HDC hdcDest, int nXOriginDest, int nYOriginDest, int nWidthDest, int hHeightDest