Win32 2.13.2.1 → 2.13.3.0

raw patch · 35 files changed

+2666/−985 lines, 35 filesdep ~filepath

Dependency ranges changed: filepath

Files

• System/Win32/DLL.hsc +1/−28
• System/Win32/DLL/Internal.hsc +57/−0
• System/Win32/DebugApi.hsc +3/−59
• System/Win32/DebugApi/Internal.hsc +80/−0
• System/Win32/File.hsc +1/−429
• System/Win32/File/Internal.hsc +529/−0
• System/Win32/FileMapping.hsc +4/−41
• System/Win32/FileMapping/Internal.hsc +72/−0
• System/Win32/HardLink.hs +4/−8
• System/Win32/HardLink/Internal.hs +31/−0
• System/Win32/Info.hsc +2/−229
• System/Win32/Info/Internal.hsc +313/−0
• System/Win32/Path.hsc +1/−2
• System/Win32/Path/Internal.hsc +29/−0
• System/Win32/Shell.hsc +1/−9
• System/Win32/Shell/Internal.hsc +50/−0
• System/Win32/SymbolicLink.hsc +1/−9
• System/Win32/SymbolicLink/Internal.hsc +26/−0
• System/Win32/Time.hsc +9/−169
• System/Win32/Time/Internal.hsc +245/−0
• System/Win32/WindowsString/DLL.hsc +67/−0
• System/Win32/WindowsString/DebugApi.hsc +33/−0
• System/Win32/WindowsString/File.hsc +238/−0
• System/Win32/WindowsString/FileMapping.hsc +107/−0
• System/Win32/WindowsString/HardLink.hs +47/−0
• System/Win32/WindowsString/Info.hsc +114/−0
• System/Win32/WindowsString/Path.hsc +52/−0
• System/Win32/WindowsString/Shell.hsc +59/−0
• System/Win32/WindowsString/String.hs +67/−0
• System/Win32/WindowsString/SymbolicLink.hsc +94/−0
• System/Win32/WindowsString/Time.hsc +60/−0
• System/Win32/WindowsString/Types.hsc +166/−0
• System/Win32/WindowsString/Utils.hs +63/−0
• Win32.cabal +36/−2
• changelog.md +4/−0

@@ -31,76 +31,49 @@     , lOAD_WITH_ALTERED_SEARCH_PATH     ) where +import System.Win32.DLL.Internal import System.Win32.Types  import Foreign import Foreign.C import Data.Maybe (fromMaybe) -##include "windows_cconv.h"--#include <windows.h>- disableThreadLibraryCalls :: HMODULE -> IO () disableThreadLibraryCalls hmod =   failIfFalse_ "DisableThreadLibraryCalls" $ c_DisableThreadLibraryCalls hmod-foreign import WINDOWS_CCONV unsafe "windows.h DisableThreadLibraryCalls"-  c_DisableThreadLibraryCalls :: HMODULE -> IO Bool  freeLibrary :: HMODULE -> IO () freeLibrary hmod =   failIfFalse_ "FreeLibrary" $ c_FreeLibrary hmod-foreign import WINDOWS_CCONV unsafe "windows.h FreeLibrary"-  c_FreeLibrary :: HMODULE -> IO Bool  getModuleFileName :: HMODULE -> IO String getModuleFileName hmod =   allocaArray 512 $ \ c_str -> do   failIfFalse_ "GetModuleFileName" $ c_GetModuleFileName hmod c_str 512   peekTString c_str-foreign import WINDOWS_CCONV unsafe "windows.h GetModuleFileNameW"-  c_GetModuleFileName :: HMODULE -> LPTSTR -> Int -> IO Bool  getModuleHandle :: Maybe String -> IO HMODULE getModuleHandle mb_name =   maybeWith withTString mb_name $ \ c_name ->   failIfNull "GetModuleHandle" $ c_GetModuleHandle c_name-foreign import WINDOWS_CCONV unsafe "windows.h GetModuleHandleW"-  c_GetModuleHandle :: LPCTSTR -> IO HMODULE  getProcAddress :: HMODULE -> String -> IO Addr getProcAddress hmod procname =   withCAString procname $ \ c_procname ->   failIfNull "GetProcAddress" $ c_GetProcAddress hmod c_procname -foreign import WINDOWS_CCONV unsafe "windows.h GetProcAddress"-  c_GetProcAddress :: HMODULE -> LPCSTR -> IO Addr- loadLibrary :: String -> IO HINSTANCE loadLibrary name =   withTString name $ \ c_name ->   failIfNull "LoadLibrary" $ c_LoadLibrary c_name-foreign import WINDOWS_CCONV unsafe "windows.h LoadLibraryW"-  c_LoadLibrary :: LPCTSTR -> IO HINSTANCE -type LoadLibraryFlags = DWORD--#{enum LoadLibraryFlags,- , lOAD_LIBRARY_AS_DATAFILE      = LOAD_LIBRARY_AS_DATAFILE- , lOAD_WITH_ALTERED_SEARCH_PATH = LOAD_WITH_ALTERED_SEARCH_PATH- }- loadLibraryEx :: String -> HANDLE -> LoadLibraryFlags -> IO HINSTANCE loadLibraryEx name h flags =   withTString name $ \ c_name ->   failIfNull "LoadLibraryEx" $ c_LoadLibraryEx c_name h flags-foreign import WINDOWS_CCONV unsafe "windows.h LoadLibraryExW"-  c_LoadLibraryEx :: LPCTSTR -> HANDLE -> LoadLibraryFlags -> IO HINSTANCE  setDllDirectory :: Maybe String -> IO () setDllDirectory name =   maybeWith withTString name $ \ c_name ->   failIfFalse_ (unwords ["SetDllDirectory", fromMaybe "NULL" name]) $ c_SetDllDirectory c_name -foreign import WINDOWS_CCONV unsafe "windows.h SetDllDirectoryW"-  c_SetDllDirectory :: LPTSTR -> IO BOOL

@@ -0,0 +1,57 @@+#if __GLASGOW_HASKELL__ >= 709+{-# LANGUAGE Safe #-}+#else+{-# LANGUAGE Trustworthy #-}+#endif+-----------------------------------------------------------------------------+-- |+-- Module      :  System.Win32.DLL.Internal+-- Copyright   :  (c) Alastair Reid, 1997-2003+-- License     :  BSD-style (see the file libraries/base/LICENSE)+--+-- Maintainer  :  Esa Ilari Vuokko <ei@vuokko.info>+-- Stability   :  provisional+-- Portability :  portable+--+-- A collection of FFI declarations for interfacing with Win32.+--+-----------------------------------------------------------------------------++module System.Win32.DLL.Internal where++import System.Win32.Types++##include "windows_cconv.h"++#include <windows.h>++foreign import WINDOWS_CCONV unsafe "windows.h DisableThreadLibraryCalls"+  c_DisableThreadLibraryCalls :: HMODULE -> IO Bool++foreign import WINDOWS_CCONV unsafe "windows.h FreeLibrary"+  c_FreeLibrary :: HMODULE -> IO Bool++foreign import WINDOWS_CCONV unsafe "windows.h GetModuleFileNameW"+  c_GetModuleFileName :: HMODULE -> LPTSTR -> Int -> IO Bool++foreign import WINDOWS_CCONV unsafe "windows.h GetModuleHandleW"+  c_GetModuleHandle :: LPCTSTR -> IO HMODULE++foreign import WINDOWS_CCONV unsafe "windows.h GetProcAddress"+  c_GetProcAddress :: HMODULE -> LPCSTR -> IO Addr++foreign import WINDOWS_CCONV unsafe "windows.h LoadLibraryW"+  c_LoadLibrary :: LPCTSTR -> IO HINSTANCE++type LoadLibraryFlags = DWORD++#{enum LoadLibraryFlags,+ , lOAD_LIBRARY_AS_DATAFILE      = LOAD_LIBRARY_AS_DATAFILE+ , lOAD_WITH_ALTERED_SEARCH_PATH = LOAD_WITH_ALTERED_SEARCH_PATH+ }++foreign import WINDOWS_CCONV unsafe "windows.h LoadLibraryExW"+  c_LoadLibraryEx :: LPCTSTR -> HANDLE -> LoadLibraryFlags -> IO HINSTANCE++foreign import WINDOWS_CCONV unsafe "windows.h SetDllDirectoryW"+  c_SetDllDirectory :: LPTSTR -> IO BOOL

@@ -70,31 +70,20 @@     , outputDebugString     ) where +import System.Win32.DebugApi.Internal import Control.Exception( bracket_ )-import Data.Word        ( Word8, Word32 ) import Foreign          ( Ptr, nullPtr, ForeignPtr, mallocForeignPtrBytes                         , peekByteOff, plusPtr, allocaBytes, castPtr, poke                         , withForeignPtr, Storable, sizeOf, peek, pokeByteOff ) import System.IO        ( fixIO )-import System.Win32.Types   ( HANDLE, BOOL, WORD, DWORD, failIf_, failWith-                            , getLastError, failIf, LPTSTR, withTString )+import System.Win32.Types   ( WORD, DWORD, failIf_, failWith+                            , getLastError, failIf, withTString )  ##include "windows_cconv.h" #include "windows.h" -type PID = DWORD-type TID = DWORD-type DebugEventId = (PID, TID)-type ForeignAddress = Word32 -type PHANDLE = Ptr ()-type THANDLE = Ptr () -type ThreadInfo = (THANDLE, ForeignAddress, ForeignAddress)   -- handle to thread, thread local, thread start-type ImageInfo = (HANDLE, ForeignAddress, DWORD, DWORD, ForeignAddress)-type ExceptionInfo = (Bool, Bool, ForeignAddress) -- First chance, continuable, address-- data Exception     = UnknownException     | AccessViolation Bool ForeignAddress@@ -416,48 +405,3 @@ outputDebugString :: String -> IO () outputDebugString s = withTString s $ \c_s -> c_OutputDebugString c_s ------------------------------------------------------------------------------ Raw imports--foreign import WINDOWS_CCONV "windows.h SuspendThread"-    c_SuspendThread :: THANDLE -> IO DWORD--foreign import WINDOWS_CCONV "windows.h ResumeThread"-    c_ResumeThread :: THANDLE -> IO DWORD--foreign import WINDOWS_CCONV "windows.h WaitForDebugEvent"-    c_WaitForDebugEvent :: Ptr () -> DWORD -> IO BOOL--foreign import WINDOWS_CCONV "windows.h ContinueDebugEvent"-    c_ContinueDebugEvent :: DWORD -> DWORD -> DWORD -> IO BOOL--foreign import WINDOWS_CCONV "windows.h DebugActiveProcess"-    c_DebugActiveProcess :: DWORD -> IO Bool---- Windows XP--- foreign import WINDOWS_CCONV "windows.h DebugActiveProcessStop"---     c_DebugActiveProcessStop :: DWORD -> IO Bool--foreign import WINDOWS_CCONV "windows.h ReadProcessMemory" c_ReadProcessMemory ::-    PHANDLE -> Ptr () -> Ptr Word8 -> DWORD -> Ptr DWORD -> IO BOOL--foreign import WINDOWS_CCONV "windows.h WriteProcessMemory" c_WriteProcessMemory ::-    PHANDLE -> Ptr () -> Ptr Word8 -> DWORD -> Ptr DWORD -> IO BOOL--foreign import WINDOWS_CCONV "windows.h GetThreadContext"-    c_GetThreadContext :: THANDLE -> Ptr () -> IO BOOL--foreign import WINDOWS_CCONV "windows.h SetThreadContext"-    c_SetThreadContext :: THANDLE -> Ptr () -> IO BOOL----foreign import WINDOWS_CCONV "windows.h GetThreadId"---    c_GetThreadId :: THANDLE -> IO TID--foreign import WINDOWS_CCONV "windows.h OutputDebugStringW"-    c_OutputDebugString :: LPTSTR -> IO ()--foreign import WINDOWS_CCONV "windows.h IsDebuggerPresent"-    isDebuggerPresent :: IO BOOL--foreign import WINDOWS_CCONV "windows.h  DebugBreak"-    debugBreak :: IO ()

@@ -0,0 +1,80 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  System.Win32.WindowsString.DebugApi.Internal+-- Copyright   :  (c) Esa Ilari Vuokko, 2006+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Esa Ilari Vuokko <ei@vuokko.info>+-- Stability   :  provisional+-- Portability :  portable+--+-- A collection of FFI declarations for using Windows DebugApi.+--+-----------------------------------------------------------------------------++module System.Win32.DebugApi.Internal where++import Data.Word            ( Word8, Word32 )+import Foreign              ( Ptr )+import System.Win32.Types   ( BOOL, DWORD, HANDLE, LPTSTR )++##include "windows_cconv.h"+#include "windows.h"++type PID = DWORD+type TID = DWORD+type DebugEventId = (PID, TID)+type ForeignAddress = Word32++type PHANDLE = Ptr ()+type THANDLE = Ptr ()++type ThreadInfo = (THANDLE, ForeignAddress, ForeignAddress)   -- handle to thread, thread local, thread start+type ImageInfo = (HANDLE, ForeignAddress, DWORD, DWORD, ForeignAddress)+type ExceptionInfo = (Bool, Bool, ForeignAddress) -- First chance, continuable, address++--------------------------------------------------------------------------+-- Raw imports++foreign import WINDOWS_CCONV "windows.h SuspendThread"+    c_SuspendThread :: THANDLE -> IO DWORD++foreign import WINDOWS_CCONV "windows.h ResumeThread"+    c_ResumeThread :: THANDLE -> IO DWORD++foreign import WINDOWS_CCONV "windows.h WaitForDebugEvent"+    c_WaitForDebugEvent :: Ptr () -> DWORD -> IO BOOL++foreign import WINDOWS_CCONV "windows.h ContinueDebugEvent"+    c_ContinueDebugEvent :: DWORD -> DWORD -> DWORD -> IO BOOL++foreign import WINDOWS_CCONV "windows.h DebugActiveProcess"+    c_DebugActiveProcess :: DWORD -> IO Bool++-- Windows XP+-- foreign import WINDOWS_CCONV "windows.h DebugActiveProcessStop"+--     c_DebugActiveProcessStop :: DWORD -> IO Bool++foreign import WINDOWS_CCONV "windows.h ReadProcessMemory" c_ReadProcessMemory ::+    PHANDLE -> Ptr () -> Ptr Word8 -> DWORD -> Ptr DWORD -> IO BOOL++foreign import WINDOWS_CCONV "windows.h WriteProcessMemory" c_WriteProcessMemory ::+    PHANDLE -> Ptr () -> Ptr Word8 -> DWORD -> Ptr DWORD -> IO BOOL++foreign import WINDOWS_CCONV "windows.h GetThreadContext"+    c_GetThreadContext :: THANDLE -> Ptr () -> IO BOOL++foreign import WINDOWS_CCONV "windows.h SetThreadContext"+    c_SetThreadContext :: THANDLE -> Ptr () -> IO BOOL++--foreign import WINDOWS_CCONV "windows.h GetThreadId"+--    c_GetThreadId :: THANDLE -> IO TID++foreign import WINDOWS_CCONV "windows.h OutputDebugStringW"+    c_OutputDebugString :: LPTSTR -> IO ()++foreign import WINDOWS_CCONV "windows.h IsDebuggerPresent"+    isDebuggerPresent :: IO BOOL++foreign import WINDOWS_CCONV "windows.h  DebugBreak"+    debugBreak :: IO ()

@@ -238,8 +238,8 @@     , unlockFile     ) where +import System.Win32.File.Internal import System.Win32.Types-import System.Win32.Time  import Foreign hiding (void) import Control.Monad@@ -251,313 +251,6 @@ #include "alignment.h"  ------------------------------------------------------------------- Enumeration types-------------------------------------------------------------------type AccessMode   = UINT--gENERIC_NONE :: AccessMode-gENERIC_NONE = 0--#{enum AccessMode,- , gENERIC_READ              = GENERIC_READ- , gENERIC_WRITE             = GENERIC_WRITE- , gENERIC_EXECUTE           = GENERIC_EXECUTE- , gENERIC_ALL               = GENERIC_ALL- , dELETE                    = DELETE- , rEAD_CONTROL              = READ_CONTROL- , wRITE_DAC                 = WRITE_DAC- , wRITE_OWNER               = WRITE_OWNER- , sYNCHRONIZE               = SYNCHRONIZE- , sTANDARD_RIGHTS_REQUIRED  = STANDARD_RIGHTS_REQUIRED- , sTANDARD_RIGHTS_READ      = STANDARD_RIGHTS_READ- , sTANDARD_RIGHTS_WRITE     = STANDARD_RIGHTS_WRITE- , sTANDARD_RIGHTS_EXECUTE   = STANDARD_RIGHTS_EXECUTE- , sTANDARD_RIGHTS_ALL       = STANDARD_RIGHTS_ALL- , sPECIFIC_RIGHTS_ALL       = SPECIFIC_RIGHTS_ALL- , aCCESS_SYSTEM_SECURITY    = ACCESS_SYSTEM_SECURITY- , mAXIMUM_ALLOWED           = MAXIMUM_ALLOWED- , fILE_ADD_FILE             = FILE_ADD_FILE- , fILE_ADD_SUBDIRECTORY     = FILE_ADD_SUBDIRECTORY- , fILE_ALL_ACCESS           = FILE_ALL_ACCESS- , fILE_APPEND_DATA          = FILE_APPEND_DATA- , fILE_CREATE_PIPE_INSTANCE = FILE_CREATE_PIPE_INSTANCE- , fILE_DELETE_CHILD         = FILE_DELETE_CHILD- , fILE_EXECUTE              = FILE_EXECUTE- , fILE_LIST_DIRECTORY       = FILE_LIST_DIRECTORY- , fILE_READ_ATTRIBUTES      = FILE_READ_ATTRIBUTES- , fILE_READ_DATA            = FILE_READ_DATA- , fILE_READ_EA              = FILE_READ_EA- , fILE_TRAVERSE             = FILE_TRAVERSE- , fILE_WRITE_ATTRIBUTES     = FILE_WRITE_ATTRIBUTES- , fILE_WRITE_DATA           = FILE_WRITE_DATA- , fILE_WRITE_EA             = FILE_WRITE_EA- }--------------------------------------------------------------------type ShareMode   = UINT--fILE_SHARE_NONE :: ShareMode-fILE_SHARE_NONE = 0--#{enum ShareMode,- , fILE_SHARE_READ      = FILE_SHARE_READ- , fILE_SHARE_WRITE     = FILE_SHARE_WRITE- , fILE_SHARE_DELETE    = FILE_SHARE_DELETE- }--------------------------------------------------------------------type CreateMode   = UINT--#{enum CreateMode,- , cREATE_NEW           = CREATE_NEW- , cREATE_ALWAYS        = CREATE_ALWAYS- , oPEN_EXISTING        = OPEN_EXISTING- , oPEN_ALWAYS          = OPEN_ALWAYS- , tRUNCATE_EXISTING    = TRUNCATE_EXISTING- }--------------------------------------------------------------------type FileAttributeOrFlag   = UINT--#{enum FileAttributeOrFlag,- , fILE_ATTRIBUTE_READONLY      = FILE_ATTRIBUTE_READONLY- , fILE_ATTRIBUTE_HIDDEN        = FILE_ATTRIBUTE_HIDDEN- , fILE_ATTRIBUTE_SYSTEM        = FILE_ATTRIBUTE_SYSTEM- , fILE_ATTRIBUTE_DIRECTORY     = FILE_ATTRIBUTE_DIRECTORY- , fILE_ATTRIBUTE_ARCHIVE       = FILE_ATTRIBUTE_ARCHIVE- , fILE_ATTRIBUTE_NORMAL        = FILE_ATTRIBUTE_NORMAL- , fILE_ATTRIBUTE_TEMPORARY     = FILE_ATTRIBUTE_TEMPORARY- , fILE_ATTRIBUTE_COMPRESSED    = FILE_ATTRIBUTE_COMPRESSED- , fILE_ATTRIBUTE_REPARSE_POINT = FILE_ATTRIBUTE_REPARSE_POINT- , fILE_FLAG_WRITE_THROUGH      = FILE_FLAG_WRITE_THROUGH- , fILE_FLAG_OVERLAPPED         = FILE_FLAG_OVERLAPPED- , fILE_FLAG_NO_BUFFERING       = FILE_FLAG_NO_BUFFERING- , fILE_FLAG_RANDOM_ACCESS      = FILE_FLAG_RANDOM_ACCESS- , fILE_FLAG_SEQUENTIAL_SCAN    = FILE_FLAG_SEQUENTIAL_SCAN- , fILE_FLAG_DELETE_ON_CLOSE    = FILE_FLAG_DELETE_ON_CLOSE- , fILE_FLAG_BACKUP_SEMANTICS   = FILE_FLAG_BACKUP_SEMANTICS- , fILE_FLAG_POSIX_SEMANTICS    = FILE_FLAG_POSIX_SEMANTICS- }-#ifndef __WINE_WINDOWS_H-#{enum FileAttributeOrFlag,- , sECURITY_ANONYMOUS           = SECURITY_ANONYMOUS- , sECURITY_IDENTIFICATION      = SECURITY_IDENTIFICATION- , sECURITY_IMPERSONATION       = SECURITY_IMPERSONATION- , sECURITY_DELEGATION          = SECURITY_DELEGATION- , sECURITY_CONTEXT_TRACKING    = SECURITY_CONTEXT_TRACKING- , sECURITY_EFFECTIVE_ONLY      = SECURITY_EFFECTIVE_ONLY- , sECURITY_SQOS_PRESENT        = SECURITY_SQOS_PRESENT- , sECURITY_VALID_SQOS_FLAGS    = SECURITY_VALID_SQOS_FLAGS- }-#endif--------------------------------------------------------------------type MoveFileFlag   = DWORD--#{enum MoveFileFlag,- , mOVEFILE_REPLACE_EXISTING    = MOVEFILE_REPLACE_EXISTING- , mOVEFILE_COPY_ALLOWED        = MOVEFILE_COPY_ALLOWED- , mOVEFILE_DELAY_UNTIL_REBOOT  = MOVEFILE_DELAY_UNTIL_REBOOT- }--------------------------------------------------------------------type FilePtrDirection   = DWORD--#{enum FilePtrDirection,- , fILE_BEGIN   = FILE_BEGIN- , fILE_CURRENT = FILE_CURRENT- , fILE_END     = FILE_END- }--------------------------------------------------------------------type DriveType = UINT--#{enum DriveType,- , dRIVE_UNKNOWN        = DRIVE_UNKNOWN- , dRIVE_NO_ROOT_DIR    = DRIVE_NO_ROOT_DIR- , dRIVE_REMOVABLE      = DRIVE_REMOVABLE- , dRIVE_FIXED          = DRIVE_FIXED- , dRIVE_REMOTE         = DRIVE_REMOTE- , dRIVE_CDROM          = DRIVE_CDROM- , dRIVE_RAMDISK        = DRIVE_RAMDISK- }--------------------------------------------------------------------type DefineDosDeviceFlags = DWORD--#{enum DefineDosDeviceFlags,- , dDD_RAW_TARGET_PATH          = DDD_RAW_TARGET_PATH- , dDD_REMOVE_DEFINITION        = DDD_REMOVE_DEFINITION- , dDD_EXACT_MATCH_ON_REMOVE    = DDD_EXACT_MATCH_ON_REMOVE- }--------------------------------------------------------------------type BinaryType = DWORD--#{enum BinaryType,- , sCS_32BIT_BINARY     = SCS_32BIT_BINARY- , sCS_DOS_BINARY       = SCS_DOS_BINARY- , sCS_WOW_BINARY       = SCS_WOW_BINARY- , sCS_PIF_BINARY       = SCS_PIF_BINARY- , sCS_POSIX_BINARY     = SCS_POSIX_BINARY- , sCS_OS216_BINARY     = SCS_OS216_BINARY- }--------------------------------------------------------------------type FileNotificationFlag = DWORD--#{enum FileNotificationFlag,- , fILE_NOTIFY_CHANGE_FILE_NAME  = FILE_NOTIFY_CHANGE_FILE_NAME- , fILE_NOTIFY_CHANGE_DIR_NAME   = FILE_NOTIFY_CHANGE_DIR_NAME- , fILE_NOTIFY_CHANGE_ATTRIBUTES = FILE_NOTIFY_CHANGE_ATTRIBUTES- , fILE_NOTIFY_CHANGE_SIZE       = FILE_NOTIFY_CHANGE_SIZE- , fILE_NOTIFY_CHANGE_LAST_WRITE = FILE_NOTIFY_CHANGE_LAST_WRITE- , fILE_NOTIFY_CHANGE_SECURITY   = FILE_NOTIFY_CHANGE_SECURITY- }--------------------------------------------------------------------type FileType = DWORD--#{enum FileType,- , fILE_TYPE_UNKNOWN    = FILE_TYPE_UNKNOWN- , fILE_TYPE_DISK       = FILE_TYPE_DISK- , fILE_TYPE_CHAR       = FILE_TYPE_CHAR- , fILE_TYPE_PIPE       = FILE_TYPE_PIPE- , fILE_TYPE_REMOTE     = FILE_TYPE_REMOTE- }--------------------------------------------------------------------type LockMode = DWORD--#{enum LockMode,- , lOCKFILE_EXCLUSIVE_LOCK   = LOCKFILE_EXCLUSIVE_LOCK- , lOCKFILE_FAIL_IMMEDIATELY = LOCKFILE_FAIL_IMMEDIATELY- }--------------------------------------------------------------------newtype GET_FILEEX_INFO_LEVELS = GET_FILEEX_INFO_LEVELS (#type GET_FILEEX_INFO_LEVELS)-    deriving (Eq, Ord)--#{enum GET_FILEEX_INFO_LEVELS, GET_FILEEX_INFO_LEVELS- , getFileExInfoStandard = GetFileExInfoStandard- , getFileExMaxInfoLevel = GetFileExMaxInfoLevel- }--------------------------------------------------------------------data SECURITY_ATTRIBUTES = SECURITY_ATTRIBUTES-    { nLength              :: !DWORD-    , lpSecurityDescriptor :: !LPVOID-    , bInheritHandle       :: !BOOL-    } deriving Show--type PSECURITY_ATTRIBUTES = Ptr SECURITY_ATTRIBUTES-type LPSECURITY_ATTRIBUTES = Ptr SECURITY_ATTRIBUTES-type MbLPSECURITY_ATTRIBUTES = Maybe LPSECURITY_ATTRIBUTES--instance Storable SECURITY_ATTRIBUTES where-    sizeOf = const #{size SECURITY_ATTRIBUTES}-    alignment _ = #alignment SECURITY_ATTRIBUTES-    poke buf input = do-        (#poke SECURITY_ATTRIBUTES, nLength)              buf (nLength input)-        (#poke SECURITY_ATTRIBUTES, lpSecurityDescriptor) buf (lpSecurityDescriptor input)-        (#poke SECURITY_ATTRIBUTES, bInheritHandle)       buf (bInheritHandle input)-    peek buf = do-        nLength'              <- (#peek SECURITY_ATTRIBUTES, nLength)              buf-        lpSecurityDescriptor' <- (#peek SECURITY_ATTRIBUTES, lpSecurityDescriptor) buf-        bInheritHandle'       <- (#peek SECURITY_ATTRIBUTES, bInheritHandle)       buf-        return $ SECURITY_ATTRIBUTES nLength' lpSecurityDescriptor' bInheritHandle'--------------------------------------------------------------------- Other types-------------------------------------------------------------------data BY_HANDLE_FILE_INFORMATION = BY_HANDLE_FILE_INFORMATION-    { bhfiFileAttributes :: FileAttributeOrFlag-    , bhfiCreationTime, bhfiLastAccessTime, bhfiLastWriteTime :: FILETIME-    , bhfiVolumeSerialNumber :: DWORD-    , bhfiSize :: DDWORD-    , bhfiNumberOfLinks :: DWORD-    , bhfiFileIndex :: DDWORD-    } deriving (Show)--instance Storable BY_HANDLE_FILE_INFORMATION where-    sizeOf = const (#size BY_HANDLE_FILE_INFORMATION)-    alignment _ = #alignment BY_HANDLE_FILE_INFORMATION-    poke buf bhi = do-        (#poke BY_HANDLE_FILE_INFORMATION, dwFileAttributes)     buf (bhfiFileAttributes bhi)-        (#poke BY_HANDLE_FILE_INFORMATION, ftCreationTime)       buf (bhfiCreationTime bhi)-        (#poke BY_HANDLE_FILE_INFORMATION, ftLastAccessTime)     buf (bhfiLastAccessTime bhi)-        (#poke BY_HANDLE_FILE_INFORMATION, ftLastWriteTime)      buf (bhfiLastWriteTime bhi)-        (#poke BY_HANDLE_FILE_INFORMATION, dwVolumeSerialNumber) buf (bhfiVolumeSerialNumber bhi)-        (#poke BY_HANDLE_FILE_INFORMATION, nFileSizeHigh)        buf sizeHi-        (#poke BY_HANDLE_FILE_INFORMATION, nFileSizeLow)         buf sizeLow-        (#poke BY_HANDLE_FILE_INFORMATION, nNumberOfLinks)       buf (bhfiNumberOfLinks bhi)-        (#poke BY_HANDLE_FILE_INFORMATION, nFileIndexHigh)       buf idxHi-        (#poke BY_HANDLE_FILE_INFORMATION, nFileIndexLow)        buf idxLow-        where-            (sizeHi,sizeLow) = ddwordToDwords $ bhfiSize bhi-            (idxHi,idxLow) = ddwordToDwords $ bhfiFileIndex bhi--    peek buf = do-        attr <- (#peek BY_HANDLE_FILE_INFORMATION, dwFileAttributes)     buf-        ctim <- (#peek BY_HANDLE_FILE_INFORMATION, ftCreationTime)       buf-        lati <- (#peek BY_HANDLE_FILE_INFORMATION, ftLastAccessTime)     buf-        lwti <- (#peek BY_HANDLE_FILE_INFORMATION, ftLastWriteTime)      buf-        vser <- (#peek BY_HANDLE_FILE_INFORMATION, dwVolumeSerialNumber) buf-        fshi <- (#peek BY_HANDLE_FILE_INFORMATION, nFileSizeHigh)        buf-        fslo <- (#peek BY_HANDLE_FILE_INFORMATION, nFileSizeLow)         buf-        link <- (#peek BY_HANDLE_FILE_INFORMATION, nNumberOfLinks)       buf-        idhi <- (#peek BY_HANDLE_FILE_INFORMATION, nFileIndexHigh)       buf-        idlo <- (#peek BY_HANDLE_FILE_INFORMATION, nFileIndexLow)        buf-        return $ BY_HANDLE_FILE_INFORMATION attr ctim lati lwti vser-            (dwordsToDdword (fshi,fslo)) link (dwordsToDdword (idhi,idlo))--------------------------------------------------------------------data WIN32_FILE_ATTRIBUTE_DATA = WIN32_FILE_ATTRIBUTE_DATA-    { fadFileAttributes :: DWORD-    , fadCreationTime , fadLastAccessTime , fadLastWriteTime :: FILETIME-    , fadFileSize :: DDWORD-    } deriving (Show)--instance Storable WIN32_FILE_ATTRIBUTE_DATA where-    sizeOf = const (#size WIN32_FILE_ATTRIBUTE_DATA)-    alignment _ = #alignment WIN32_FILE_ATTRIBUTE_DATA-    poke buf ad = do-        (#poke WIN32_FILE_ATTRIBUTE_DATA, dwFileAttributes) buf (fadFileAttributes ad)-        (#poke WIN32_FILE_ATTRIBUTE_DATA, ftCreationTime)   buf (fadCreationTime ad)-        (#poke WIN32_FILE_ATTRIBUTE_DATA, ftLastAccessTime) buf (fadLastAccessTime ad)-        (#poke WIN32_FILE_ATTRIBUTE_DATA, ftLastWriteTime)  buf (fadLastWriteTime ad)-        (#poke WIN32_FILE_ATTRIBUTE_DATA, nFileSizeHigh)    buf sizeHi-        (#poke WIN32_FILE_ATTRIBUTE_DATA, nFileSizeLow)     buf sizeLo-        where-            (sizeHi,sizeLo) = ddwordToDwords $ fadFileSize ad--    peek buf = do-        attr <- (#peek WIN32_FILE_ATTRIBUTE_DATA, dwFileAttributes) buf-        ctim <- (#peek WIN32_FILE_ATTRIBUTE_DATA, ftCreationTime)   buf-        lati <- (#peek WIN32_FILE_ATTRIBUTE_DATA, ftLastAccessTime) buf-        lwti <- (#peek WIN32_FILE_ATTRIBUTE_DATA, ftLastWriteTime)  buf-        fshi <- (#peek WIN32_FILE_ATTRIBUTE_DATA, nFileSizeHigh)    buf-        fslo <- (#peek WIN32_FILE_ATTRIBUTE_DATA, nFileSizeLow)     buf-        return $ WIN32_FILE_ATTRIBUTE_DATA attr ctim lati lwti-            (dwordsToDdword (fshi,fslo))------------------------------------------------------------------ -- File operations ---------------------------------------------------------------- @@ -596,8 +289,6 @@   withTString name $ \ c_name ->     failIfFalseWithRetry_ (unwords ["DeleteFile",show name]) $       c_DeleteFile c_name-foreign import WINDOWS_CCONV unsafe "windows.h DeleteFileW"-  c_DeleteFile :: LPCTSTR -> IO Bool  copyFile :: String -> String -> Bool -> IO () copyFile src dest over =@@ -605,8 +296,6 @@   withTString dest $ \ c_dest ->   failIfFalseWithRetry_ (unwords ["CopyFile",show src,show dest]) $     c_CopyFile c_src c_dest over-foreign import WINDOWS_CCONV unsafe "windows.h CopyFileW"-  c_CopyFile :: LPCTSTR -> LPCTSTR -> Bool -> IO Bool  moveFile :: String -> String -> IO () moveFile src dest =@@ -614,8 +303,6 @@   withTString dest $ \ c_dest ->   failIfFalseWithRetry_ (unwords ["MoveFile",show src,show dest]) $     c_MoveFile c_src c_dest-foreign import WINDOWS_CCONV unsafe "windows.h MoveFileW"-  c_MoveFile :: LPCTSTR -> LPCTSTR -> IO Bool  moveFileEx :: String -> Maybe String -> MoveFileFlag -> IO () moveFileEx src dest flags =@@ -623,24 +310,18 @@   maybeWith withTString dest $ \ c_dest ->   failIfFalseWithRetry_ (unwords ["MoveFileEx",show src,show dest]) $     c_MoveFileEx c_src c_dest flags-foreign import WINDOWS_CCONV unsafe "windows.h MoveFileExW"-  c_MoveFileEx :: LPCTSTR -> LPCTSTR -> MoveFileFlag -> IO Bool  setCurrentDirectory :: String -> IO () setCurrentDirectory name =   withTString name $ \ c_name ->   failIfFalse_ (unwords ["SetCurrentDirectory",show name]) $     c_SetCurrentDirectory c_name-foreign import WINDOWS_CCONV unsafe "windows.h SetCurrentDirectoryW"-  c_SetCurrentDirectory :: LPCTSTR -> IO Bool  createDirectory :: String -> Maybe LPSECURITY_ATTRIBUTES -> IO () createDirectory name mb_attr =   withTString name $ \ c_name ->   failIfFalseWithRetry_ (unwords ["CreateDirectory",show name]) $     c_CreateDirectory c_name (maybePtr mb_attr)-foreign import WINDOWS_CCONV unsafe "windows.h CreateDirectoryW"-  c_CreateDirectory :: LPCTSTR -> LPSECURITY_ATTRIBUTES -> IO Bool  createDirectoryEx :: String -> String -> Maybe LPSECURITY_ATTRIBUTES -> IO () createDirectoryEx template name mb_attr =@@ -648,16 +329,12 @@   withTString name $ \ c_name ->   failIfFalseWithRetry_ (unwords ["CreateDirectoryEx",show template,show name]) $     c_CreateDirectoryEx c_template c_name (maybePtr mb_attr)-foreign import WINDOWS_CCONV unsafe "windows.h CreateDirectoryExW"-  c_CreateDirectoryEx :: LPCTSTR -> LPCTSTR -> LPSECURITY_ATTRIBUTES -> IO Bool  removeDirectory :: String -> IO () removeDirectory name =   withTString name $ \ c_name ->   failIfFalseWithRetry_ (unwords ["RemoveDirectory",show name]) $     c_RemoveDirectory c_name-foreign import WINDOWS_CCONV unsafe "windows.h RemoveDirectoryW"-  c_RemoveDirectory :: LPCTSTR -> IO Bool  getBinaryType :: String -> IO BinaryType getBinaryType name =@@ -666,8 +343,6 @@   failIfFalse_ (unwords ["GetBinaryType",show name]) $     c_GetBinaryType c_name p_btype   peek p_btype-foreign import WINDOWS_CCONV unsafe "windows.h GetBinaryTypeW"-  c_GetBinaryType :: LPCTSTR -> Ptr DWORD -> IO Bool  ---------------------------------------------------------------- -- HANDLE operations@@ -678,46 +353,32 @@   withTString name $ \ c_name ->   failIfWithRetry (==iNVALID_HANDLE_VALUE) (unwords ["CreateFile",show name]) $     c_CreateFile c_name access share (maybePtr mb_attr) mode flag (maybePtr mb_h)-foreign import WINDOWS_CCONV unsafe "windows.h CreateFileW"-  c_CreateFile :: LPCTSTR -> AccessMode -> ShareMode -> LPSECURITY_ATTRIBUTES -> CreateMode -> FileAttributeOrFlag -> HANDLE -> IO HANDLE  closeHandle :: HANDLE -> IO () closeHandle h =   failIfFalse_ "CloseHandle" $ c_CloseHandle h-foreign import WINDOWS_CCONV unsafe "windows.h CloseHandle"-  c_CloseHandle :: HANDLE -> IO Bool -foreign import WINDOWS_CCONV unsafe "windows.h GetFileType"-  getFileType :: HANDLE -> IO FileType --Apparently no error code  flushFileBuffers :: HANDLE -> IO () flushFileBuffers h =   failIfFalse_ "FlushFileBuffers" $ c_FlushFileBuffers h-foreign import WINDOWS_CCONV unsafe "windows.h FlushFileBuffers"-  c_FlushFileBuffers :: HANDLE -> IO Bool  setEndOfFile :: HANDLE -> IO () setEndOfFile h =   failIfFalse_ "SetEndOfFile" $ c_SetEndOfFile h-foreign import WINDOWS_CCONV unsafe "windows.h SetEndOfFile"-  c_SetEndOfFile :: HANDLE -> IO Bool  setFileAttributes :: String -> FileAttributeOrFlag -> IO () setFileAttributes name attr =   withTString name $ \ c_name ->   failIfFalseWithRetry_ (unwords ["SetFileAttributes",show name])     $ c_SetFileAttributes c_name attr-foreign import WINDOWS_CCONV unsafe "windows.h SetFileAttributesW"-  c_SetFileAttributes :: LPCTSTR -> FileAttributeOrFlag -> IO Bool  getFileAttributes :: String -> IO FileAttributeOrFlag getFileAttributes name =   withTString name $ \ c_name ->   failIfWithRetry (== 0xFFFFFFFF) (unwords ["GetFileAttributes",show name]) $     c_GetFileAttributes c_name-foreign import WINDOWS_CCONV unsafe "windows.h GetFileAttributesW"-  c_GetFileAttributes :: LPCTSTR -> IO FileAttributeOrFlag  getFileAttributesExStandard :: String -> IO WIN32_FILE_ATTRIBUTE_DATA getFileAttributesExStandard name =  alloca $ \res -> do@@ -725,51 +386,16 @@     failIfFalseWithRetry_ "getFileAttributesExStandard" $       c_GetFileAttributesEx c_name getFileExInfoStandard res   peek res-foreign import WINDOWS_CCONV unsafe "windows.h GetFileAttributesExW"-  c_GetFileAttributesEx :: LPCTSTR -> GET_FILEEX_INFO_LEVELS -> Ptr a -> IO BOOL  getFileInformationByHandle :: HANDLE -> IO BY_HANDLE_FILE_INFORMATION getFileInformationByHandle h = alloca $ \res -> do     failIfFalseWithRetry_ "GetFileInformationByHandle" $ c_GetFileInformationByHandle h res     peek res-foreign import WINDOWS_CCONV unsafe "windows.h GetFileInformationByHandle"-    c_GetFileInformationByHandle :: HANDLE -> Ptr BY_HANDLE_FILE_INFORMATION -> IO BOOL  ---------------------------------------------------------------- -- Read/write files ---------------------------------------------------------------- --- No support for this yet-data OVERLAPPED-  = OVERLAPPED { ovl_internal     :: ULONG_PTR-               , ovl_internalHigh :: ULONG_PTR-               , ovl_offset       :: DWORD-               , ovl_offsetHigh   :: DWORD-               , ovl_hEvent       :: HANDLE-               } deriving (Show)--instance Storable OVERLAPPED where-  sizeOf = const (#size OVERLAPPED)-  alignment _ = #alignment OVERLAPPED-  poke buf ad = do-      (#poke OVERLAPPED, Internal    ) buf (ovl_internal     ad)-      (#poke OVERLAPPED, InternalHigh) buf (ovl_internalHigh ad)-      (#poke OVERLAPPED, Offset      ) buf (ovl_offset       ad)-      (#poke OVERLAPPED, OffsetHigh  ) buf (ovl_offsetHigh   ad)-      (#poke OVERLAPPED, hEvent      ) buf (ovl_hEvent       ad)--  peek buf = do-      intnl      <- (#peek OVERLAPPED, Internal    ) buf-      intnl_high <- (#peek OVERLAPPED, InternalHigh) buf-      off        <- (#peek OVERLAPPED, Offset      ) buf-      off_high   <- (#peek OVERLAPPED, OffsetHigh  ) buf-      hevnt      <- (#peek OVERLAPPED, hEvent      ) buf-      return $ OVERLAPPED intnl intnl_high off off_high hevnt--type LPOVERLAPPED = Ptr OVERLAPPED--type MbLPOVERLAPPED = Maybe LPOVERLAPPED- --Sigh - I give up & prefix win32_ to the next two to avoid -- senseless Prelude name clashes. --sof. @@ -778,24 +404,18 @@   alloca $ \ p_n -> do   failIfFalse_ "ReadFile" $ c_ReadFile h buf n p_n (maybePtr mb_over)   peek p_n-foreign import WINDOWS_CCONV unsafe "windows.h ReadFile"-  c_ReadFile :: HANDLE -> Ptr a -> DWORD -> Ptr DWORD -> LPOVERLAPPED -> IO Bool  win32_WriteFile :: HANDLE -> Ptr a -> DWORD -> Maybe LPOVERLAPPED -> IO DWORD win32_WriteFile h buf n mb_over =   alloca $ \ p_n -> do   failIfFalse_ "WriteFile" $ c_WriteFile h buf n p_n (maybePtr mb_over)   peek p_n-foreign import WINDOWS_CCONV unsafe "windows.h WriteFile"-  c_WriteFile :: HANDLE -> Ptr a -> DWORD -> Ptr DWORD -> LPOVERLAPPED -> IO Bool  setFilePointerEx :: HANDLE -> LARGE_INTEGER -> FilePtrDirection -> IO LARGE_INTEGER setFilePointerEx h dist dir =   alloca $ \p_pos -> do   failIfFalse_ "SetFilePointerEx" $ c_SetFilePointerEx h dist p_pos dir   peek p_pos-foreign import WINDOWS_CCONV unsafe "windows.h SetFilePointerEx"-  c_SetFilePointerEx :: HANDLE -> LARGE_INTEGER -> Ptr LARGE_INTEGER -> FilePtrDirection -> IO Bool  ---------------------------------------------------------------- -- File Notifications@@ -809,29 +429,19 @@   withTString path $ \ c_path ->   failIfNull (unwords ["FindFirstChangeNotification",show path]) $     c_FindFirstChangeNotification c_path watch flag-foreign import WINDOWS_CCONV unsafe "windows.h FindFirstChangeNotificationW"-  c_FindFirstChangeNotification :: LPCTSTR -> Bool -> FileNotificationFlag -> IO HANDLE  findNextChangeNotification :: HANDLE -> IO () findNextChangeNotification h =   failIfFalse_ "FindNextChangeNotification" $ c_FindNextChangeNotification h-foreign import WINDOWS_CCONV unsafe "windows.h FindNextChangeNotification"-  c_FindNextChangeNotification :: HANDLE -> IO Bool  findCloseChangeNotification :: HANDLE -> IO () findCloseChangeNotification h =   failIfFalse_ "FindCloseChangeNotification" $ c_FindCloseChangeNotification h-foreign import WINDOWS_CCONV unsafe "windows.h FindCloseChangeNotification"-  c_FindCloseChangeNotification :: HANDLE -> IO Bool  ---------------------------------------------------------------- -- Directories ---------------------------------------------------------------- -type WIN32_FIND_DATA = ()--newtype FindData = FindData (ForeignPtr WIN32_FIND_DATA)- getFindDataFileName :: FindData -> IO FilePath getFindDataFileName (FindData fp) =   withForeignPtr fp $ \p ->@@ -845,8 +455,6 @@                 failIf (== iNVALID_HANDLE_VALUE) "findFirstFile" $                   c_FindFirstFile tstr p_finddata     return (handle, FindData fp_finddata)-foreign import WINDOWS_CCONV unsafe "windows.h FindFirstFileW"-  c_FindFirstFile :: LPCTSTR -> Ptr WIN32_FIND_DATA -> IO HANDLE  findNextFile :: HANDLE -> FindData -> IO Bool -- False -> no more files findNextFile h (FindData finddata) = do@@ -859,13 +467,9 @@              if err_code == (# const ERROR_NO_MORE_FILES )                 then return False                 else failWith "findNextFile" err_code-foreign import WINDOWS_CCONV unsafe "windows.h FindNextFileW"-  c_FindNextFile :: HANDLE -> Ptr WIN32_FIND_DATA -> IO BOOL  findClose :: HANDLE -> IO () findClose h = failIfFalse_ "findClose" $ c_FindClose h-foreign import WINDOWS_CCONV unsafe "windows.h FindClose"-  c_FindClose :: HANDLE -> IO BOOL  ---------------------------------------------------------------- -- DOS Device flags@@ -876,33 +480,12 @@   maybeWith withTString path $ \ c_path ->   withTString name $ \ c_name ->   failIfFalse_ "DefineDosDevice" $ c_DefineDosDevice flags c_name c_path-foreign import WINDOWS_CCONV unsafe "windows.h DefineDosDeviceW"-  c_DefineDosDevice :: DefineDosDeviceFlags -> LPCTSTR -> LPCTSTR -> IO Bool  ---------------------------------------------------------------- --- These functions are very unusual in the Win32 API:--- They don't return error codes--foreign import WINDOWS_CCONV unsafe "windows.h AreFileApisANSI"-  areFileApisANSI :: IO Bool--foreign import WINDOWS_CCONV unsafe "windows.h SetFileApisToOEM"-  setFileApisToOEM :: IO ()--foreign import WINDOWS_CCONV unsafe "windows.h SetFileApisToANSI"-  setFileApisToANSI :: IO ()--foreign import WINDOWS_CCONV unsafe "windows.h SetHandleCount"-  setHandleCount :: UINT -> IO UINT------------------------------------------------------------------- getLogicalDrives :: IO DWORD getLogicalDrives =   failIfZero "GetLogicalDrives" $ c_GetLogicalDrives-foreign import WINDOWS_CCONV unsafe "windows.h GetLogicalDrives"-  c_GetLogicalDrives :: IO DWORD  -- %fun GetDriveType :: Maybe String -> IO DriveType @@ -920,16 +503,12 @@   nfree <- peek p_nfree   nclusters <- peek p_nclusters   return (sectors, bytes, nfree, nclusters)-foreign import WINDOWS_CCONV unsafe "windows.h GetDiskFreeSpaceW"-  c_GetDiskFreeSpace :: LPCTSTR -> Ptr DWORD -> Ptr DWORD -> Ptr DWORD -> Ptr DWORD -> IO Bool  setVolumeLabel :: Maybe String -> Maybe String -> IO () setVolumeLabel path name =   maybeWith withTString path $ \ c_path ->   maybeWith withTString name $ \ c_name ->   failIfFalse_ "SetVolumeLabel" $ c_SetVolumeLabel c_path c_name-foreign import WINDOWS_CCONV unsafe "windows.h SetVolumeLabelW"-  c_SetVolumeLabel :: LPCTSTR -> LPCTSTR -> IO Bool  ---------------------------------------------------------------- -- File locks@@ -951,10 +530,6 @@          ovlp  = OVERLAPPED 0 0 o_low o_hi nullPtr      with ovlp $ \ptr -> c_LockFileEx hwnd mode 0 s_low s_hi ptr -foreign import WINDOWS_CCONV unsafe "LockFileEx"-  c_LockFileEx :: HANDLE -> DWORD -> DWORD -> DWORD -> DWORD -> LPOVERLAPPED-               -> IO BOOL- -- | Unlocks a given range in a file handle, To unlock an entire file --   use 0xFFFFFFFFFFFFFFFF for size and 0 for offset. unlockFile :: HANDLE  -- ^ CreateFile handle@@ -969,9 +544,6 @@          o_hi  = fromIntegral (f_offset `shiftR` 32)          ovlp  = OVERLAPPED 0 0 o_low o_hi nullPtr      with ovlp $ \ptr -> c_UnlockFileEx hwnd 0 s_low s_hi ptr--foreign import WINDOWS_CCONV unsafe "UnlockFileEx"-  c_UnlockFileEx :: HANDLE -> DWORD -> DWORD -> DWORD -> LPOVERLAPPED -> IO BOOL  ---------------------------------------------------------------- -- End

@@ -0,0 +1,529 @@+#if __GLASGOW_HASKELL__ >= 709+{-# LANGUAGE Safe #-}+#else+{-# LANGUAGE Trustworthy #-}+#endif+-----------------------------------------------------------------------------+-- |+-- Module      :  System.Win32.File.Internal+-- Copyright   :  (c) Alastair Reid, 1997-2003+-- License     :  BSD-style (see the file libraries/base/LICENSE)+--+-- Maintainer  :  Esa Ilari Vuokko <ei@vuokko.info>+-- Stability   :  provisional+-- Portability :  portable+--+-- A collection of FFI declarations for interfacing with Win32.+--+-----------------------------------------------------------------------------++module System.Win32.File.Internal where++import System.Win32.Types+import System.Win32.Time++import Foreign hiding (void)++##include "windows_cconv.h"++#include <windows.h>+#include "alignment.h"++----------------------------------------------------------------+-- Enumeration types+----------------------------------------------------------------++type AccessMode   = UINT++gENERIC_NONE :: AccessMode+gENERIC_NONE = 0++#{enum AccessMode,+ , gENERIC_READ              = GENERIC_READ+ , gENERIC_WRITE             = GENERIC_WRITE+ , gENERIC_EXECUTE           = GENERIC_EXECUTE+ , gENERIC_ALL               = GENERIC_ALL+ , dELETE                    = DELETE+ , rEAD_CONTROL              = READ_CONTROL+ , wRITE_DAC                 = WRITE_DAC+ , wRITE_OWNER               = WRITE_OWNER+ , sYNCHRONIZE               = SYNCHRONIZE+ , sTANDARD_RIGHTS_REQUIRED  = STANDARD_RIGHTS_REQUIRED+ , sTANDARD_RIGHTS_READ      = STANDARD_RIGHTS_READ+ , sTANDARD_RIGHTS_WRITE     = STANDARD_RIGHTS_WRITE+ , sTANDARD_RIGHTS_EXECUTE   = STANDARD_RIGHTS_EXECUTE+ , sTANDARD_RIGHTS_ALL       = STANDARD_RIGHTS_ALL+ , sPECIFIC_RIGHTS_ALL       = SPECIFIC_RIGHTS_ALL+ , aCCESS_SYSTEM_SECURITY    = ACCESS_SYSTEM_SECURITY+ , mAXIMUM_ALLOWED           = MAXIMUM_ALLOWED+ , fILE_ADD_FILE             = FILE_ADD_FILE+ , fILE_ADD_SUBDIRECTORY     = FILE_ADD_SUBDIRECTORY+ , fILE_ALL_ACCESS           = FILE_ALL_ACCESS+ , fILE_APPEND_DATA          = FILE_APPEND_DATA+ , fILE_CREATE_PIPE_INSTANCE = FILE_CREATE_PIPE_INSTANCE+ , fILE_DELETE_CHILD         = FILE_DELETE_CHILD+ , fILE_EXECUTE              = FILE_EXECUTE+ , fILE_LIST_DIRECTORY       = FILE_LIST_DIRECTORY+ , fILE_READ_ATTRIBUTES      = FILE_READ_ATTRIBUTES+ , fILE_READ_DATA            = FILE_READ_DATA+ , fILE_READ_EA              = FILE_READ_EA+ , fILE_TRAVERSE             = FILE_TRAVERSE+ , fILE_WRITE_ATTRIBUTES     = FILE_WRITE_ATTRIBUTES+ , fILE_WRITE_DATA           = FILE_WRITE_DATA+ , fILE_WRITE_EA             = FILE_WRITE_EA+ }++----------------------------------------------------------------++type ShareMode   = UINT++fILE_SHARE_NONE :: ShareMode+fILE_SHARE_NONE = 0++#{enum ShareMode,+ , fILE_SHARE_READ      = FILE_SHARE_READ+ , fILE_SHARE_WRITE     = FILE_SHARE_WRITE+ , fILE_SHARE_DELETE    = FILE_SHARE_DELETE+ }++----------------------------------------------------------------++type CreateMode   = UINT++#{enum CreateMode,+ , cREATE_NEW           = CREATE_NEW+ , cREATE_ALWAYS        = CREATE_ALWAYS+ , oPEN_EXISTING        = OPEN_EXISTING+ , oPEN_ALWAYS          = OPEN_ALWAYS+ , tRUNCATE_EXISTING    = TRUNCATE_EXISTING+ }++----------------------------------------------------------------++type FileAttributeOrFlag   = UINT++#{enum FileAttributeOrFlag,+ , fILE_ATTRIBUTE_READONLY      = FILE_ATTRIBUTE_READONLY+ , fILE_ATTRIBUTE_HIDDEN        = FILE_ATTRIBUTE_HIDDEN+ , fILE_ATTRIBUTE_SYSTEM        = FILE_ATTRIBUTE_SYSTEM+ , fILE_ATTRIBUTE_DIRECTORY     = FILE_ATTRIBUTE_DIRECTORY+ , fILE_ATTRIBUTE_ARCHIVE       = FILE_ATTRIBUTE_ARCHIVE+ , fILE_ATTRIBUTE_NORMAL        = FILE_ATTRIBUTE_NORMAL+ , fILE_ATTRIBUTE_TEMPORARY     = FILE_ATTRIBUTE_TEMPORARY+ , fILE_ATTRIBUTE_COMPRESSED    = FILE_ATTRIBUTE_COMPRESSED+ , fILE_ATTRIBUTE_REPARSE_POINT = FILE_ATTRIBUTE_REPARSE_POINT+ , fILE_FLAG_WRITE_THROUGH      = FILE_FLAG_WRITE_THROUGH+ , fILE_FLAG_OVERLAPPED         = FILE_FLAG_OVERLAPPED+ , fILE_FLAG_NO_BUFFERING       = FILE_FLAG_NO_BUFFERING+ , fILE_FLAG_RANDOM_ACCESS      = FILE_FLAG_RANDOM_ACCESS+ , fILE_FLAG_SEQUENTIAL_SCAN    = FILE_FLAG_SEQUENTIAL_SCAN+ , fILE_FLAG_DELETE_ON_CLOSE    = FILE_FLAG_DELETE_ON_CLOSE+ , fILE_FLAG_BACKUP_SEMANTICS   = FILE_FLAG_BACKUP_SEMANTICS+ , fILE_FLAG_POSIX_SEMANTICS    = FILE_FLAG_POSIX_SEMANTICS+ }+#ifndef __WINE_WINDOWS_H+#{enum FileAttributeOrFlag,+ , sECURITY_ANONYMOUS           = SECURITY_ANONYMOUS+ , sECURITY_IDENTIFICATION      = SECURITY_IDENTIFICATION+ , sECURITY_IMPERSONATION       = SECURITY_IMPERSONATION+ , sECURITY_DELEGATION          = SECURITY_DELEGATION+ , sECURITY_CONTEXT_TRACKING    = SECURITY_CONTEXT_TRACKING+ , sECURITY_EFFECTIVE_ONLY      = SECURITY_EFFECTIVE_ONLY+ , sECURITY_SQOS_PRESENT        = SECURITY_SQOS_PRESENT+ , sECURITY_VALID_SQOS_FLAGS    = SECURITY_VALID_SQOS_FLAGS+ }+#endif++----------------------------------------------------------------++type MoveFileFlag   = DWORD++#{enum MoveFileFlag,+ , mOVEFILE_REPLACE_EXISTING    = MOVEFILE_REPLACE_EXISTING+ , mOVEFILE_COPY_ALLOWED        = MOVEFILE_COPY_ALLOWED+ , mOVEFILE_DELAY_UNTIL_REBOOT  = MOVEFILE_DELAY_UNTIL_REBOOT+ }++----------------------------------------------------------------++type FilePtrDirection   = DWORD++#{enum FilePtrDirection,+ , fILE_BEGIN   = FILE_BEGIN+ , fILE_CURRENT = FILE_CURRENT+ , fILE_END     = FILE_END+ }++----------------------------------------------------------------++type DriveType = UINT++#{enum DriveType,+ , dRIVE_UNKNOWN        = DRIVE_UNKNOWN+ , dRIVE_NO_ROOT_DIR    = DRIVE_NO_ROOT_DIR+ , dRIVE_REMOVABLE      = DRIVE_REMOVABLE+ , dRIVE_FIXED          = DRIVE_FIXED+ , dRIVE_REMOTE         = DRIVE_REMOTE+ , dRIVE_CDROM          = DRIVE_CDROM+ , dRIVE_RAMDISK        = DRIVE_RAMDISK+ }++----------------------------------------------------------------++type DefineDosDeviceFlags = DWORD++#{enum DefineDosDeviceFlags,+ , dDD_RAW_TARGET_PATH          = DDD_RAW_TARGET_PATH+ , dDD_REMOVE_DEFINITION        = DDD_REMOVE_DEFINITION+ , dDD_EXACT_MATCH_ON_REMOVE    = DDD_EXACT_MATCH_ON_REMOVE+ }++----------------------------------------------------------------++type BinaryType = DWORD++#{enum BinaryType,+ , sCS_32BIT_BINARY     = SCS_32BIT_BINARY+ , sCS_DOS_BINARY       = SCS_DOS_BINARY+ , sCS_WOW_BINARY       = SCS_WOW_BINARY+ , sCS_PIF_BINARY       = SCS_PIF_BINARY+ , sCS_POSIX_BINARY     = SCS_POSIX_BINARY+ , sCS_OS216_BINARY     = SCS_OS216_BINARY+ }++----------------------------------------------------------------++type FileNotificationFlag = DWORD++#{enum FileNotificationFlag,+ , fILE_NOTIFY_CHANGE_FILE_NAME  = FILE_NOTIFY_CHANGE_FILE_NAME+ , fILE_NOTIFY_CHANGE_DIR_NAME   = FILE_NOTIFY_CHANGE_DIR_NAME+ , fILE_NOTIFY_CHANGE_ATTRIBUTES = FILE_NOTIFY_CHANGE_ATTRIBUTES+ , fILE_NOTIFY_CHANGE_SIZE       = FILE_NOTIFY_CHANGE_SIZE+ , fILE_NOTIFY_CHANGE_LAST_WRITE = FILE_NOTIFY_CHANGE_LAST_WRITE+ , fILE_NOTIFY_CHANGE_SECURITY   = FILE_NOTIFY_CHANGE_SECURITY+ }++----------------------------------------------------------------++type FileType = DWORD++#{enum FileType,+ , fILE_TYPE_UNKNOWN    = FILE_TYPE_UNKNOWN+ , fILE_TYPE_DISK       = FILE_TYPE_DISK+ , fILE_TYPE_CHAR       = FILE_TYPE_CHAR+ , fILE_TYPE_PIPE       = FILE_TYPE_PIPE+ , fILE_TYPE_REMOTE     = FILE_TYPE_REMOTE+ }++----------------------------------------------------------------++type LockMode = DWORD++#{enum LockMode,+ , lOCKFILE_EXCLUSIVE_LOCK   = LOCKFILE_EXCLUSIVE_LOCK+ , lOCKFILE_FAIL_IMMEDIATELY = LOCKFILE_FAIL_IMMEDIATELY+ }++----------------------------------------------------------------++newtype GET_FILEEX_INFO_LEVELS = GET_FILEEX_INFO_LEVELS (#type GET_FILEEX_INFO_LEVELS)+    deriving (Eq, Ord)++#{enum GET_FILEEX_INFO_LEVELS, GET_FILEEX_INFO_LEVELS+ , getFileExInfoStandard = GetFileExInfoStandard+ , getFileExMaxInfoLevel = GetFileExMaxInfoLevel+ }++----------------------------------------------------------------++data SECURITY_ATTRIBUTES = SECURITY_ATTRIBUTES+    { nLength              :: !DWORD+    , lpSecurityDescriptor :: !LPVOID+    , bInheritHandle       :: !BOOL+    } deriving Show++type PSECURITY_ATTRIBUTES = Ptr SECURITY_ATTRIBUTES+type LPSECURITY_ATTRIBUTES = Ptr SECURITY_ATTRIBUTES+type MbLPSECURITY_ATTRIBUTES = Maybe LPSECURITY_ATTRIBUTES++instance Storable SECURITY_ATTRIBUTES where+    sizeOf = const #{size SECURITY_ATTRIBUTES}+    alignment _ = #alignment SECURITY_ATTRIBUTES+    poke buf input = do+        (#poke SECURITY_ATTRIBUTES, nLength)              buf (nLength input)+        (#poke SECURITY_ATTRIBUTES, lpSecurityDescriptor) buf (lpSecurityDescriptor input)+        (#poke SECURITY_ATTRIBUTES, bInheritHandle)       buf (bInheritHandle input)+    peek buf = do+        nLength'              <- (#peek SECURITY_ATTRIBUTES, nLength)              buf+        lpSecurityDescriptor' <- (#peek SECURITY_ATTRIBUTES, lpSecurityDescriptor) buf+        bInheritHandle'       <- (#peek SECURITY_ATTRIBUTES, bInheritHandle)       buf+        return $ SECURITY_ATTRIBUTES nLength' lpSecurityDescriptor' bInheritHandle'++----------------------------------------------------------------+-- Other types+----------------------------------------------------------------++data BY_HANDLE_FILE_INFORMATION = BY_HANDLE_FILE_INFORMATION+    { bhfiFileAttributes :: FileAttributeOrFlag+    , bhfiCreationTime, bhfiLastAccessTime, bhfiLastWriteTime :: FILETIME+    , bhfiVolumeSerialNumber :: DWORD+    , bhfiSize :: DDWORD+    , bhfiNumberOfLinks :: DWORD+    , bhfiFileIndex :: DDWORD+    } deriving (Show)++instance Storable BY_HANDLE_FILE_INFORMATION where+    sizeOf = const (#size BY_HANDLE_FILE_INFORMATION)+    alignment _ = #alignment BY_HANDLE_FILE_INFORMATION+    poke buf bhi = do+        (#poke BY_HANDLE_FILE_INFORMATION, dwFileAttributes)     buf (bhfiFileAttributes bhi)+        (#poke BY_HANDLE_FILE_INFORMATION, ftCreationTime)       buf (bhfiCreationTime bhi)+        (#poke BY_HANDLE_FILE_INFORMATION, ftLastAccessTime)     buf (bhfiLastAccessTime bhi)+        (#poke BY_HANDLE_FILE_INFORMATION, ftLastWriteTime)      buf (bhfiLastWriteTime bhi)+        (#poke BY_HANDLE_FILE_INFORMATION, dwVolumeSerialNumber) buf (bhfiVolumeSerialNumber bhi)+        (#poke BY_HANDLE_FILE_INFORMATION, nFileSizeHigh)        buf sizeHi+        (#poke BY_HANDLE_FILE_INFORMATION, nFileSizeLow)         buf sizeLow+        (#poke BY_HANDLE_FILE_INFORMATION, nNumberOfLinks)       buf (bhfiNumberOfLinks bhi)+        (#poke BY_HANDLE_FILE_INFORMATION, nFileIndexHigh)       buf idxHi+        (#poke BY_HANDLE_FILE_INFORMATION, nFileIndexLow)        buf idxLow+        where+            (sizeHi,sizeLow) = ddwordToDwords $ bhfiSize bhi+            (idxHi,idxLow) = ddwordToDwords $ bhfiFileIndex bhi++    peek buf = do+        attr <- (#peek BY_HANDLE_FILE_INFORMATION, dwFileAttributes)     buf+        ctim <- (#peek BY_HANDLE_FILE_INFORMATION, ftCreationTime)       buf+        lati <- (#peek BY_HANDLE_FILE_INFORMATION, ftLastAccessTime)     buf+        lwti <- (#peek BY_HANDLE_FILE_INFORMATION, ftLastWriteTime)      buf+        vser <- (#peek BY_HANDLE_FILE_INFORMATION, dwVolumeSerialNumber) buf+        fshi <- (#peek BY_HANDLE_FILE_INFORMATION, nFileSizeHigh)        buf+        fslo <- (#peek BY_HANDLE_FILE_INFORMATION, nFileSizeLow)         buf+        link <- (#peek BY_HANDLE_FILE_INFORMATION, nNumberOfLinks)       buf+        idhi <- (#peek BY_HANDLE_FILE_INFORMATION, nFileIndexHigh)       buf+        idlo <- (#peek BY_HANDLE_FILE_INFORMATION, nFileIndexLow)        buf+        return $ BY_HANDLE_FILE_INFORMATION attr ctim lati lwti vser+            (dwordsToDdword (fshi,fslo)) link (dwordsToDdword (idhi,idlo))++----------------------------------------------------------------++data WIN32_FILE_ATTRIBUTE_DATA = WIN32_FILE_ATTRIBUTE_DATA+    { fadFileAttributes :: DWORD+    , fadCreationTime , fadLastAccessTime , fadLastWriteTime :: FILETIME+    , fadFileSize :: DDWORD+    } deriving (Show)++instance Storable WIN32_FILE_ATTRIBUTE_DATA where+    sizeOf = const (#size WIN32_FILE_ATTRIBUTE_DATA)+    alignment _ = #alignment WIN32_FILE_ATTRIBUTE_DATA+    poke buf ad = do+        (#poke WIN32_FILE_ATTRIBUTE_DATA, dwFileAttributes) buf (fadFileAttributes ad)+        (#poke WIN32_FILE_ATTRIBUTE_DATA, ftCreationTime)   buf (fadCreationTime ad)+        (#poke WIN32_FILE_ATTRIBUTE_DATA, ftLastAccessTime) buf (fadLastAccessTime ad)+        (#poke WIN32_FILE_ATTRIBUTE_DATA, ftLastWriteTime)  buf (fadLastWriteTime ad)+        (#poke WIN32_FILE_ATTRIBUTE_DATA, nFileSizeHigh)    buf sizeHi+        (#poke WIN32_FILE_ATTRIBUTE_DATA, nFileSizeLow)     buf sizeLo+        where+            (sizeHi,sizeLo) = ddwordToDwords $ fadFileSize ad++    peek buf = do+        attr <- (#peek WIN32_FILE_ATTRIBUTE_DATA, dwFileAttributes) buf+        ctim <- (#peek WIN32_FILE_ATTRIBUTE_DATA, ftCreationTime)   buf+        lati <- (#peek WIN32_FILE_ATTRIBUTE_DATA, ftLastAccessTime) buf+        lwti <- (#peek WIN32_FILE_ATTRIBUTE_DATA, ftLastWriteTime)  buf+        fshi <- (#peek WIN32_FILE_ATTRIBUTE_DATA, nFileSizeHigh)    buf+        fslo <- (#peek WIN32_FILE_ATTRIBUTE_DATA, nFileSizeLow)     buf+        return $ WIN32_FILE_ATTRIBUTE_DATA attr ctim lati lwti+            (dwordsToDdword (fshi,fslo))++----------------------------------------------------------------+-- File operations+----------------------------------------------------------------++foreign import WINDOWS_CCONV unsafe "windows.h DeleteFileW"+  c_DeleteFile :: LPCTSTR -> IO Bool++foreign import WINDOWS_CCONV unsafe "windows.h CopyFileW"+  c_CopyFile :: LPCTSTR -> LPCTSTR -> Bool -> IO Bool++foreign import WINDOWS_CCONV unsafe "windows.h MoveFileW"+  c_MoveFile :: LPCTSTR -> LPCTSTR -> IO Bool++foreign import WINDOWS_CCONV unsafe "windows.h MoveFileExW"+  c_MoveFileEx :: LPCTSTR -> LPCTSTR -> MoveFileFlag -> IO Bool++foreign import WINDOWS_CCONV unsafe "windows.h SetCurrentDirectoryW"+  c_SetCurrentDirectory :: LPCTSTR -> IO Bool++foreign import WINDOWS_CCONV unsafe "windows.h CreateDirectoryW"+  c_CreateDirectory :: LPCTSTR -> LPSECURITY_ATTRIBUTES -> IO Bool++foreign import WINDOWS_CCONV unsafe "windows.h CreateDirectoryExW"+  c_CreateDirectoryEx :: LPCTSTR -> LPCTSTR -> LPSECURITY_ATTRIBUTES -> IO Bool++foreign import WINDOWS_CCONV unsafe "windows.h RemoveDirectoryW"+  c_RemoveDirectory :: LPCTSTR -> IO Bool++foreign import WINDOWS_CCONV unsafe "windows.h GetBinaryTypeW"+  c_GetBinaryType :: LPCTSTR -> Ptr DWORD -> IO Bool++----------------------------------------------------------------+-- HANDLE operations+----------------------------------------------------------------++foreign import WINDOWS_CCONV unsafe "windows.h CreateFileW"+  c_CreateFile :: LPCTSTR -> AccessMode -> ShareMode -> LPSECURITY_ATTRIBUTES -> CreateMode -> FileAttributeOrFlag -> HANDLE -> IO HANDLE++foreign import WINDOWS_CCONV unsafe "windows.h CloseHandle"+  c_CloseHandle :: HANDLE -> IO Bool++foreign import WINDOWS_CCONV unsafe "windows.h GetFileType"+  getFileType :: HANDLE -> IO FileType+--Apparently no error code++foreign import WINDOWS_CCONV unsafe "windows.h FlushFileBuffers"+  c_FlushFileBuffers :: HANDLE -> IO Bool++foreign import WINDOWS_CCONV unsafe "windows.h SetEndOfFile"+  c_SetEndOfFile :: HANDLE -> IO Bool++foreign import WINDOWS_CCONV unsafe "windows.h SetFileAttributesW"+  c_SetFileAttributes :: LPCTSTR -> FileAttributeOrFlag -> IO Bool++foreign import WINDOWS_CCONV unsafe "windows.h GetFileAttributesW"+  c_GetFileAttributes :: LPCTSTR -> IO FileAttributeOrFlag++foreign import WINDOWS_CCONV unsafe "windows.h GetFileAttributesExW"+  c_GetFileAttributesEx :: LPCTSTR -> GET_FILEEX_INFO_LEVELS -> Ptr a -> IO BOOL++foreign import WINDOWS_CCONV unsafe "windows.h GetFileInformationByHandle"+    c_GetFileInformationByHandle :: HANDLE -> Ptr BY_HANDLE_FILE_INFORMATION -> IO BOOL++----------------------------------------------------------------+-- Read/write files+----------------------------------------------------------------++-- No support for this yet+data OVERLAPPED+  = OVERLAPPED { ovl_internal     :: ULONG_PTR+               , ovl_internalHigh :: ULONG_PTR+               , ovl_offset       :: DWORD+               , ovl_offsetHigh   :: DWORD+               , ovl_hEvent       :: HANDLE+               } deriving (Show)++instance Storable OVERLAPPED where+  sizeOf = const (#size OVERLAPPED)+  alignment _ = #alignment OVERLAPPED+  poke buf ad = do+      (#poke OVERLAPPED, Internal    ) buf (ovl_internal     ad)+      (#poke OVERLAPPED, InternalHigh) buf (ovl_internalHigh ad)+      (#poke OVERLAPPED, Offset      ) buf (ovl_offset       ad)+      (#poke OVERLAPPED, OffsetHigh  ) buf (ovl_offsetHigh   ad)+      (#poke OVERLAPPED, hEvent      ) buf (ovl_hEvent       ad)++  peek buf = do+      intnl      <- (#peek OVERLAPPED, Internal    ) buf+      intnl_high <- (#peek OVERLAPPED, InternalHigh) buf+      off        <- (#peek OVERLAPPED, Offset      ) buf+      off_high   <- (#peek OVERLAPPED, OffsetHigh  ) buf+      hevnt      <- (#peek OVERLAPPED, hEvent      ) buf+      return $ OVERLAPPED intnl intnl_high off off_high hevnt++type LPOVERLAPPED = Ptr OVERLAPPED++type MbLPOVERLAPPED = Maybe LPOVERLAPPED++foreign import WINDOWS_CCONV unsafe "windows.h ReadFile"+  c_ReadFile :: HANDLE -> Ptr a -> DWORD -> Ptr DWORD -> LPOVERLAPPED -> IO Bool++foreign import WINDOWS_CCONV unsafe "windows.h WriteFile"+  c_WriteFile :: HANDLE -> Ptr a -> DWORD -> Ptr DWORD -> LPOVERLAPPED -> IO Bool++foreign import WINDOWS_CCONV unsafe "windows.h SetFilePointerEx"+  c_SetFilePointerEx :: HANDLE -> LARGE_INTEGER -> Ptr LARGE_INTEGER -> FilePtrDirection -> IO Bool++----------------------------------------------------------------+-- File Notifications+--+-- Use these to initialise, "increment" and close a HANDLE you can wait+-- on.+----------------------------------------------------------------++foreign import WINDOWS_CCONV unsafe "windows.h FindFirstChangeNotificationW"+  c_FindFirstChangeNotification :: LPCTSTR -> Bool -> FileNotificationFlag -> IO HANDLE++foreign import WINDOWS_CCONV unsafe "windows.h FindNextChangeNotification"+  c_FindNextChangeNotification :: HANDLE -> IO Bool++foreign import WINDOWS_CCONV unsafe "windows.h FindCloseChangeNotification"+  c_FindCloseChangeNotification :: HANDLE -> IO Bool++----------------------------------------------------------------+-- Directories+----------------------------------------------------------------++type WIN32_FIND_DATA = ()++newtype FindData = FindData (ForeignPtr WIN32_FIND_DATA)++foreign import WINDOWS_CCONV unsafe "windows.h FindFirstFileW"+  c_FindFirstFile :: LPCTSTR -> Ptr WIN32_FIND_DATA -> IO HANDLE++foreign import WINDOWS_CCONV unsafe "windows.h FindNextFileW"+  c_FindNextFile :: HANDLE -> Ptr WIN32_FIND_DATA -> IO BOOL++foreign import WINDOWS_CCONV unsafe "windows.h FindClose"+  c_FindClose :: HANDLE -> IO BOOL++----------------------------------------------------------------+-- DOS Device flags+----------------------------------------------------------------++foreign import WINDOWS_CCONV unsafe "windows.h DefineDosDeviceW"+  c_DefineDosDevice :: DefineDosDeviceFlags -> LPCTSTR -> LPCTSTR -> IO Bool++----------------------------------------------------------------++-- These functions are very unusual in the Win32 API:+-- They don't return error codes++foreign import WINDOWS_CCONV unsafe "windows.h AreFileApisANSI"+  areFileApisANSI :: IO Bool++foreign import WINDOWS_CCONV unsafe "windows.h SetFileApisToOEM"+  setFileApisToOEM :: IO ()++foreign import WINDOWS_CCONV unsafe "windows.h SetFileApisToANSI"+  setFileApisToANSI :: IO ()++foreign import WINDOWS_CCONV unsafe "windows.h SetHandleCount"+  setHandleCount :: UINT -> IO UINT++----------------------------------------------------------------++foreign import WINDOWS_CCONV unsafe "windows.h GetLogicalDrives"+  c_GetLogicalDrives :: IO DWORD++-- %fun GetDriveType :: Maybe String -> IO DriveType++foreign import WINDOWS_CCONV unsafe "windows.h GetDiskFreeSpaceW"+  c_GetDiskFreeSpace :: LPCTSTR -> Ptr DWORD -> Ptr DWORD -> Ptr DWORD -> Ptr DWORD -> IO Bool++foreign import WINDOWS_CCONV unsafe "windows.h SetVolumeLabelW"+  c_SetVolumeLabel :: LPCTSTR -> LPCTSTR -> IO Bool++----------------------------------------------------------------+-- File locks+----------------------------------------------------------------++foreign import WINDOWS_CCONV unsafe "LockFileEx"+  c_LockFileEx :: HANDLE -> DWORD -> DWORD -> DWORD -> DWORD -> LPOVERLAPPED+               -> IO BOOL++foreign import WINDOWS_CCONV unsafe "UnlockFileEx"+  c_UnlockFileEx :: HANDLE -> DWORD -> DWORD -> DWORD -> LPOVERLAPPED -> IO BOOL++----------------------------------------------------------------+-- End+----------------------------------------------------------------

@@ -44,7 +44,9 @@     , unmapViewOfFile     ) where -import System.Win32.Types   ( HANDLE, DWORD, BOOL, SIZE_T, LPCTSTR, withTString++import System.Win32.FileMapping.Internal+import System.Win32.Types   ( HANDLE, BOOL, SIZE_T, withTString                             , failIf, failIfNull, DDWORD, ddwordToDwords                             , iNVALID_HANDLE_VALUE ) import System.Win32.Mem@@ -52,9 +54,8 @@ import System.Win32.Info  import Control.Exception        ( mask_, bracket )-import Foreign                  ( Ptr, nullPtr, plusPtr, maybeWith, FunPtr+import Foreign                  ( Ptr, nullPtr, plusPtr, maybeWith                                 , ForeignPtr, newForeignPtr )-import Foreign.C.Types (CUIntPtr(..))  ##include "windows_cconv.h" @@ -81,8 +82,6 @@                     newForeignPtr c_UnmapViewOfFileFinaliser ptr                 return (fp, fromIntegral $ bhfiSize fi) -data MappedObject = MappedObject HANDLE HANDLE FileMapAccess- -- | Opens an existing file and creates mapping object to it. withMappedFile     :: FilePath             -- ^ Path@@ -128,24 +127,6 @@         (act . flip plusPtr (fromIntegral offset))  ------------------------------------------------------------------------------ Enums-----------------------------------------------------------------------------type ProtectSectionFlags = DWORD-#{enum ProtectSectionFlags,-    , sEC_COMMIT    = SEC_COMMIT-    , sEC_IMAGE     = SEC_IMAGE-    , sEC_NOCACHE   = SEC_NOCACHE-    , sEC_RESERVE   = SEC_RESERVE-    }-type FileMapAccess = DWORD-#{enum FileMapAccess,-    , fILE_MAP_ALL_ACCESS   = FILE_MAP_ALL_ACCESS-    , fILE_MAP_COPY         = FILE_MAP_COPY-    , fILE_MAP_READ         = FILE_MAP_READ-    , fILE_MAP_WRITE        = FILE_MAP_WRITE-    }----------------------------------------------------------------------------- -- API in Haskell --------------------------------------------------------------------------- createFileMapping :: Maybe HANDLE -> ProtectFlags -> DDWORD -> Maybe String -> IO HANDLE@@ -175,21 +156,3 @@ unmapViewOfFile :: Ptr a -> IO () unmapViewOfFile v = c_UnmapViewOfFile v >> return () ------------------------------------------------------------------------------- Imports-----------------------------------------------------------------------------foreign import WINDOWS_CCONV "windows.h OpenFileMappingW"-    c_OpenFileMapping :: DWORD -> BOOL -> LPCTSTR -> IO HANDLE--foreign import WINDOWS_CCONV "windows.h CreateFileMappingW"-    c_CreateFileMapping :: HANDLE -> Ptr () -> DWORD -> DWORD -> DWORD -> LPCTSTR -> IO HANDLE--foreign import WINDOWS_CCONV "windows.h MapViewOfFileEx"-    c_MapViewOfFileEx :: HANDLE -> DWORD -> DWORD -> DWORD -> SIZE_T -> Ptr a -> IO (Ptr b)--foreign import WINDOWS_CCONV "windows.h UnmapViewOfFile"-    c_UnmapViewOfFile :: Ptr a -> IO BOOL--{-# CFILES cbits/HsWin32.c #-}-foreign import ccall "HsWin32.h &UnmapViewOfFileFinaliser"-    c_UnmapViewOfFileFinaliser :: FunPtr (Ptr a -> IO ())

@@ -0,0 +1,72 @@+#if __GLASGOW_HASKELL__ >= 709+{-# LANGUAGE Safe #-}+#else+{-# LANGUAGE Trustworthy #-}+#endif+-----------------------------------------------------------------------------+-- |+-- Module      :  System.Win32.FileMapping.Internal+-- Copyright   :  (c) Esa Ilari Vuokko, 2006+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Esa Ilari Vuokko <ei@vuokko.info>+-- Stability   :  provisional+-- Portability :  portable+--+-- A collection of FFI declarations for interfacing with Win32 mapped files.+--+-----------------------------------------------------------------------------+module System.Win32.FileMapping.Internal where++import System.Win32.Types   ( HANDLE, DWORD, BOOL, SIZE_T, LPCTSTR )++import Foreign                  ( Ptr, FunPtr )+import Foreign.C.Types (CUIntPtr(..))++##include "windows_cconv.h"++#include "windows.h"++---------------------------------------------------------------------------+-- Derived functions+---------------------------------------------------------------------------++data MappedObject = MappedObject HANDLE HANDLE FileMapAccess+++---------------------------------------------------------------------------+-- Enums+---------------------------------------------------------------------------+type ProtectSectionFlags = DWORD+#{enum ProtectSectionFlags,+    , sEC_COMMIT    = SEC_COMMIT+    , sEC_IMAGE     = SEC_IMAGE+    , sEC_NOCACHE   = SEC_NOCACHE+    , sEC_RESERVE   = SEC_RESERVE+    }+type FileMapAccess = DWORD+#{enum FileMapAccess,+    , fILE_MAP_ALL_ACCESS   = FILE_MAP_ALL_ACCESS+    , fILE_MAP_COPY         = FILE_MAP_COPY+    , fILE_MAP_READ         = FILE_MAP_READ+    , fILE_MAP_WRITE        = FILE_MAP_WRITE+    }++---------------------------------------------------------------------------+-- Imports+---------------------------------------------------------------------------+foreign import WINDOWS_CCONV "windows.h OpenFileMappingW"+    c_OpenFileMapping :: DWORD -> BOOL -> LPCTSTR -> IO HANDLE++foreign import WINDOWS_CCONV "windows.h CreateFileMappingW"+    c_CreateFileMapping :: HANDLE -> Ptr () -> DWORD -> DWORD -> DWORD -> LPCTSTR -> IO HANDLE++foreign import WINDOWS_CCONV "windows.h MapViewOfFileEx"+    c_MapViewOfFileEx :: HANDLE -> DWORD -> DWORD -> DWORD -> SIZE_T -> Ptr a -> IO (Ptr b)++foreign import WINDOWS_CCONV "windows.h UnmapViewOfFile"+    c_UnmapViewOfFile :: Ptr a -> IO BOOL++{-# CFILES cbits/HsWin32.c #-}+foreign import ccall "HsWin32.h &UnmapViewOfFileFinaliser"+    c_UnmapViewOfFileFinaliser :: FunPtr (Ptr a -> IO ())

@@ -21,9 +21,10 @@   , createHardLink'
   ) where
 
-import System.Win32.File   ( LPSECURITY_ATTRIBUTES, failIfFalseWithRetry_ )
-import System.Win32.String ( LPCTSTR, withTString )
-import System.Win32.Types  ( BOOL, nullPtr )
+import System.Win32.HardLink.Internal
+import System.Win32.File   ( failIfFalseWithRetry_ )
+import System.Win32.String ( withTString )
+import System.Win32.Types  ( nullPtr )
 
 #include "windows_cconv.h"
 
@@ -44,11 +45,6 @@         failIfFalseWithRetry_ (unwords ["CreateHardLinkW",show link,show target]) $
           c_CreateHardLink c_link c_target nullPtr
 
-foreign import WINDOWS_CCONV unsafe "windows.h CreateHardLinkW"
-  c_CreateHardLink :: LPCTSTR -- ^ Hard link name
-                   -> LPCTSTR -- ^ Target file path
-                   -> LPSECURITY_ATTRIBUTES -- ^ This parameter is reserved. You should pass just /nullPtr/.
-                   -> IO BOOL
 
 {-
 -- We plan to check file system type internally.

@@ -0,0 +1,31 @@+{-# LANGUAGE CPP #-}+{- |+   Module      :  System.Win32.HardLink.Internal+   Copyright   :  2013 shelarcy+   License     :  BSD-style++   Maintainer  :  shelarcy@gmail.com+   Stability   :  Provisional+   Portability :  Non-portable (Win32 API)++   Handling hard link using Win32 API. [NTFS only]++   Note: You should worry about file system type when use this module's function in your application:++     * NTFS only supprts this functionality.++     * ReFS doesn't support hard link currently.+-}+module System.Win32.HardLink.Internal where++import System.Win32.File   ( LPSECURITY_ATTRIBUTES )+import System.Win32.String ( LPCTSTR )+import System.Win32.Types  ( BOOL )++#include "windows_cconv.h"++foreign import WINDOWS_CCONV unsafe "windows.h CreateHardLinkW"+  c_CreateHardLink :: LPCTSTR -- ^ Hard link name+                   -> LPCTSTR -- ^ Target file path+                   -> LPSECURITY_ATTRIBUTES -- ^ This parameter is reserved. You should pass just /nullPtr/.+                   -> IO BOOL

@@ -129,14 +129,14 @@     , getUserName     ) where +import System.Win32.Info.Internal import Control.Exception (catch) import Foreign.Marshal.Alloc (alloca) import Foreign.Marshal.Utils (with, maybeWith) import Foreign.Marshal.Array (allocaArray)-import Foreign.Ptr (Ptr, nullPtr)+import Foreign.Ptr (nullPtr) import Foreign.Storable (Storable(..)) import System.IO.Error (isDoesNotExistError)-import System.Win32.Types (DWORD, LPDWORD, LPCTSTR, LPTSTR, LPVOID, UINT, WORD) import System.Win32.Types (failIfFalse_, peekTStringLen, withTString, try)  #if !MIN_VERSION_base(4,6,0)@@ -175,41 +175,6 @@ -- %fun GetKeyboardType :: KeyboardTypeKind -> IO KeyboardType  ------------------------------------------------------------------- System Color-------------------------------------------------------------------type SystemColor   = UINT---- ToDo: This list is out of date.--#{enum SystemColor,- , cOLOR_SCROLLBAR      = COLOR_SCROLLBAR- , cOLOR_BACKGROUND     = COLOR_BACKGROUND- , cOLOR_ACTIVECAPTION  = COLOR_ACTIVECAPTION- , cOLOR_INACTIVECAPTION = COLOR_INACTIVECAPTION- , cOLOR_MENU           = COLOR_MENU- , cOLOR_WINDOW         = COLOR_WINDOW- , cOLOR_WINDOWFRAME    = COLOR_WINDOWFRAME- , cOLOR_MENUTEXT       = COLOR_MENUTEXT- , cOLOR_WINDOWTEXT     = COLOR_WINDOWTEXT- , cOLOR_CAPTIONTEXT    = COLOR_CAPTIONTEXT- , cOLOR_ACTIVEBORDER   = COLOR_ACTIVEBORDER- , cOLOR_INACTIVEBORDER = COLOR_INACTIVEBORDER- , cOLOR_APPWORKSPACE   = COLOR_APPWORKSPACE- , cOLOR_HIGHLIGHT      = COLOR_HIGHLIGHT- , cOLOR_HIGHLIGHTTEXT  = COLOR_HIGHLIGHTTEXT- , cOLOR_BTNFACE        = COLOR_BTNFACE- , cOLOR_BTNSHADOW      = COLOR_BTNSHADOW- , cOLOR_GRAYTEXT       = COLOR_GRAYTEXT- , cOLOR_BTNTEXT        = COLOR_BTNTEXT- , cOLOR_INACTIVECAPTIONTEXT = COLOR_INACTIVECAPTIONTEXT- , cOLOR_BTNHIGHLIGHT   = COLOR_BTNHIGHLIGHT- }---- %fun GetSysColor :: SystemColor -> IO COLORREF--- %fun SetSysColors :: [(SystemColor,COLORREF)] -> IO ()------------------------------------------------------------------ -- Standard Directories ---------------------------------------------------------------- @@ -256,204 +221,15 @@                        then return Nothing                        else ioError e -foreign import WINDOWS_CCONV unsafe "GetWindowsDirectoryW"-  c_getWindowsDirectory :: LPTSTR -> UINT -> IO UINT--foreign import WINDOWS_CCONV unsafe "GetSystemDirectoryW"-  c_getSystemDirectory :: LPTSTR -> UINT -> IO UINT--foreign import WINDOWS_CCONV unsafe "GetCurrentDirectoryW"-  c_getCurrentDirectory :: DWORD -> LPTSTR -> IO UINT--foreign import WINDOWS_CCONV unsafe "GetTempPathW"-  c_getTempPath :: DWORD -> LPTSTR -> IO UINT--foreign import WINDOWS_CCONV unsafe "GetFullPathNameW"-  c_GetFullPathName :: LPCTSTR -> DWORD -> LPTSTR -> Ptr LPTSTR -> IO DWORD--foreign import WINDOWS_CCONV unsafe "GetLongPathNameW"-  c_GetLongPathName :: LPCTSTR -> LPTSTR -> DWORD -> IO DWORD--foreign import WINDOWS_CCONV unsafe "GetShortPathNameW"-  c_GetShortPathName :: LPCTSTR -> LPTSTR -> DWORD -> IO DWORD--foreign import WINDOWS_CCONV unsafe "SearchPathW"-  c_SearchPath :: LPCTSTR -> LPCTSTR -> LPCTSTR -> DWORD -> LPTSTR -> Ptr LPTSTR-               -> IO DWORD- ---------------------------------------------------------------- -- System Info (Info about processor and memory subsystem) ---------------------------------------------------------------- -data ProcessorArchitecture = PaUnknown WORD | PaIntel | PaMips | PaAlpha | PaPpc | PaIa64 | PaIa32OnIa64 | PaAmd64-    deriving (Show,Eq)--instance Storable ProcessorArchitecture where-    sizeOf _ = sizeOf (undefined::WORD)-    alignment _ = alignment (undefined::WORD)-    poke buf pa = pokeByteOff buf 0 $ case pa of-        PaUnknown w -> w-        PaIntel     -> #const PROCESSOR_ARCHITECTURE_INTEL-        PaMips      -> #const PROCESSOR_ARCHITECTURE_MIPS-        PaAlpha     -> #const PROCESSOR_ARCHITECTURE_ALPHA-        PaPpc       -> #const PROCESSOR_ARCHITECTURE_PPC-        PaIa64      -> #const PROCESSOR_ARCHITECTURE_IA64-#ifndef __WINE_WINDOWS_H-        PaIa32OnIa64 -> #const PROCESSOR_ARCHITECTURE_IA32_ON_WIN64-#endif-        PaAmd64     -> #const PROCESSOR_ARCHITECTURE_AMD64-    peek buf = do-        v <- (peekByteOff buf 0:: IO WORD)-        return $ case v of-            (#const PROCESSOR_ARCHITECTURE_INTEL) -> PaIntel-            (#const PROCESSOR_ARCHITECTURE_MIPS)  -> PaMips-            (#const PROCESSOR_ARCHITECTURE_ALPHA) -> PaAlpha-            (#const PROCESSOR_ARCHITECTURE_PPC)   -> PaPpc-            (#const PROCESSOR_ARCHITECTURE_IA64)  -> PaIa64-#ifndef __WINE_WINDOWS_H-            (#const PROCESSOR_ARCHITECTURE_IA32_ON_WIN64) -> PaIa32OnIa64-#endif-            (#const PROCESSOR_ARCHITECTURE_AMD64) -> PaAmd64-            w                                   -> PaUnknown w--data SYSTEM_INFO = SYSTEM_INFO-    { siProcessorArchitecture :: ProcessorArchitecture-    , siPageSize :: DWORD-    , siMinimumApplicationAddress, siMaximumApplicationAddress :: LPVOID-    , siActiveProcessorMask :: DWORD-    , siNumberOfProcessors :: DWORD-    , siProcessorType :: DWORD-    , siAllocationGranularity :: DWORD-    , siProcessorLevel :: WORD-    , siProcessorRevision :: WORD-    } deriving (Show)--instance Storable SYSTEM_INFO where-    sizeOf = const #size SYSTEM_INFO-    alignment _ = #alignment SYSTEM_INFO-    poke buf si = do-        (#poke SYSTEM_INFO, wProcessorArchitecture) buf (siProcessorArchitecture si)-        (#poke SYSTEM_INFO, dwPageSize)             buf (siPageSize si)-        (#poke SYSTEM_INFO, lpMinimumApplicationAddress) buf (siMinimumApplicationAddress si)-        (#poke SYSTEM_INFO, lpMaximumApplicationAddress) buf (siMaximumApplicationAddress si)-        (#poke SYSTEM_INFO, dwActiveProcessorMask)  buf (siActiveProcessorMask si)-        (#poke SYSTEM_INFO, dwNumberOfProcessors)   buf (siNumberOfProcessors si)-        (#poke SYSTEM_INFO, dwProcessorType)        buf (siProcessorType si)-        (#poke SYSTEM_INFO, dwAllocationGranularity) buf (siAllocationGranularity si)-        (#poke SYSTEM_INFO, wProcessorLevel)        buf (siProcessorLevel si)-        (#poke SYSTEM_INFO, wProcessorRevision)     buf (siProcessorRevision si)--    peek buf = do-        processorArchitecture <--            (#peek SYSTEM_INFO, wProcessorArchitecture) buf-        pageSize            <- (#peek SYSTEM_INFO, dwPageSize) buf-        minimumApplicationAddress <--            (#peek SYSTEM_INFO, lpMinimumApplicationAddress) buf-        maximumApplicationAddress <--            (#peek SYSTEM_INFO, lpMaximumApplicationAddress) buf-        activeProcessorMask <- (#peek SYSTEM_INFO, dwActiveProcessorMask) buf-        numberOfProcessors  <- (#peek SYSTEM_INFO, dwNumberOfProcessors) buf-        processorType       <- (#peek SYSTEM_INFO, dwProcessorType) buf-        allocationGranularity <--            (#peek SYSTEM_INFO, dwAllocationGranularity) buf-        processorLevel      <- (#peek SYSTEM_INFO, wProcessorLevel) buf-        processorRevision   <- (#peek SYSTEM_INFO, wProcessorRevision) buf-        return $ SYSTEM_INFO {-            siProcessorArchitecture     = processorArchitecture,-            siPageSize                  = pageSize,-            siMinimumApplicationAddress = minimumApplicationAddress,-            siMaximumApplicationAddress = maximumApplicationAddress,-            siActiveProcessorMask       = activeProcessorMask,-            siNumberOfProcessors        = numberOfProcessors,-            siProcessorType             = processorType,-            siAllocationGranularity     = allocationGranularity,-            siProcessorLevel            = processorLevel,-            siProcessorRevision         = processorRevision-            }--foreign import WINDOWS_CCONV unsafe "windows.h GetSystemInfo"-    c_GetSystemInfo :: Ptr SYSTEM_INFO -> IO ()- getSystemInfo :: IO SYSTEM_INFO getSystemInfo = alloca $ \ret -> do     c_GetSystemInfo ret     peek ret -------------------------------------------------------------------- System metrics-------------------------------------------------------------------type SMSetting = UINT--#{enum SMSetting,- , sM_ARRANGE           = SM_ARRANGE- , sM_CLEANBOOT         = SM_CLEANBOOT- , sM_CMETRICS          = SM_CMETRICS- , sM_CMOUSEBUTTONS     = SM_CMOUSEBUTTONS- , sM_CXBORDER          = SM_CXBORDER- , sM_CYBORDER          = SM_CYBORDER- , sM_CXCURSOR          = SM_CXCURSOR- , sM_CYCURSOR          = SM_CYCURSOR- , sM_CXDLGFRAME        = SM_CXDLGFRAME- , sM_CYDLGFRAME        = SM_CYDLGFRAME- , sM_CXDOUBLECLK       = SM_CXDOUBLECLK- , sM_CYDOUBLECLK       = SM_CYDOUBLECLK- , sM_CXDRAG            = SM_CXDRAG- , sM_CYDRAG            = SM_CYDRAG- , sM_CXEDGE            = SM_CXEDGE- , sM_CYEDGE            = SM_CYEDGE- , sM_CXFRAME           = SM_CXFRAME- , sM_CYFRAME           = SM_CYFRAME- , sM_CXFULLSCREEN      = SM_CXFULLSCREEN- , sM_CYFULLSCREEN      = SM_CYFULLSCREEN- , sM_CXHSCROLL         = SM_CXHSCROLL- , sM_CYVSCROLL         = SM_CYVSCROLL- , sM_CXICON            = SM_CXICON- , sM_CYICON            = SM_CYICON- , sM_CXICONSPACING     = SM_CXICONSPACING- , sM_CYICONSPACING     = SM_CYICONSPACING- , sM_CXMAXIMIZED       = SM_CXMAXIMIZED- , sM_CYMAXIMIZED       = SM_CYMAXIMIZED- , sM_CXMENUCHECK       = SM_CXMENUCHECK- , sM_CYMENUCHECK       = SM_CYMENUCHECK- , sM_CXMENUSIZE        = SM_CXMENUSIZE- , sM_CYMENUSIZE        = SM_CYMENUSIZE- , sM_CXMIN             = SM_CXMIN- , sM_CYMIN             = SM_CYMIN- , sM_CXMINIMIZED       = SM_CXMINIMIZED- , sM_CYMINIMIZED       = SM_CYMINIMIZED- , sM_CXMINTRACK        = SM_CXMINTRACK- , sM_CYMINTRACK        = SM_CYMINTRACK- , sM_CXSCREEN          = SM_CXSCREEN- , sM_CYSCREEN          = SM_CYSCREEN- , sM_CXSIZE            = SM_CXSIZE- , sM_CYSIZE            = SM_CYSIZE- , sM_CXSIZEFRAME       = SM_CXSIZEFRAME- , sM_CYSIZEFRAME       = SM_CYSIZEFRAME- , sM_CXSMICON          = SM_CXSMICON- , sM_CYSMICON          = SM_CYSMICON- , sM_CXSMSIZE          = SM_CXSMSIZE- , sM_CYSMSIZE          = SM_CYSMSIZE- , sM_CXVSCROLL         = SM_CXVSCROLL- , sM_CYHSCROLL         = SM_CYHSCROLL- , sM_CYVTHUMB          = SM_CYVTHUMB- , sM_CYCAPTION         = SM_CYCAPTION- , sM_CYKANJIWINDOW     = SM_CYKANJIWINDOW- , sM_CYMENU            = SM_CYMENU- , sM_CYSMCAPTION       = SM_CYSMCAPTION- , sM_DBCSENABLED       = SM_DBCSENABLED- , sM_DEBUG             = SM_DEBUG- , sM_MENUDROPALIGNMENT = SM_MENUDROPALIGNMENT- , sM_MIDEASTENABLED    = SM_MIDEASTENABLED- , sM_MOUSEPRESENT      = SM_MOUSEPRESENT- , sM_NETWORK           = SM_NETWORK- , sM_PENWINDOWS        = SM_PENWINDOWS- , sM_SECURE            = SM_SECURE- , sM_SHOWSOUNDS        = SM_SHOWSOUNDS- , sM_SLOWMACHINE       = SM_SLOWMACHINE- , sM_SWAPBUTTON        = SM_SWAPBUTTON- }- -- %fun GetSystemMetrics :: SMSetting -> IO Int  ----------------------------------------------------------------@@ -468,9 +244,6 @@ ----------------------------------------------------------------  -- %fun GetUserName :: IO String--foreign import WINDOWS_CCONV unsafe "windows.h GetUserNameW"-  c_GetUserName :: LPTSTR -> LPDWORD -> IO Bool  getUserName :: IO String getUserName =

@@ -0,0 +1,313 @@+#if __GLASGOW_HASKELL__ >= 709+{-# LANGUAGE Safe #-}+#else+{-# LANGUAGE Trustworthy #-}+#endif+-----------------------------------------------------------------------------+-- |+-- Module      :  System.Win32.Info.Internal+-- Copyright   :  (c) Alastair Reid, 1997-2003+-- License     :  BSD-style (see the file libraries/base/LICENSE)+--+-- Maintainer  :  Esa Ilari Vuokko <ei@vuokko.info>+-- Stability   :  provisional+-- Portability :  portable+--+-- A collection of FFI declarations for interfacing with Win32.+--+-----------------------------------------------------------------------------++module System.Win32.Info.Internal where++import Foreign.Ptr (Ptr)+import Foreign.Storable (Storable(..))+import System.Win32.Types (DWORD, LPDWORD, LPCTSTR, LPTSTR, LPVOID, UINT, WORD)++#if !MIN_VERSION_base(4,6,0)+import Prelude hiding (catch)+#endif++##include "windows_cconv.h"++#include <windows.h>+#include "alignment.h"++----------------------------------------------------------------+-- Environment Strings+----------------------------------------------------------------++-- %fun ExpandEnvironmentStrings :: String -> IO String++----------------------------------------------------------------+-- Computer Name+----------------------------------------------------------------++-- %fun GetComputerName :: IO String+-- %fun SetComputerName :: String -> IO ()+-- %end free(arg1)++----------------------------------------------------------------+-- Hardware Profiles+----------------------------------------------------------------++-- %fun GetCurrentHwProfile :: IO HW_PROFILE_INFO++----------------------------------------------------------------+-- Keyboard Type+----------------------------------------------------------------++-- %fun GetKeyboardType :: KeyboardTypeKind -> IO KeyboardType++----------------------------------------------------------------+-- System Color+----------------------------------------------------------------++type SystemColor   = UINT++-- ToDo: This list is out of date.++#{enum SystemColor,+ , cOLOR_SCROLLBAR      = COLOR_SCROLLBAR+ , cOLOR_BACKGROUND     = COLOR_BACKGROUND+ , cOLOR_ACTIVECAPTION  = COLOR_ACTIVECAPTION+ , cOLOR_INACTIVECAPTION = COLOR_INACTIVECAPTION+ , cOLOR_MENU           = COLOR_MENU+ , cOLOR_WINDOW         = COLOR_WINDOW+ , cOLOR_WINDOWFRAME    = COLOR_WINDOWFRAME+ , cOLOR_MENUTEXT       = COLOR_MENUTEXT+ , cOLOR_WINDOWTEXT     = COLOR_WINDOWTEXT+ , cOLOR_CAPTIONTEXT    = COLOR_CAPTIONTEXT+ , cOLOR_ACTIVEBORDER   = COLOR_ACTIVEBORDER+ , cOLOR_INACTIVEBORDER = COLOR_INACTIVEBORDER+ , cOLOR_APPWORKSPACE   = COLOR_APPWORKSPACE+ , cOLOR_HIGHLIGHT      = COLOR_HIGHLIGHT+ , cOLOR_HIGHLIGHTTEXT  = COLOR_HIGHLIGHTTEXT+ , cOLOR_BTNFACE        = COLOR_BTNFACE+ , cOLOR_BTNSHADOW      = COLOR_BTNSHADOW+ , cOLOR_GRAYTEXT       = COLOR_GRAYTEXT+ , cOLOR_BTNTEXT        = COLOR_BTNTEXT+ , cOLOR_INACTIVECAPTIONTEXT = COLOR_INACTIVECAPTIONTEXT+ , cOLOR_BTNHIGHLIGHT   = COLOR_BTNHIGHLIGHT+ }++-- %fun GetSysColor :: SystemColor -> IO COLORREF+-- %fun SetSysColors :: [(SystemColor,COLORREF)] -> IO ()++----------------------------------------------------------------+-- Standard Directories+----------------------------------------------------------------++foreign import WINDOWS_CCONV unsafe "GetWindowsDirectoryW"+  c_getWindowsDirectory :: LPTSTR -> UINT -> IO UINT++foreign import WINDOWS_CCONV unsafe "GetSystemDirectoryW"+  c_getSystemDirectory :: LPTSTR -> UINT -> IO UINT++foreign import WINDOWS_CCONV unsafe "GetCurrentDirectoryW"+  c_getCurrentDirectory :: DWORD -> LPTSTR -> IO UINT++foreign import WINDOWS_CCONV unsafe "GetTempPathW"+  c_getTempPath :: DWORD -> LPTSTR -> IO UINT++foreign import WINDOWS_CCONV unsafe "GetFullPathNameW"+  c_GetFullPathName :: LPCTSTR -> DWORD -> LPTSTR -> Ptr LPTSTR -> IO DWORD++foreign import WINDOWS_CCONV unsafe "GetLongPathNameW"+  c_GetLongPathName :: LPCTSTR -> LPTSTR -> DWORD -> IO DWORD++foreign import WINDOWS_CCONV unsafe "GetShortPathNameW"+  c_GetShortPathName :: LPCTSTR -> LPTSTR -> DWORD -> IO DWORD++foreign import WINDOWS_CCONV unsafe "SearchPathW"+  c_SearchPath :: LPCTSTR -> LPCTSTR -> LPCTSTR -> DWORD -> LPTSTR -> Ptr LPTSTR+               -> IO DWORD++----------------------------------------------------------------+-- System Info (Info about processor and memory subsystem)+----------------------------------------------------------------++data ProcessorArchitecture = PaUnknown WORD | PaIntel | PaMips | PaAlpha | PaPpc | PaIa64 | PaIa32OnIa64 | PaAmd64+    deriving (Show,Eq)++instance Storable ProcessorArchitecture where+    sizeOf _ = sizeOf (undefined::WORD)+    alignment _ = alignment (undefined::WORD)+    poke buf pa = pokeByteOff buf 0 $ case pa of+        PaUnknown w -> w+        PaIntel     -> #const PROCESSOR_ARCHITECTURE_INTEL+        PaMips      -> #const PROCESSOR_ARCHITECTURE_MIPS+        PaAlpha     -> #const PROCESSOR_ARCHITECTURE_ALPHA+        PaPpc       -> #const PROCESSOR_ARCHITECTURE_PPC+        PaIa64      -> #const PROCESSOR_ARCHITECTURE_IA64+#ifndef __WINE_WINDOWS_H+        PaIa32OnIa64 -> #const PROCESSOR_ARCHITECTURE_IA32_ON_WIN64+#endif+        PaAmd64     -> #const PROCESSOR_ARCHITECTURE_AMD64+    peek buf = do+        v <- (peekByteOff buf 0:: IO WORD)+        return $ case v of+            (#const PROCESSOR_ARCHITECTURE_INTEL) -> PaIntel+            (#const PROCESSOR_ARCHITECTURE_MIPS)  -> PaMips+            (#const PROCESSOR_ARCHITECTURE_ALPHA) -> PaAlpha+            (#const PROCESSOR_ARCHITECTURE_PPC)   -> PaPpc+            (#const PROCESSOR_ARCHITECTURE_IA64)  -> PaIa64+#ifndef __WINE_WINDOWS_H+            (#const PROCESSOR_ARCHITECTURE_IA32_ON_WIN64) -> PaIa32OnIa64+#endif+            (#const PROCESSOR_ARCHITECTURE_AMD64) -> PaAmd64+            w                                   -> PaUnknown w++data SYSTEM_INFO = SYSTEM_INFO+    { siProcessorArchitecture :: ProcessorArchitecture+    , siPageSize :: DWORD+    , siMinimumApplicationAddress, siMaximumApplicationAddress :: LPVOID+    , siActiveProcessorMask :: DWORD+    , siNumberOfProcessors :: DWORD+    , siProcessorType :: DWORD+    , siAllocationGranularity :: DWORD+    , siProcessorLevel :: WORD+    , siProcessorRevision :: WORD+    } deriving (Show)++instance Storable SYSTEM_INFO where+    sizeOf = const #size SYSTEM_INFO+    alignment _ = #alignment SYSTEM_INFO+    poke buf si = do+        (#poke SYSTEM_INFO, wProcessorArchitecture) buf (siProcessorArchitecture si)+        (#poke SYSTEM_INFO, dwPageSize)             buf (siPageSize si)+        (#poke SYSTEM_INFO, lpMinimumApplicationAddress) buf (siMinimumApplicationAddress si)+        (#poke SYSTEM_INFO, lpMaximumApplicationAddress) buf (siMaximumApplicationAddress si)+        (#poke SYSTEM_INFO, dwActiveProcessorMask)  buf (siActiveProcessorMask si)+        (#poke SYSTEM_INFO, dwNumberOfProcessors)   buf (siNumberOfProcessors si)+        (#poke SYSTEM_INFO, dwProcessorType)        buf (siProcessorType si)+        (#poke SYSTEM_INFO, dwAllocationGranularity) buf (siAllocationGranularity si)+        (#poke SYSTEM_INFO, wProcessorLevel)        buf (siProcessorLevel si)+        (#poke SYSTEM_INFO, wProcessorRevision)     buf (siProcessorRevision si)++    peek buf = do+        processorArchitecture <-+            (#peek SYSTEM_INFO, wProcessorArchitecture) buf+        pageSize            <- (#peek SYSTEM_INFO, dwPageSize) buf+        minimumApplicationAddress <-+            (#peek SYSTEM_INFO, lpMinimumApplicationAddress) buf+        maximumApplicationAddress <-+            (#peek SYSTEM_INFO, lpMaximumApplicationAddress) buf+        activeProcessorMask <- (#peek SYSTEM_INFO, dwActiveProcessorMask) buf+        numberOfProcessors  <- (#peek SYSTEM_INFO, dwNumberOfProcessors) buf+        processorType       <- (#peek SYSTEM_INFO, dwProcessorType) buf+        allocationGranularity <-+            (#peek SYSTEM_INFO, dwAllocationGranularity) buf+        processorLevel      <- (#peek SYSTEM_INFO, wProcessorLevel) buf+        processorRevision   <- (#peek SYSTEM_INFO, wProcessorRevision) buf+        return $ SYSTEM_INFO {+            siProcessorArchitecture     = processorArchitecture,+            siPageSize                  = pageSize,+            siMinimumApplicationAddress = minimumApplicationAddress,+            siMaximumApplicationAddress = maximumApplicationAddress,+            siActiveProcessorMask       = activeProcessorMask,+            siNumberOfProcessors        = numberOfProcessors,+            siProcessorType             = processorType,+            siAllocationGranularity     = allocationGranularity,+            siProcessorLevel            = processorLevel,+            siProcessorRevision         = processorRevision+            }++foreign import WINDOWS_CCONV unsafe "windows.h GetSystemInfo"+    c_GetSystemInfo :: Ptr SYSTEM_INFO -> IO ()++----------------------------------------------------------------+-- System metrics+----------------------------------------------------------------++type SMSetting = UINT++#{enum SMSetting,+ , sM_ARRANGE           = SM_ARRANGE+ , sM_CLEANBOOT         = SM_CLEANBOOT+ , sM_CMETRICS          = SM_CMETRICS+ , sM_CMOUSEBUTTONS     = SM_CMOUSEBUTTONS+ , sM_CXBORDER          = SM_CXBORDER+ , sM_CYBORDER          = SM_CYBORDER+ , sM_CXCURSOR          = SM_CXCURSOR+ , sM_CYCURSOR          = SM_CYCURSOR+ , sM_CXDLGFRAME        = SM_CXDLGFRAME+ , sM_CYDLGFRAME        = SM_CYDLGFRAME+ , sM_CXDOUBLECLK       = SM_CXDOUBLECLK+ , sM_CYDOUBLECLK       = SM_CYDOUBLECLK+ , sM_CXDRAG            = SM_CXDRAG+ , sM_CYDRAG            = SM_CYDRAG+ , sM_CXEDGE            = SM_CXEDGE+ , sM_CYEDGE            = SM_CYEDGE+ , sM_CXFRAME           = SM_CXFRAME+ , sM_CYFRAME           = SM_CYFRAME+ , sM_CXFULLSCREEN      = SM_CXFULLSCREEN+ , sM_CYFULLSCREEN      = SM_CYFULLSCREEN+ , sM_CXHSCROLL         = SM_CXHSCROLL+ , sM_CYVSCROLL         = SM_CYVSCROLL+ , sM_CXICON            = SM_CXICON+ , sM_CYICON            = SM_CYICON+ , sM_CXICONSPACING     = SM_CXICONSPACING+ , sM_CYICONSPACING     = SM_CYICONSPACING+ , sM_CXMAXIMIZED       = SM_CXMAXIMIZED+ , sM_CYMAXIMIZED       = SM_CYMAXIMIZED+ , sM_CXMENUCHECK       = SM_CXMENUCHECK+ , sM_CYMENUCHECK       = SM_CYMENUCHECK+ , sM_CXMENUSIZE        = SM_CXMENUSIZE+ , sM_CYMENUSIZE        = SM_CYMENUSIZE+ , sM_CXMIN             = SM_CXMIN+ , sM_CYMIN             = SM_CYMIN+ , sM_CXMINIMIZED       = SM_CXMINIMIZED+ , sM_CYMINIMIZED       = SM_CYMINIMIZED+ , sM_CXMINTRACK        = SM_CXMINTRACK+ , sM_CYMINTRACK        = SM_CYMINTRACK+ , sM_CXSCREEN          = SM_CXSCREEN+ , sM_CYSCREEN          = SM_CYSCREEN+ , sM_CXSIZE            = SM_CXSIZE+ , sM_CYSIZE            = SM_CYSIZE+ , sM_CXSIZEFRAME       = SM_CXSIZEFRAME+ , sM_CYSIZEFRAME       = SM_CYSIZEFRAME+ , sM_CXSMICON          = SM_CXSMICON+ , sM_CYSMICON          = SM_CYSMICON+ , sM_CXSMSIZE          = SM_CXSMSIZE+ , sM_CYSMSIZE          = SM_CYSMSIZE+ , sM_CXVSCROLL         = SM_CXVSCROLL+ , sM_CYHSCROLL         = SM_CYHSCROLL+ , sM_CYVTHUMB          = SM_CYVTHUMB+ , sM_CYCAPTION         = SM_CYCAPTION+ , sM_CYKANJIWINDOW     = SM_CYKANJIWINDOW+ , sM_CYMENU            = SM_CYMENU+ , sM_CYSMCAPTION       = SM_CYSMCAPTION+ , sM_DBCSENABLED       = SM_DBCSENABLED+ , sM_DEBUG             = SM_DEBUG+ , sM_MENUDROPALIGNMENT = SM_MENUDROPALIGNMENT+ , sM_MIDEASTENABLED    = SM_MIDEASTENABLED+ , sM_MOUSEPRESENT      = SM_MOUSEPRESENT+ , sM_NETWORK           = SM_NETWORK+ , sM_PENWINDOWS        = SM_PENWINDOWS+ , sM_SECURE            = SM_SECURE+ , sM_SHOWSOUNDS        = SM_SHOWSOUNDS+ , sM_SLOWMACHINE       = SM_SLOWMACHINE+ , sM_SWAPBUTTON        = SM_SWAPBUTTON+ }++-- %fun GetSystemMetrics :: SMSetting -> IO Int++----------------------------------------------------------------+-- Thread Desktops+----------------------------------------------------------------++-- %fun GetThreadDesktop :: ThreadId -> IO HDESK+-- %fun SetThreadDesktop :: ThreadId -> HDESK -> IO ()++----------------------------------------------------------------+-- User name+----------------------------------------------------------------++-- %fun GetUserName :: IO String++foreign import WINDOWS_CCONV unsafe "windows.h GetUserNameW"+  c_GetUserName :: LPTSTR -> LPDWORD -> IO Bool++----------------------------------------------------------------+-- End+----------------------------------------------------------------

@@ -22,6 +22,7 @@  , pathRelativePathTo  ) where +import System.Win32.Path.Internal import System.Win32.Types import System.Win32.File @@ -53,5 +54,3 @@     _ <- localFree p_AbsPath     return path -foreign import WINDOWS_CCONV unsafe "Shlwapi.h PathRelativePathToW"-         c_pathRelativePathTo :: LPTSTR -> LPCTSTR -> DWORD -> LPCTSTR -> DWORD -> IO UINT

@@ -0,0 +1,29 @@+#if __GLASGOW_HASKELL__ >= 709+{-# LANGUAGE Safe #-}+#else+{-# LANGUAGE Trustworthy #-}+#endif+-----------------------------------------------------------------------------+-- |+-- Module      :  System.Win32.Path.Internal+-- Copyright   :  (c) Tamar Christina, 1997-2003+-- License     :  BSD-style (see the file libraries/base/LICENSE)+--+-- Maintainer  :  Tamar Christina <tamar@zhox.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- A collection of FFI declarations for interfacing with Win32.+--+-----------------------------------------------------------------------------++module System.Win32.Path.Internal where++import System.Win32.Types++##include "windows_cconv.h"++#include <windows.h>++foreign import WINDOWS_CCONV unsafe "Shlwapi.h PathRelativePathToW"+         c_pathRelativePathTo :: LPTSTR -> LPCTSTR -> DWORD -> LPCTSTR -> DWORD -> IO UINT

@@ -32,13 +32,13 @@   sHGFP_TYPE_DEFAULT
  ) where
 
+import System.Win32.Shell.Internal
 import System.Win32.Types
 import Graphics.Win32.GDI.Types (HWND)
 
 import Foreign
 import Foreign.C
 import Control.Monad
-import System.IO.Error
 
 ##include "windows_cconv.h"
 
@@ -79,11 +79,3 @@     r <- c_SHGetFolderPath hwnd csidl hdl flags pstr
     when (r < 0) $ raiseUnsupported "sHGetFolderPath"
     peekTString pstr
-
-raiseUnsupported :: String -> IO ()
-raiseUnsupported loc =
-   ioError (ioeSetErrorString (mkIOError illegalOperationErrorType loc Nothing Nothing) "unsupported operation")
-
-foreign import WINDOWS_CCONV unsafe "SHGetFolderPathW"
-  c_SHGetFolderPath :: HWND -> CInt -> HANDLE -> DWORD -> LPTSTR
-                    -> IO HRESULT

@@ -0,0 +1,50 @@+#if __GLASGOW_HASKELL__ >= 709+{-# LANGUAGE Safe #-}+#else+{-# LANGUAGE Trustworthy #-}+#endif+-----------------------------------------------------------------------------+-- |+-- Module      :  System.Win32.Shell.Internal+-- Copyright   :  (c) The University of Glasgow 2009+-- License     :  BSD-style (see the file libraries/base/LICENSE)+--+-- Maintainer  :  Esa Ilari Vuokko <ei@vuokko.info>+-- Stability   :  provisional+-- Portability :  portable+--+-- Win32 stuff from shell32.dll+--+-----------------------------------------------------------------------------++module System.Win32.Shell.Internal (+   c_SHGetFolderPath+ , raiseUnsupported+ ) where++import System.Win32.Types+import Graphics.Win32.GDI.Types (HWND)++import Foreign.C+import System.IO.Error++##include "windows_cconv.h"++-- for SHGetFolderPath stuff+#define _WIN32_IE 0x500+#include <windows.h>+#include <shlobj.h>++----------------------------------------------------------------+-- SHGetFolderPath+--+-- XXX: this is deprecated in Vista and later+----------------------------------------------------------------++raiseUnsupported :: String -> IO ()+raiseUnsupported loc =+   ioError (ioeSetErrorString (mkIOError illegalOperationErrorType loc Nothing Nothing) "unsupported operation")++foreign import WINDOWS_CCONV unsafe "SHGetFolderPathW"+  c_SHGetFolderPath :: HWND -> CInt -> HANDLE -> DWORD -> LPTSTR+                    -> IO HRESULT

@@ -35,20 +35,14 @@   , createSymbolicLinkDirectory
   ) where
 
+import System.Win32.SymbolicLink.Internal
 import Data.Bits ((.|.))
 import System.Win32.Types
 import System.Win32.File ( failIfFalseWithRetry_ )
 
 ##include "windows_cconv.h"
 
-type SymbolicLinkFlags = DWORD
 
-#{enum SymbolicLinkFlags,
- , sYMBOLIC_LINK_FLAG_FILE      = 0x0
- , sYMBOLIC_LINK_FLAG_DIRECTORY = 0x1
- , sYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE = 0x2
-}
-
 -- | createSymbolicLink* functions don't check that file is exist or not.
 --
 -- NOTE: createSymbolicLink* functions are /flipped arguments/ to provide compatibility for Unix,
@@ -97,5 +91,3 @@         failIfFalseWithRetry_ (unwords ["CreateSymbolicLink",show link,show target]) $
           c_CreateSymbolicLink c_link c_target flag
 
-foreign import WINDOWS_CCONV unsafe "windows.h CreateSymbolicLinkW"
-  c_CreateSymbolicLink :: LPTSTR -> LPTSTR -> SymbolicLinkFlags -> IO BOOL

@@ -0,0 +1,26 @@+{-# LANGUAGE CPP #-}+{- |+   Module      :  System.Win32.SymbolicLink.Internal+   Copyright   :  2012 shelarcy+   License     :  BSD-style++   Maintainer  :  shelarcy@gmail.com+   Stability   :  Provisional+   Portability :  Non-portable (Win32 API)+-}+module System.Win32.SymbolicLink.Internal where++import System.Win32.Types++##include "windows_cconv.h"++type SymbolicLinkFlags = DWORD++#{enum SymbolicLinkFlags,+ , sYMBOLIC_LINK_FLAG_FILE      = 0x0+ , sYMBOLIC_LINK_FLAG_DIRECTORY = 0x1+ , sYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE = 0x2+}++foreign import WINDOWS_CCONV unsafe "windows.h CreateSymbolicLinkW"+  c_CreateSymbolicLink :: LPTSTR -> LPTSTR -> SymbolicLinkFlags -> IO BOOL

@@ -52,21 +52,19 @@     , getTimeFormat     ) where +import System.Win32.Time.Internal 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+import System.Win32.Types   ( DWORD, HANDLE, LCID+                            , failIf                             , failIfFalse_, failIf_ ) import System.Win32.Utils   ( trySized ) -import Control.Monad    ( when, liftM3, liftM )-import Data.Word        ( Word8 )-import Foreign          ( Storable(sizeOf, alignment, peekByteOff, peek,-                                   pokeByteOff, poke)-                        , Ptr, nullPtr, castPtr, plusPtr, advancePtr-                        , with, alloca, allocaBytes, copyArray )-import Foreign.C        ( CInt(..), CWchar(..)-                        , peekCWString, withCWStringLen, withCWString )+import Control.Monad    ( liftM3, liftM )+import Foreign          ( Storable(sizeOf, peek)+                        , Ptr, nullPtr, castPtr+                        , with, alloca, allocaBytes )+import Foreign.C        ( CWchar(..)+                        , withCWString ) import Foreign.Marshal.Utils (maybeWith)  ##include "windows_cconv.h"@@ -74,145 +72,30 @@ #include "alignment.h" #include "winnls_compat.h" -------------------------------------------------------------------- data types----------------------------------------------------------------- -newtype FILETIME = FILETIME DDWORD deriving (Show, Eq, Ord)--data SYSTEMTIME = SYSTEMTIME {-    wYear, wMonth, wDayOfWeek, wDay, wHour, wMinute, wSecond, wMilliseconds :: WORD }-    deriving (Show, Eq, Ord)--data TIME_ZONE_INFORMATION = TIME_ZONE_INFORMATION-    { tziBias :: LONG-    , tziStandardName :: String-    , tziStandardDate :: SYSTEMTIME-    , tziStandardBias :: LONG-    , tziDaylightName :: String-    , tziDaylightDate :: SYSTEMTIME-    , tziDaylightBias :: LONG-    } deriving (Show,Eq,Ord)--data TimeZoneId = TzIdUnknown | TzIdStandard | TzIdDaylight-    deriving (Show, Eq, Ord)--data LASTINPUTINFO = LASTINPUTINFO DWORD deriving (Show)--------------------------------------------------------------------- Instances-------------------------------------------------------------------instance Storable FILETIME where-    sizeOf = const (#size FILETIME)-    alignment _ = #alignment FILETIME-    poke buf (FILETIME n) = do-        (#poke FILETIME, dwLowDateTime) buf low-        (#poke FILETIME, dwHighDateTime) buf hi-        where (hi,low) = ddwordToDwords n-    peek buf = do-        low <- (#peek FILETIME, dwLowDateTime) buf-        hi <- (#peek FILETIME, dwHighDateTime) buf-        return $ FILETIME $ dwordsToDdword (hi,low)--instance Storable SYSTEMTIME where-    sizeOf _ = #size SYSTEMTIME-    alignment _ = #alignment SYSTEMTIME-    poke buf st = do-         (#poke SYSTEMTIME, wYear)          buf (wYear st)-         (#poke SYSTEMTIME, wMonth)         buf (wMonth st)-         (#poke SYSTEMTIME, wDayOfWeek)     buf (wDayOfWeek st)-         (#poke SYSTEMTIME, wDay)           buf (wDay st)-         (#poke SYSTEMTIME, wHour)          buf (wHour st)-         (#poke SYSTEMTIME, wMinute)        buf (wMinute st)-         (#poke SYSTEMTIME, wSecond)        buf (wSecond st)-         (#poke SYSTEMTIME, wMilliseconds)  buf (wMilliseconds st)-    peek buf = do-        year    <- (#peek SYSTEMTIME, wYear)        buf-        month   <- (#peek SYSTEMTIME, wMonth)       buf-        dow     <- (#peek SYSTEMTIME, wDayOfWeek)   buf-        day     <- (#peek SYSTEMTIME, wDay)         buf-        hour    <- (#peek SYSTEMTIME, wHour)        buf-        mins    <- (#peek SYSTEMTIME, wMinute)      buf-        sec     <- (#peek SYSTEMTIME, wSecond)      buf-        ms      <- (#peek SYSTEMTIME, wMilliseconds) buf-        return $ SYSTEMTIME year month dow day hour mins sec ms--instance Storable TIME_ZONE_INFORMATION where-    sizeOf _ = (#size TIME_ZONE_INFORMATION)-    alignment _ = #alignment TIME_ZONE_INFORMATION-    poke buf tzi = do-        (#poke TIME_ZONE_INFORMATION, Bias) buf (tziBias tzi)-        (#poke TIME_ZONE_INFORMATION, StandardDate) buf (tziStandardDate tzi)-        (#poke TIME_ZONE_INFORMATION, StandardBias) buf (tziStandardBias tzi)-        (#poke TIME_ZONE_INFORMATION, DaylightDate) buf (tziDaylightDate tzi)-        (#poke TIME_ZONE_INFORMATION, DaylightBias) buf (tziDaylightBias tzi)-        write buf (#offset TIME_ZONE_INFORMATION, StandardName) (tziStandardName tzi)-        write buf (#offset TIME_ZONE_INFORMATION, DaylightName) (tziDaylightName tzi)-        where-            write buf_ offset str = withCWStringLen str $ \(c_str,len) -> do-                when (len>31) $ fail "Storable TIME_ZONE_INFORMATION.poke: Too long string."-                let len'  = len * sizeOf (undefined :: CWchar)-                    start = (advancePtr (castPtr buf_) offset)-                    end   = advancePtr start len'-                copyArray start (castPtr c_str :: Ptr Word8) len'-                poke (castPtr end) (0 :: CWchar)--    peek buf = do-        bias <- (#peek TIME_ZONE_INFORMATION, Bias)         buf-        sdat <- (#peek TIME_ZONE_INFORMATION, StandardDate) buf-        sbia <- (#peek TIME_ZONE_INFORMATION, StandardBias) buf-        ddat <- (#peek TIME_ZONE_INFORMATION, DaylightDate) buf-        dbia <- (#peek TIME_ZONE_INFORMATION, DaylightBias) buf-        snam <- peekCWString (plusPtr buf (#offset TIME_ZONE_INFORMATION, StandardName))-        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 getSystemTime = alloca $ \res -> do     c_GetSystemTime res     peek res -foreign import WINDOWS_CCONV "windows.h SetSystemTime"-    c_SetSystemTime :: Ptr SYSTEMTIME -> IO BOOL setSystemTime :: SYSTEMTIME -> IO () setSystemTime st = with st $ \c_st -> failIf_ not "setSystemTime: SetSystemTime" $     c_SetSystemTime c_st -foreign import WINDOWS_CCONV "windows.h GetSystemTimeAsFileTime"-    c_GetSystemTimeAsFileTime :: Ptr FILETIME -> IO () getSystemTimeAsFileTime :: IO FILETIME getSystemTimeAsFileTime = alloca $ \ret -> do     c_GetSystemTimeAsFileTime ret     peek ret -foreign import WINDOWS_CCONV "windows.h GetLocalTime"-    c_GetLocalTime :: Ptr SYSTEMTIME -> IO () getLocalTime :: IO SYSTEMTIME getLocalTime = alloca $ \res -> do     c_GetLocalTime res     peek res -foreign import WINDOWS_CCONV "windows.h SetLocalTime"-    c_SetLocalTime :: Ptr SYSTEMTIME -> IO BOOL setLocalTime :: SYSTEMTIME -> IO () setLocalTime st = with st $ \c_st -> failIf_ not "setLocalTime: SetLocalTime" $     c_SetLocalTime c_st -foreign import WINDOWS_CCONV "windows.h GetSystemTimeAdjustment"-    c_GetSystemTimeAdjustment :: Ptr DWORD -> Ptr DWORD -> Ptr BOOL -> IO BOOL getSystemTimeAdjustment :: IO (Maybe (Int, Int)) getSystemTimeAdjustment = alloca $ \ta -> alloca $ \ti -> alloca $ \enabled -> do     failIf_ not "getSystemTimeAdjustment: GetSystemTimeAdjustment" $@@ -225,10 +108,6 @@             return $ Just (fromIntegral ta', fromIntegral ti')         else return Nothing -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@@ -242,8 +121,6 @@   now <- getTickCount   return $ fromIntegral $ now - lii -foreign import WINDOWS_CCONV "windows.h SetSystemTimeAdjustment"-    c_SetSystemTimeAdjustment :: DWORD -> BOOL -> IO BOOL setSystemTimeAdjustment :: Maybe Int -> IO () setSystemTimeAdjustment ta =     failIf_ not "setSystemTimeAjustment: SetSystemTimeAdjustment" $@@ -253,8 +130,6 @@             Nothing -> (0,True)             Just x  -> (fromIntegral x,False) -foreign import WINDOWS_CCONV "windows.h GetTimeZoneInformation"-    c_GetTimeZoneInformation :: Ptr TIME_ZONE_INFORMATION -> IO DWORD getTimeZoneInformation :: IO (TimeZoneId, TIME_ZONE_INFORMATION) getTimeZoneInformation = alloca $ \tzi -> do     tz <- failIf (==(#const TIME_ZONE_ID_INVALID)) "getTimeZoneInformation: GetTimeZoneInformation" $@@ -266,24 +141,18 @@         (#const TIME_ZONE_ID_DAYLIGHT)  -> TzIdDaylight         _                               -> TzIdUnknown   -- to remove warning -foreign import WINDOWS_CCONV "windows.h SystemTimeToFileTime"-    c_SystemTimeToFileTime :: Ptr SYSTEMTIME -> Ptr FILETIME -> IO BOOL systemTimeToFileTime :: SYSTEMTIME -> IO FILETIME systemTimeToFileTime s = with s $ \c_s -> alloca $ \ret -> do     failIf_ not "systemTimeToFileTime: SystemTimeToFileTime" $         c_SystemTimeToFileTime c_s ret     peek ret -foreign import WINDOWS_CCONV "windows.h FileTimeToSystemTime"-    c_FileTimeToSystemTime :: Ptr FILETIME -> Ptr SYSTEMTIME -> IO BOOL fileTimeToSystemTime :: FILETIME -> IO SYSTEMTIME fileTimeToSystemTime s = with s $ \c_s -> alloca $ \ret -> do     failIf_ not "fileTimeToSystemTime: FileTimeToSystemTime" $         c_FileTimeToSystemTime c_s ret     peek ret -foreign import WINDOWS_CCONV "windows.h GetFileTime"-    c_GetFileTime :: HANDLE -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> IO BOOL getFileTime :: HANDLE -> IO (FILETIME,FILETIME,FILETIME) getFileTime h = alloca $ \crt -> alloca $ \acc -> alloca $ \wrt -> do     failIf_ not "getFileTime: GetFileTime" $ c_GetFileTime h crt acc wrt@@ -292,8 +161,6 @@ invalidFileTime :: FILETIME invalidFileTime = FILETIME 0 -foreign import WINDOWS_CCONV "windows.h SetFileTime"-    c_SetFileTime :: HANDLE -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> IO BOOL setFileTime :: HANDLE -> Maybe FILETIME -> Maybe FILETIME -> Maybe FILETIME -> IO () setFileTime h crt acc wrt = withTime crt $     \c_crt -> withTime acc $@@ -305,16 +172,12 @@     withTime Nothing k  = k nullPtr     withTime (Just t) k = with t k -foreign import WINDOWS_CCONV "windows.h FileTimeToLocalFileTime"-    c_FileTimeToLocalFileTime :: Ptr FILETIME -> Ptr FILETIME -> IO BOOL fileTimeToLocalFileTime :: FILETIME -> IO FILETIME fileTimeToLocalFileTime ft = with ft $ \c_ft -> alloca $ \res -> do     failIf_ not "fileTimeToLocalFileTime: FileTimeToLocalFileTime"         $ c_FileTimeToLocalFileTime c_ft res     peek res -foreign import WINDOWS_CCONV "windows.h LocalFileTimeToFileTime"-    c_LocalFileTimeToFileTime :: Ptr FILETIME -> Ptr FILETIME -> IO BOOL localFileTimeToFileTime :: FILETIME -> IO FILETIME localFileTimeToFileTime ft = with ft $ \c_ft -> alloca $ \res -> do     failIf_ not "localFileTimeToFileTime: LocalFileTimeToFileTime"@@ -350,31 +213,18 @@     peek res -} -foreign import WINDOWS_CCONV "windows.h QueryPerformanceFrequency"-    c_QueryPerformanceFrequency :: Ptr LARGE_INTEGER -> IO BOOL queryPerformanceFrequency :: IO Integer queryPerformanceFrequency = alloca $ \res -> do     failIf_ not "queryPerformanceFrequency: QueryPerformanceFrequency" $         c_QueryPerformanceFrequency res     liftM fromIntegral $ peek res -foreign import WINDOWS_CCONV "windows.h QueryPerformanceCounter"-    c_QueryPerformanceCounter:: Ptr LARGE_INTEGER -> IO BOOL queryPerformanceCounter:: IO Integer queryPerformanceCounter= alloca $ \res -> do     failIf_ not "queryPerformanceCounter: QueryPerformanceCounter" $         c_QueryPerformanceCounter res     liftM fromIntegral $ peek res -type GetTimeFormatFlags = DWORD-#{enum GetTimeFormatFlags,-    , lOCALE_NOUSEROVERRIDE = LOCALE_NOUSEROVERRIDE-    , lOCALE_USE_CP_ACP     = LOCALE_USE_CP_ACP-    , tIME_NOMINUTESORSECONDS = TIME_NOMINUTESORSECONDS-    , tIME_NOSECONDS        = TIME_NOSECONDS-    , tIME_NOTIMEMARKER     = TIME_NOTIMEMARKER-    , tIME_FORCE24HOURFORMAT= TIME_FORCE24HOURFORMAT-    }  getTimeFormatEx :: Maybe String                 -> GetTimeFormatFlags@@ -387,17 +237,7 @@             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 getTimeFormat :: LCID -> GetTimeFormatFlags -> Maybe SYSTEMTIME -> Maybe String -> IO String getTimeFormat locale flags st fmt =     maybeWith with st $ \c_st ->

@@ -0,0 +1,245 @@+#if __GLASGOW_HASKELL__ >= 709+{-# LANGUAGE Safe #-}+#else+{-# LANGUAGE Trustworthy #-}+#endif+-----------------------------------------------------------------------------+-- |+-- Module      :  System.Win32.Time.Internal+-- Copyright   :  (c) Esa Ilari Vuokko, 2006+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Esa Ilari Vuokko <ei@vuokko.info>+-- Stability   :  provisional+-- Portability :  portable+--+-- A collection of FFI declarations for interfacing with Win32 Time API.+--+-----------------------------------------------------------------------------+module System.Win32.Time.Internal where++import System.Win32.Types   ( BOOL, DDWORD, DWORD, HANDLE, LARGE_INTEGER, LCID+                            , LONG, LPCTSTR, LPCWSTR, LPTSTR, LPWSTR, UINT, WORD+                            , dwordsToDdword, ddwordToDwords+                            )+import Control.Monad    ( when )+import Data.Word        ( Word8 )+import Foreign          ( Storable(sizeOf, alignment, peekByteOff, peek,+                                   pokeByteOff, poke)+                        , Ptr, castPtr, plusPtr, advancePtr+                        , copyArray )+import Foreign.C        ( CInt(..), CWchar(..)+                        , peekCWString, withCWStringLen )++##include "windows_cconv.h"+#include <windows.h>+#include "alignment.h"+#include "winnls_compat.h"++----------------------------------------------------------------+-- data types+----------------------------------------------------------------++newtype FILETIME = FILETIME DDWORD deriving (Show, Eq, Ord)++data SYSTEMTIME = SYSTEMTIME {+    wYear, wMonth, wDayOfWeek, wDay, wHour, wMinute, wSecond, wMilliseconds :: WORD }+    deriving (Show, Eq, Ord)++data TIME_ZONE_INFORMATION = TIME_ZONE_INFORMATION+    { tziBias :: LONG+    , tziStandardName :: String+    , tziStandardDate :: SYSTEMTIME+    , tziStandardBias :: LONG+    , tziDaylightName :: String+    , tziDaylightDate :: SYSTEMTIME+    , tziDaylightBias :: LONG+    } deriving (Show,Eq,Ord)++data TimeZoneId = TzIdUnknown | TzIdStandard | TzIdDaylight+    deriving (Show, Eq, Ord)++data LASTINPUTINFO = LASTINPUTINFO DWORD deriving (Show)++----------------------------------------------------------------+-- Instances+----------------------------------------------------------------++instance Storable FILETIME where+    sizeOf = const (#size FILETIME)+    alignment _ = #alignment FILETIME+    poke buf (FILETIME n) = do+        (#poke FILETIME, dwLowDateTime) buf low+        (#poke FILETIME, dwHighDateTime) buf hi+        where (hi,low) = ddwordToDwords n+    peek buf = do+        low <- (#peek FILETIME, dwLowDateTime) buf+        hi <- (#peek FILETIME, dwHighDateTime) buf+        return $ FILETIME $ dwordsToDdword (hi,low)++instance Storable SYSTEMTIME where+    sizeOf _ = #size SYSTEMTIME+    alignment _ = #alignment SYSTEMTIME+    poke buf st = do+         (#poke SYSTEMTIME, wYear)          buf (wYear st)+         (#poke SYSTEMTIME, wMonth)         buf (wMonth st)+         (#poke SYSTEMTIME, wDayOfWeek)     buf (wDayOfWeek st)+         (#poke SYSTEMTIME, wDay)           buf (wDay st)+         (#poke SYSTEMTIME, wHour)          buf (wHour st)+         (#poke SYSTEMTIME, wMinute)        buf (wMinute st)+         (#poke SYSTEMTIME, wSecond)        buf (wSecond st)+         (#poke SYSTEMTIME, wMilliseconds)  buf (wMilliseconds st)+    peek buf = do+        year    <- (#peek SYSTEMTIME, wYear)        buf+        month   <- (#peek SYSTEMTIME, wMonth)       buf+        dow     <- (#peek SYSTEMTIME, wDayOfWeek)   buf+        day     <- (#peek SYSTEMTIME, wDay)         buf+        hour    <- (#peek SYSTEMTIME, wHour)        buf+        mins    <- (#peek SYSTEMTIME, wMinute)      buf+        sec     <- (#peek SYSTEMTIME, wSecond)      buf+        ms      <- (#peek SYSTEMTIME, wMilliseconds) buf+        return $ SYSTEMTIME year month dow day hour mins sec ms++instance Storable TIME_ZONE_INFORMATION where+    sizeOf _ = (#size TIME_ZONE_INFORMATION)+    alignment _ = #alignment TIME_ZONE_INFORMATION+    poke buf tzi = do+        (#poke TIME_ZONE_INFORMATION, Bias) buf (tziBias tzi)+        (#poke TIME_ZONE_INFORMATION, StandardDate) buf (tziStandardDate tzi)+        (#poke TIME_ZONE_INFORMATION, StandardBias) buf (tziStandardBias tzi)+        (#poke TIME_ZONE_INFORMATION, DaylightDate) buf (tziDaylightDate tzi)+        (#poke TIME_ZONE_INFORMATION, DaylightBias) buf (tziDaylightBias tzi)+        write buf (#offset TIME_ZONE_INFORMATION, StandardName) (tziStandardName tzi)+        write buf (#offset TIME_ZONE_INFORMATION, DaylightName) (tziDaylightName tzi)+        where+            write buf_ offset str = withCWStringLen str $ \(c_str,len) -> do+                when (len>31) $ fail "Storable TIME_ZONE_INFORMATION.poke: Too long string."+                let len'  = len * sizeOf (undefined :: CWchar)+                    start = (advancePtr (castPtr buf_) offset)+                    end   = advancePtr start len'+                copyArray start (castPtr c_str :: Ptr Word8) len'+                poke (castPtr end) (0 :: CWchar)++    peek buf = do+        bias <- (#peek TIME_ZONE_INFORMATION, Bias)         buf+        sdat <- (#peek TIME_ZONE_INFORMATION, StandardDate) buf+        sbia <- (#peek TIME_ZONE_INFORMATION, StandardBias) buf+        ddat <- (#peek TIME_ZONE_INFORMATION, DaylightDate) buf+        dbia <- (#peek TIME_ZONE_INFORMATION, DaylightBias) buf+        snam <- peekCWString (plusPtr buf (#offset TIME_ZONE_INFORMATION, StandardName))+        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 ()++foreign import WINDOWS_CCONV "windows.h SetSystemTime"+    c_SetSystemTime :: Ptr SYSTEMTIME -> IO BOOL++foreign import WINDOWS_CCONV "windows.h GetSystemTimeAsFileTime"+    c_GetSystemTimeAsFileTime :: Ptr FILETIME -> IO ()++foreign import WINDOWS_CCONV "windows.h GetLocalTime"+    c_GetLocalTime :: Ptr SYSTEMTIME -> IO ()++foreign import WINDOWS_CCONV "windows.h SetLocalTime"+    c_SetLocalTime :: Ptr SYSTEMTIME -> IO BOOL++foreign import WINDOWS_CCONV "windows.h GetSystemTimeAdjustment"+    c_GetSystemTimeAdjustment :: Ptr DWORD -> Ptr DWORD -> Ptr BOOL -> IO BOOL++foreign import WINDOWS_CCONV "windows.h GetTickCount" getTickCount :: IO DWORD++foreign import WINDOWS_CCONV unsafe "windows.h GetLastInputInfo"+  c_GetLastInputInfo :: Ptr LASTINPUTINFO -> IO Bool++foreign import WINDOWS_CCONV "windows.h SetSystemTimeAdjustment"+    c_SetSystemTimeAdjustment :: DWORD -> BOOL -> IO BOOL++foreign import WINDOWS_CCONV "windows.h GetTimeZoneInformation"+    c_GetTimeZoneInformation :: Ptr TIME_ZONE_INFORMATION -> IO DWORD++foreign import WINDOWS_CCONV "windows.h SystemTimeToFileTime"+    c_SystemTimeToFileTime :: Ptr SYSTEMTIME -> Ptr FILETIME -> IO BOOL++foreign import WINDOWS_CCONV "windows.h FileTimeToSystemTime"+    c_FileTimeToSystemTime :: Ptr FILETIME -> Ptr SYSTEMTIME -> IO BOOL++foreign import WINDOWS_CCONV "windows.h GetFileTime"+    c_GetFileTime :: HANDLE -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> IO BOOL++foreign import WINDOWS_CCONV "windows.h SetFileTime"+    c_SetFileTime :: HANDLE -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> IO BOOL++foreign import WINDOWS_CCONV "windows.h FileTimeToLocalFileTime"+    c_FileTimeToLocalFileTime :: Ptr FILETIME -> Ptr FILETIME -> IO BOOL++foreign import WINDOWS_CCONV "windows.h LocalFileTimeToFileTime"+    c_LocalFileTimeToFileTime :: Ptr FILETIME -> Ptr FILETIME -> IO BOOL++{-+-- Windows XP SP1+foreign import WINDOWS_CCONV "windows.h GetSystemTimes"+    c_GetSystemTimes :: Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> IO BOOL+getSystemTimes :: IO (FILETIME,FILETIME,FILETIME)+getSystemTimes = alloca $ \idle -> alloca $ \kernel -> alloca $ \user -> do+    failIf not "getSystemTimes: GetSystemTimes" $ c_GetSystemTimes idle kernel user+    liftM3 (,,) (peek idle) (peek kernel) (peek user)+-}++{-+-- Windows XP+foreign import WINDOWS_CCONV "windows.h SystemTimeToTzSpecificLocalTime"+    c_SystemTimeToTzSpecificLocalTime :: Ptr TIME_ZONE_INFORMATION -> Ptr SYSTEMTIME -> Ptr SYSTEMTIME -> IO BOOL+systemTimeToTzSpecificLocalTime :: TIME_ZONE_INFORMATION -> SYSTEMTIME -> IO SYSTEMTIME+systemTimeToTzSpecificLocalTime tzi st = with tzi $ \tzi -> with st $ \st -> alloca $ \res -> do+    failIf not "systemTimeToTzSpecificLocalTime: SystemTimeToTzSpecificLocalTime" $+        c_SystemTimeToTzSpecificLocalTime tzi st res+    peek res++foreign import WINDOWS_CCONV "windows.h TzSpecificLocalTimeToSystemTime"+    c_TzSpecificLocalTimeToSystemTime :: Ptr TIME_ZONE_INFORMATION -> Ptr SYSTEMTIME -> Ptr SYSTEMTIME -> IO BOOL+tzSpecificLocalTimeToSystemTime :: TIME_ZONE_INFORMATION -> SYSTEMTIME -> IO SYSTEMTIME+tzSpecificLocalTimeToSystemTime tzi st = with tzi $ \tzi -> with st $ \st -> alloca $ \res -> do+    failIf not "tzSpecificLocalTimeToSystemTime: TzSpecificLocalTimeToSystemTime" $+        c_TzSpecificLocalTimeToSystemTime tzi st res+    peek res+-}++foreign import WINDOWS_CCONV "windows.h QueryPerformanceFrequency"+    c_QueryPerformanceFrequency :: Ptr LARGE_INTEGER -> IO BOOL++foreign import WINDOWS_CCONV "windows.h QueryPerformanceCounter"+    c_QueryPerformanceCounter:: Ptr LARGE_INTEGER -> IO BOOL++type GetTimeFormatFlags = DWORD+#{enum GetTimeFormatFlags,+    , lOCALE_NOUSEROVERRIDE = LOCALE_NOUSEROVERRIDE+    , lOCALE_USE_CP_ACP     = LOCALE_USE_CP_ACP+    , tIME_NOMINUTESORSECONDS = TIME_NOMINUTESORSECONDS+    , tIME_NOSECONDS        = TIME_NOSECONDS+    , tIME_NOTIMEMARKER     = TIME_NOTIMEMARKER+    , tIME_FORCE24HOURFORMAT= TIME_FORCE24HOURFORMAT+    }++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

@@ -0,0 +1,67 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Win32.DLL
+-- Copyright   :  (c) Alastair Reid, 1997-2003
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  Esa Ilari Vuokko <ei@vuokko.info>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- A collection of FFI declarations for interfacing with Win32.
+--
+-----------------------------------------------------------------------------
+
+module System.Win32.WindowsString.DLL
+    ( module System.Win32.WindowsString.DLL
+    , module System.Win32.DLL
+    ) where
+
+import System.Win32.DLL hiding
+  (   disableThreadLibraryCalls
+    , freeLibrary
+    , getModuleFileName
+    , getModuleHandle
+    , getProcAddress
+    , loadLibrary
+    , loadLibraryEx
+    , setDllDirectory
+    , lOAD_LIBRARY_AS_DATAFILE
+    , lOAD_WITH_ALTERED_SEARCH_PATH
+  )
+import System.Win32.DLL.Internal
+import System.Win32.WindowsString.Types
+
+import Foreign
+import Data.Maybe (fromMaybe)
+import System.OsString.Windows
+import GHC.IO.Encoding.UTF16 ( mkUTF16le )
+import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )
+
+getModuleFileName :: HMODULE -> IO WindowsString
+getModuleFileName hmod =
+  allocaArray 512 $ \ c_str -> do
+  failIfFalse_ "GetModuleFileName" $ c_GetModuleFileName hmod c_str 512
+  peekTString c_str
+
+getModuleHandle :: Maybe WindowsString -> IO HMODULE
+getModuleHandle mb_name =
+  maybeWith withTString mb_name $ \ c_name ->
+  failIfNull "GetModuleHandle" $ c_GetModuleHandle c_name
+
+loadLibrary :: WindowsString -> IO HINSTANCE
+loadLibrary name =
+  withTString name $ \ c_name ->
+  failIfNull "LoadLibrary" $ c_LoadLibrary c_name
+
+loadLibraryEx :: WindowsString -> HANDLE -> LoadLibraryFlags -> IO HINSTANCE
+loadLibraryEx name h flags =
+  withTString name $ \ c_name ->
+  failIfNull "LoadLibraryEx" $ c_LoadLibraryEx c_name h flags
+
+setDllDirectory :: Maybe WindowsString -> IO ()
+setDllDirectory name =
+  maybeWith withTString name $ \ c_name -> do
+    let nameS = name >>= either (const Nothing) Just . decodeWith (mkUTF16le TransliterateCodingFailure)
+    failIfFalse_ (unwords ["SetDllDirectory", fromMaybe "NULL" nameS]) $ c_SetDllDirectory c_name
+

@@ -0,0 +1,33 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Win32.WindowsString.DebugApi
+-- Copyright   :  (c) Esa Ilari Vuokko, 2006
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Esa Ilari Vuokko <ei@vuokko.info>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- A collection of FFI declarations for using Windows DebugApi.
+--
+-----------------------------------------------------------------------------
+module System.Win32.WindowsString.DebugApi
+    ( module System.Win32.WindowsString.DebugApi
+    , module System.Win32.DebugApi
+    ) where
+
+import System.Win32.DebugApi.Internal
+import System.Win32.DebugApi hiding (outputDebugString)
+import System.Win32.WindowsString.Types   ( withTString )
+import System.OsString.Windows
+
+##include "windows_cconv.h"
+#include "windows.h"
+
+
+--------------------------------------------------------------------------
+-- On process being debugged
+
+outputDebugString :: WindowsString -> IO ()
+outputDebugString s = withTString s $ \c_s -> c_OutputDebugString c_s
+

@@ -0,0 +1,238 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Win32.File
+-- Copyright   :  (c) Alastair Reid, 1997-2003
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  Esa Ilari Vuokko <ei@vuokko.info>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- A collection of FFI declarations for interfacing with Win32.
+--
+-----------------------------------------------------------------------------
+
+module System.Win32.WindowsString.File
+    ( deleteFile
+    , copyFile
+    , moveFile
+    , moveFileEx
+    , setCurrentDirectory
+    , createDirectory
+    , createDirectoryEx
+    , removeDirectory
+    , getBinaryType
+    , createFile
+    , setFileAttributes
+    , getFileAttributes
+    , getFileAttributesExStandard
+    , findFirstChangeNotification
+    , getFindDataFileName
+    , findFirstFile
+    , defineDosDevice
+    , getDiskFreeSpace
+    , setVolumeLabel
+    , getFileExInfoStandard
+    , getFileExMaxInfoLevel
+    , module System.Win32.File
+    ) where
+
+import System.Win32.File.Internal
+import System.Win32.File hiding (
+    deleteFile
+  , copyFile
+  , moveFile
+  , moveFileEx
+  , setCurrentDirectory
+  , createDirectory
+  , createDirectoryEx
+  , removeDirectory
+  , getBinaryType
+  , createFile
+  , setFileAttributes
+  , getFileAttributes
+  , getFileAttributesExStandard
+  , findFirstChangeNotification
+  , getFindDataFileName
+  , findFirstFile
+  , defineDosDevice
+  , getDiskFreeSpace
+  , setVolumeLabel
+  , getFileExInfoStandard
+  , getFileExMaxInfoLevel
+  )
+import System.Win32.WindowsString.Types
+import System.OsString.Windows
+import Unsafe.Coerce (unsafeCoerce)
+
+import Foreign hiding (void)
+
+##include "windows_cconv.h"
+
+#include <windows.h>
+#include "alignment.h"
+
+deleteFile :: WindowsString -> IO ()
+deleteFile name =
+  withTString name $ \ c_name ->
+    failIfFalseWithRetry_ (unwords ["DeleteFile",show name]) $
+      c_DeleteFile c_name
+
+copyFile :: WindowsString -> WindowsString -> Bool -> IO ()
+copyFile src dest over =
+  withTString src $ \ c_src ->
+  withTString dest $ \ c_dest ->
+  failIfFalseWithRetry_ (unwords ["CopyFile",show src,show dest]) $
+    c_CopyFile c_src c_dest over
+
+moveFile :: WindowsString -> WindowsString -> IO ()
+moveFile src dest =
+  withTString src $ \ c_src ->
+  withTString dest $ \ c_dest ->
+  failIfFalseWithRetry_ (unwords ["MoveFile",show src,show dest]) $
+    c_MoveFile c_src c_dest
+
+moveFileEx :: WindowsString -> Maybe WindowsString -> MoveFileFlag -> IO ()
+moveFileEx src dest flags =
+  withTString src $ \ c_src ->
+  maybeWith withTString dest $ \ c_dest ->
+  failIfFalseWithRetry_ (unwords ["MoveFileEx",show src,show dest]) $
+    c_MoveFileEx c_src c_dest flags
+
+setCurrentDirectory :: WindowsString -> IO ()
+setCurrentDirectory name =
+  withTString name $ \ c_name ->
+  failIfFalse_ (unwords ["SetCurrentDirectory",show name]) $
+    c_SetCurrentDirectory c_name
+
+createDirectory :: WindowsString -> Maybe LPSECURITY_ATTRIBUTES -> IO ()
+createDirectory name mb_attr =
+  withTString name $ \ c_name ->
+  failIfFalseWithRetry_ (unwords ["CreateDirectory",show name]) $
+    c_CreateDirectory c_name (maybePtr mb_attr)
+
+createDirectoryEx :: WindowsString -> WindowsString -> Maybe LPSECURITY_ATTRIBUTES -> IO ()
+createDirectoryEx template name mb_attr =
+  withTString template $ \ c_template ->
+  withTString name $ \ c_name ->
+  failIfFalseWithRetry_ (unwords ["CreateDirectoryEx",show template,show name]) $
+    c_CreateDirectoryEx c_template c_name (maybePtr mb_attr)
+
+removeDirectory :: WindowsString -> IO ()
+removeDirectory name =
+  withTString name $ \ c_name ->
+  failIfFalseWithRetry_ (unwords ["RemoveDirectory",show name]) $
+    c_RemoveDirectory c_name
+
+getBinaryType :: WindowsString -> IO BinaryType
+getBinaryType name =
+  withTString name $ \ c_name ->
+  alloca $ \ p_btype -> do
+  failIfFalse_ (unwords ["GetBinaryType",show name]) $
+    c_GetBinaryType c_name p_btype
+  peek p_btype
+
+----------------------------------------------------------------
+-- HANDLE operations
+----------------------------------------------------------------
+
+createFile :: WindowsString -> AccessMode -> ShareMode -> Maybe LPSECURITY_ATTRIBUTES -> CreateMode -> FileAttributeOrFlag -> Maybe HANDLE -> IO HANDLE
+createFile name access share mb_attr mode flag mb_h =
+  withTString name $ \ c_name ->
+  failIfWithRetry (==iNVALID_HANDLE_VALUE) (unwords ["CreateFile",show name]) $
+    c_CreateFile c_name access share (maybePtr mb_attr) mode flag (maybePtr mb_h)
+
+setFileAttributes :: WindowsString -> FileAttributeOrFlag -> IO ()
+setFileAttributes name attr =
+  withTString name $ \ c_name ->
+  failIfFalseWithRetry_ (unwords ["SetFileAttributes",show name])
+    $ c_SetFileAttributes c_name attr
+
+getFileAttributes :: WindowsString -> IO FileAttributeOrFlag
+getFileAttributes name =
+  withTString name $ \ c_name ->
+  failIfWithRetry (== 0xFFFFFFFF) (unwords ["GetFileAttributes",show name]) $
+    c_GetFileAttributes c_name
+
+getFileAttributesExStandard :: WindowsString -> IO WIN32_FILE_ATTRIBUTE_DATA
+getFileAttributesExStandard name =  alloca $ \res -> do
+  withTString name $ \ c_name ->
+    failIfFalseWithRetry_ "getFileAttributesExStandard" $
+      c_GetFileAttributesEx c_name (unsafeCoerce getFileExInfoStandard) res
+  peek res
+
+
+----------------------------------------------------------------
+-- File Notifications
+--
+-- Use these to initialise, "increment" and close a HANDLE you can wait
+-- on.
+----------------------------------------------------------------
+
+findFirstChangeNotification :: WindowsString -> Bool -> FileNotificationFlag -> IO HANDLE
+findFirstChangeNotification path watch flag =
+  withTString path $ \ c_path ->
+  failIfNull (unwords ["FindFirstChangeNotification",show path]) $
+    c_FindFirstChangeNotification c_path watch flag
+
+
+----------------------------------------------------------------
+-- Directories
+----------------------------------------------------------------
+
+
+getFindDataFileName :: FindData -> IO WindowsString
+getFindDataFileName fd = case unsafeCoerce fd of
+  (FindData fp) ->
+    withForeignPtr fp $ \p ->
+      peekTString ((# ptr WIN32_FIND_DATAW, cFileName ) p)
+
+findFirstFile :: WindowsString -> IO (HANDLE, FindData)
+findFirstFile str = do
+  fp_finddata <- mallocForeignPtrBytes (# const sizeof(WIN32_FIND_DATAW) )
+  withForeignPtr fp_finddata $ \p_finddata -> do
+    handle <- withTString str $ \tstr -> do
+                failIf (== iNVALID_HANDLE_VALUE) "findFirstFile" $
+                  c_FindFirstFile tstr p_finddata
+    return (handle, unsafeCoerce (FindData fp_finddata))
+
+
+----------------------------------------------------------------
+-- DOS Device flags
+----------------------------------------------------------------
+
+defineDosDevice :: DefineDosDeviceFlags -> WindowsString -> Maybe WindowsString -> IO ()
+defineDosDevice flags name path =
+  maybeWith withTString path $ \ c_path ->
+  withTString name $ \ c_name ->
+  failIfFalse_ "DefineDosDevice" $ c_DefineDosDevice flags c_name c_path
+
+----------------------------------------------------------------
+
+
+-- %fun GetDriveType :: Maybe String -> IO DriveType
+
+getDiskFreeSpace :: Maybe WindowsString -> IO (DWORD,DWORD,DWORD,DWORD)
+getDiskFreeSpace path =
+  maybeWith withTString path $ \ c_path ->
+  alloca $ \ p_sectors ->
+  alloca $ \ p_bytes ->
+  alloca $ \ p_nfree ->
+  alloca $ \ p_nclusters -> do
+  failIfFalse_ "GetDiskFreeSpace" $
+    c_GetDiskFreeSpace c_path p_sectors p_bytes p_nfree p_nclusters
+  sectors <- peek p_sectors
+  bytes <- peek p_bytes
+  nfree <- peek p_nfree
+  nclusters <- peek p_nclusters
+  return (sectors, bytes, nfree, nclusters)
+
+setVolumeLabel :: Maybe WindowsString -> Maybe WindowsString -> IO ()
+setVolumeLabel path name =
+  maybeWith withTString path $ \ c_path ->
+  maybeWith withTString name $ \ c_name ->
+  failIfFalse_ "SetVolumeLabel" $ c_SetVolumeLabel c_path c_name
+
+----------------------------------------------------------------
+-- End
+----------------------------------------------------------------

@@ -0,0 +1,107 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Win32.FileMapping
+-- Copyright   :  (c) Esa Ilari Vuokko, 2006
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Esa Ilari Vuokko <ei@vuokko.info>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- A collection of FFI declarations for interfacing with Win32 mapped files.
+--
+-----------------------------------------------------------------------------
+module System.Win32.WindowsString.FileMapping
+    ( module System.Win32.WindowsString.FileMapping
+    , module System.Win32.FileMapping
+    ) where
+
+import System.Win32.FileMapping hiding
+    (
+      mapFile
+    , withMappedFile
+    , createFileMapping
+    , openFileMapping
+    )
+
+import System.Win32.FileMapping.Internal
+import System.Win32.WindowsString.Types   ( HANDLE, BOOL, withTString
+                            , failIf, DDWORD, ddwordToDwords
+                            , iNVALID_HANDLE_VALUE )
+import System.Win32.Mem
+import System.Win32.WindowsString.File
+import System.OsString.Windows
+import System.OsPath.Windows
+
+import Control.Exception        ( mask_, bracket )
+import Foreign                  ( nullPtr, maybeWith
+                                , ForeignPtr, newForeignPtr )
+
+##include "windows_cconv.h"
+
+#include "windows.h"
+
+---------------------------------------------------------------------------
+-- Derived functions
+---------------------------------------------------------------------------
+
+-- | Maps file fully and returns ForeignPtr and length of the mapped area.
+-- The mapped file is opened read-only and shared reading.
+mapFile :: WindowsPath -> IO (ForeignPtr a, Int)
+mapFile path = do
+    bracket
+        (createFile path gENERIC_READ fILE_SHARE_READ Nothing oPEN_EXISTING fILE_ATTRIBUTE_NORMAL Nothing)
+        (closeHandle)
+        $ \fh -> bracket
+            (createFileMapping (Just fh) pAGE_READONLY 0 Nothing)
+            (closeHandle)
+            $ \fm -> do
+                fi <- getFileInformationByHandle fh
+                fp <- mask_ $ do
+                    ptr <- mapViewOfFile fm fILE_MAP_READ 0 0
+                    newForeignPtr c_UnmapViewOfFileFinaliser ptr
+                return (fp, fromIntegral $ bhfiSize fi)
+
+-- | Opens an existing file and creates mapping object to it.
+withMappedFile
+    :: WindowsPath             -- ^ Path
+    -> Bool                 -- ^ Write? (False = read-only)
+    -> Maybe Bool           -- ^ Sharing mode, no sharing, share read, share read+write
+    -> (Integer -> MappedObject -> IO a) -- ^ Action
+    -> IO a
+withMappedFile path write share act =
+    bracket
+        (createFile path access share' Nothing oPEN_EXISTING fILE_ATTRIBUTE_NORMAL Nothing)
+        (closeHandle)
+        $ \fh -> bracket
+            (createFileMapping (Just fh) page 0 Nothing)
+            (closeHandle)
+            $ \fm -> do
+                bhfi <- getFileInformationByHandle fh
+                act (fromIntegral $ bhfiSize bhfi) (MappedObject fh fm mapaccess)
+    where
+        access    = if write then gENERIC_READ+gENERIC_WRITE else gENERIC_READ
+        page      = if write then pAGE_READWRITE else pAGE_READONLY
+        mapaccess = if write then fILE_MAP_ALL_ACCESS else fILE_MAP_READ
+        share' = case share of
+            Nothing     -> fILE_SHARE_NONE
+            Just False  -> fILE_SHARE_READ
+            Just True   -> fILE_SHARE_READ + fILE_SHARE_WRITE
+
+---------------------------------------------------------------------------
+-- API in Haskell
+---------------------------------------------------------------------------
+createFileMapping :: Maybe HANDLE -> ProtectFlags -> DDWORD -> Maybe WindowsString -> IO HANDLE
+createFileMapping mh flags mosize name =
+    maybeWith withTString name $ \c_name ->
+        failIf (==nullPtr) "createFileMapping: CreateFileMapping" $ c_CreateFileMapping handle nullPtr flags moshi moslow c_name
+    where
+        (moshi,moslow) = ddwordToDwords mosize
+        handle = maybe iNVALID_HANDLE_VALUE id mh
+
+openFileMapping :: FileMapAccess -> BOOL -> Maybe WindowsString -> IO HANDLE
+openFileMapping access inherit name =
+    maybeWith withTString name $ \c_name ->
+        failIf (==nullPtr) "openFileMapping: OpenFileMapping" $
+            c_OpenFileMapping access inherit c_name
+

@@ -0,0 +1,47 @@+{-# LANGUAGE CPP #-}
+{- |
+   Module      :  System.Win32.HardLink
+   Copyright   :  2013 shelarcy
+   License     :  BSD-style
+
+   Maintainer  :  shelarcy@gmail.com
+   Stability   :  Provisional
+   Portability :  Non-portable (Win32 API)
+
+   Handling hard link using Win32 API. [NTFS only]
+
+   Note: You should worry about file system type when use this module's function in your application:
+
+     * NTFS only supprts this functionality.
+
+     * ReFS doesn't support hard link currently.
+-}
+module System.Win32.WindowsString.HardLink
+  ( createHardLink
+  , createHardLink'
+  ) where
+
+import System.Win32.HardLink.Internal
+import System.Win32.WindowsString.File   ( failIfFalseWithRetry_ )
+import System.Win32.WindowsString.String ( withTString )
+import System.Win32.WindowsString.Types  ( nullPtr )
+import System.OsPath.Windows
+
+#include "windows_cconv.h"
+
+-- | NOTE: createHardLink is /flipped arguments/ to provide compatibility for Unix.
+-- 
+-- If you want to create hard link by Windows way, use 'createHardLink'' instead.
+createHardLink :: WindowsPath -- ^ Target file path
+               -> WindowsPath -- ^ Hard link name
+               -> IO ()
+createHardLink = flip createHardLink'
+
+createHardLink' :: WindowsPath -- ^ Hard link name
+                -> WindowsPath -- ^ Target file path
+                -> IO ()
+createHardLink' link target =
+   withTString target $ \c_target ->
+   withTString link   $ \c_link ->
+        failIfFalseWithRetry_ (unwords ["CreateHardLinkW",show link,show target]) $
+          c_CreateHardLink c_link c_target nullPtr

@@ -0,0 +1,114 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Win32.Info
+-- Copyright   :  (c) Alastair Reid, 1997-2003
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  Esa Ilari Vuokko <ei@vuokko.info>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- A collection of FFI declarations for interfacing with Win32.
+--
+-----------------------------------------------------------------------------
+
+module System.Win32.WindowsString.Info
+    ( module System.Win32.WindowsString.Info
+    , module System.Win32.Info
+    ) where
+
+import System.Win32.Info.Internal
+import System.Win32.Info hiding (
+    getSystemDirectory
+  , getWindowsDirectory
+  , getCurrentDirectory
+  , getTemporaryDirectory
+  , getFullPathName
+  , getLongPathName
+  , getShortPathName
+  , searchPath
+  , getUserName
+  )
+import Control.Exception (catch)
+import Foreign.Marshal.Alloc (alloca)
+import Foreign.Marshal.Utils (with, maybeWith)
+import Foreign.Marshal.Array (allocaArray)
+import Foreign.Ptr (nullPtr)
+import Foreign.Storable (Storable(..))
+import System.IO.Error (isDoesNotExistError)
+import System.Win32.WindowsString.Types (failIfFalse_, peekTStringLen, withTString, try)
+import System.OsPath.Windows
+
+#if !MIN_VERSION_base(4,6,0)
+import Prelude hiding (catch)
+#endif
+
+##include "windows_cconv.h"
+
+#include <windows.h>
+#include "alignment.h"
+
+----------------------------------------------------------------
+-- Standard Directories
+----------------------------------------------------------------
+
+getSystemDirectory :: IO WindowsString
+getSystemDirectory = try "GetSystemDirectory" c_getSystemDirectory 512
+
+getWindowsDirectory :: IO WindowsString
+getWindowsDirectory = try "GetWindowsDirectory" c_getWindowsDirectory 512
+
+getCurrentDirectory :: IO WindowsString
+getCurrentDirectory = try "GetCurrentDirectory" (flip c_getCurrentDirectory) 512
+
+getTemporaryDirectory :: IO WindowsString
+getTemporaryDirectory = try "GetTempPath" (flip c_getTempPath) 512
+
+getFullPathName :: WindowsPath -> IO WindowsPath
+getFullPathName name = do
+  withTString name $ \ c_name ->
+    try "getFullPathName"
+      (\buf len -> c_GetFullPathName c_name len buf nullPtr) 512
+
+getLongPathName :: WindowsPath -> IO WindowsPath
+getLongPathName name = do
+  withTString name $ \ c_name ->
+    try "getLongPathName"
+      (c_GetLongPathName c_name) 512
+
+getShortPathName :: WindowsPath -> IO WindowsPath
+getShortPathName name = do
+  withTString name $ \ c_name ->
+    try "getShortPathName"
+      (c_GetShortPathName c_name) 512
+
+searchPath :: Maybe WindowsString -> WindowsPath -> Maybe WindowsString -> IO (Maybe WindowsPath)
+searchPath path filename ext =
+  maybe ($ nullPtr) withTString path $ \p_path ->
+  withTString filename $ \p_filename ->
+  maybeWith withTString ext      $ \p_ext ->
+  alloca $ \ppFilePart -> (do
+    s <- try "searchPath" (\buf len -> c_SearchPath p_path p_filename p_ext
+                          len buf ppFilePart) 512
+    return (Just s))
+     `catch` \e -> if isDoesNotExistError e
+                       then return Nothing
+                       else ioError e
+
+----------------------------------------------------------------
+-- User name
+----------------------------------------------------------------
+
+-- %fun GetUserName :: IO String
+
+getUserName :: IO WindowsString
+getUserName =
+  allocaArray 512 $ \ c_str ->
+    with 512 $ \ c_len -> do
+        failIfFalse_ "GetUserName" $ c_GetUserName c_str c_len
+        len <- peek c_len
+        peekTStringLen (c_str, fromIntegral len - 1)
+
+----------------------------------------------------------------
+-- End
+----------------------------------------------------------------

@@ -0,0 +1,52 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Win32.Path
+-- Copyright   :  (c) Tamar Christina, 1997-2003
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  Tamar Christina <tamar@zhox.com>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- A collection of FFI declarations for interfacing with Win32.
+--
+-----------------------------------------------------------------------------
+
+module System.Win32.WindowsString.Path (
+   filepathRelativePathTo
+ , pathRelativePathTo
+ ) where
+
+import System.Win32.Path.Internal
+import System.Win32.WindowsString.Types
+import System.Win32.WindowsString.File
+import System.OsPath.Windows
+
+import Foreign
+
+##include "windows_cconv.h"
+
+#include <windows.h>
+
+filepathRelativePathTo :: WindowsPath -> WindowsPath -> IO WindowsPath
+filepathRelativePathTo from to =
+  withTString from $ \p_from ->
+  withTString to   $ \p_to   ->
+  allocaArray ((#const MAX_PATH) * (#size TCHAR)) $ \p_AbsPath -> do
+    _ <- failIfZero "PathRelativePathTo" (c_pathRelativePathTo p_AbsPath p_from fILE_ATTRIBUTE_DIRECTORY
+                                                                         p_to   fILE_ATTRIBUTE_NORMAL)
+    path <- peekTString p_AbsPath
+    _ <- localFree p_AbsPath
+    return path
+
+pathRelativePathTo :: WindowsPath -> FileAttributeOrFlag -> WindowsPath -> FileAttributeOrFlag -> IO WindowsPath
+pathRelativePathTo from from_attr to to_attr =
+  withTString from $ \p_from ->
+  withTString to   $ \p_to   ->
+  allocaArray ((#const MAX_PATH) * (#size TCHAR)) $ \p_AbsPath -> do
+    _ <- failIfZero "PathRelativePathTo" (c_pathRelativePathTo p_AbsPath p_from from_attr
+                                                                         p_to   to_attr)
+    path <- peekTString p_AbsPath
+    _ <- localFree p_AbsPath
+    return path
+

@@ -0,0 +1,59 @@+{-# LANGUAGE Trustworthy #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  System.Win32.WindowsString.Shell+-- Copyright   :  (c) The University of Glasgow 2009+-- License     :  BSD-style (see the file libraries/base/LICENSE)+--+-- Maintainer  :  Esa Ilari Vuokko <ei@vuokko.info>+-- Stability   :  provisional+-- Portability :  portable+--+-- Win32 stuff from shell32.dll+--+-----------------------------------------------------------------------------++module System.Win32.WindowsString.Shell (+  sHGetFolderPath,+  CSIDL,+  cSIDL_PROFILE,+  cSIDL_APPDATA,+  cSIDL_WINDOWS,+  cSIDL_PERSONAL,+  cSIDL_LOCAL_APPDATA,+  cSIDL_DESKTOPDIRECTORY,+  cSIDL_PROGRAM_FILES,+  SHGetFolderPathFlags,+  sHGFP_TYPE_CURRENT,+  sHGFP_TYPE_DEFAULT+ ) where++import System.OsString.Windows (WindowsString)+import System.Win32.Shell.Internal+import System.Win32.Shell hiding (sHGetFolderPath)+import System.Win32.WindowsString.Types+import Graphics.Win32.GDI.Types (HWND)++import Foreign+import Control.Monad++##include "windows_cconv.h"++-- for SHGetFolderPath stuff+#define _WIN32_IE 0x500+#include <windows.h>+#include <shlobj.h>++----------------------------------------------------------------+-- SHGetFolderPath+--+-- XXX: this is deprecated in Vista and later+----------------------------------------------------------------+++sHGetFolderPath :: HWND -> CSIDL -> HANDLE -> SHGetFolderPathFlags -> IO WindowsString+sHGetFolderPath hwnd csidl hdl flags =+  allocaBytes ((#const MAX_PATH) * (#size TCHAR)) $ \pstr -> do+    r <- c_SHGetFolderPath hwnd csidl hdl flags pstr+    when (r < 0) $ raiseUnsupported "sHGetFolderPath"+    peekTString pstr

@@ -0,0 +1,67 @@+{- |
+   Module      :  System.Win32.String
+   Copyright   :  2013 shelarcy
+   License     :  BSD-style
+
+   Maintainer  :  shelarcy@gmail.com
+   Stability   :  Provisional
+   Portability :  Non-portable (Win32 API)
+
+   Utilities for primitive marshalling of Windows' C strings.
+-}
+module System.Win32.WindowsString.String
+  ( LPSTR, LPCSTR, LPWSTR, LPCWSTR
+  , TCHAR, LPTSTR, LPCTSTR, LPCTSTR_
+  , withTString, withTStringLen, peekTString, peekTStringLen
+  , newTString
+  , withTStringBuffer, withTStringBufferLen
+  ) where
+
+import System.Win32.String hiding
+  ( withTStringBuffer
+  , withTStringBufferLen
+  , withTString
+  , withTStringLen
+  , peekTString
+  , peekTStringLen
+  , newTString
+  )
+import System.Win32.WindowsString.Types
+import System.OsString.Internal.Types
+import qualified System.OsPath.Data.ByteString.Short as SBS
+import Data.Word (Word8)
+
+-- | Marshal a dummy Haskell string into a NUL terminated C wide string
+-- using temporary storage.
+--
+-- * the Haskell string is created by length parameter. And the Haskell
+--   string contains /only/ NUL characters.
+--
+-- * the memory is freed when the subcomputation terminates (either
+--   normally or via an exception), so the pointer to the temporary
+--   storage must /not/ be used after this.
+--
+withTStringBuffer :: Int -> (LPTSTR -> IO a) -> IO a
+withTStringBuffer maxLength
+  = let dummyBuffer = WindowsString $ SBS.pack $ replicate (if even maxLength then maxLength else maxLength + 1) _nul
+    in  withTString dummyBuffer
+
+-- | Marshal a dummy Haskell string into a C wide string (i.e. wide
+-- character array) in temporary storage, with explicit length
+-- information.
+--
+-- * the Haskell string is created by length parameter. And the Haskell
+--   string contains /only/ NUL characters.
+--
+-- * the memory is freed when the subcomputation terminates (either
+--   normally or via an exception), so the pointer to the temporary
+--   storage must /not/ be used after this.
+--
+withTStringBufferLen :: Int -> ((LPTSTR, Int) -> IO a) -> IO a
+withTStringBufferLen maxLength
+  = let dummyBuffer = WindowsString $ SBS.pack $ replicate (if even maxLength then maxLength else maxLength + 1) _nul
+    in  withTStringLen dummyBuffer
+
+
+_nul :: Word8
+_nul = 0x00

@@ -0,0 +1,94 @@+{-# LANGUAGE CPP #-}
+{- |
+   Module      :  System.Win32.SymbolicLink
+   Copyright   :  2012 shelarcy
+   License     :  BSD-style
+
+   Maintainer  :  shelarcy@gmail.com
+   Stability   :  Provisional
+   Portability :  Non-portable (Win32 API)
+
+   Handling symbolic link using Win32 API. [Vista of later and desktop app only]
+
+   Note: When using the createSymbolicLink* functions without the
+   SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE flag, you should worry about UAC
+   (User Account Control) when use this module's function in your application:
+
+     * require to use 'Run As Administrator' to run your application.
+
+     * or modify your application's manifect file to add
+       \<requestedExecutionLevel level='requireAdministrator' uiAccess='false'/\>.
+
+   Starting from Windows 10 version 1703 (Creators Update), after enabling
+   Developer Mode, users can create symbolic links without requiring the
+   Administrator privilege in the current process. Supply a 'True' flag in
+   addition to the target and link name to enable this behavior.
+-}
+module System.Win32.WindowsString.SymbolicLink
+  ( SymbolicLinkFlags
+  , sYMBOLIC_LINK_FLAG_FILE
+  , sYMBOLIC_LINK_FLAG_DIRECTORY
+  , sYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE
+  , createSymbolicLink
+  , createSymbolicLink'
+  , createSymbolicLinkFile
+  , createSymbolicLinkDirectory
+  ) where
+
+import System.Win32.SymbolicLink.Internal
+import Data.Bits ((.|.))
+import System.Win32.WindowsString.Types
+import System.Win32.WindowsString.File ( failIfFalseWithRetry_ )
+import System.OsPath.Windows
+import Unsafe.Coerce (unsafeCoerce)
+
+##include "windows_cconv.h"
+
+-- | createSymbolicLink* functions don't check that file is exist or not.
+--
+-- NOTE: createSymbolicLink* functions are /flipped arguments/ to provide compatibility for Unix,
+-- except 'createSymbolicLink''.
+--
+-- If you want to create symbolic link by Windows way, use 'createSymbolicLink'' instead.
+createSymbolicLink :: WindowsPath -- ^ Target file path
+                   -> WindowsPath -- ^ Symbolic link name
+                   -> SymbolicLinkFlags -> IO ()
+createSymbolicLink = flip createSymbolicLink'
+
+createSymbolicLinkFile :: WindowsPath -- ^ Target file path
+                       -> WindowsPath -- ^ Symbolic link name
+                       -> Bool -- ^ Create the symbolic link with the unprivileged mode
+                       -> IO ()
+createSymbolicLinkFile target link unprivileged =
+  createSymbolicLink'
+    link
+    target
+    ( if unprivileged
+        then sYMBOLIC_LINK_FLAG_FILE .|. sYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE
+        else sYMBOLIC_LINK_FLAG_FILE
+    )
+
+createSymbolicLinkDirectory :: WindowsPath -- ^ Target file path
+                            -> WindowsPath -- ^ Symbolic link name
+                            -> Bool -- ^ Create the symbolic link with the unprivileged mode
+                            -> IO ()
+createSymbolicLinkDirectory target link unprivileged =
+  createSymbolicLink'
+    link
+    target
+    ( if unprivileged
+        then
+          sYMBOLIC_LINK_FLAG_DIRECTORY
+            .|. sYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE
+        else sYMBOLIC_LINK_FLAG_DIRECTORY
+    )
+
+createSymbolicLink' :: WindowsPath -- ^ Symbolic link name
+                    -> WindowsPath -- ^ Target file path
+                    -> SymbolicLinkFlags -> IO ()
+createSymbolicLink' link target flag = do
+    withTString link $ \c_link ->
+      withTString target $ \c_target ->
+        failIfFalseWithRetry_ (unwords ["CreateSymbolicLink",show link,show target]) $
+          c_CreateSymbolicLink c_link c_target (unsafeCoerce flag)
+

@@ -0,0 +1,60 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Win32.Time
+-- Copyright   :  (c) Esa Ilari Vuokko, 2006
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Esa Ilari Vuokko <ei@vuokko.info>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- A collection of FFI declarations for interfacing with Win32 Time API.
+--
+-----------------------------------------------------------------------------
+module System.Win32.WindowsString.Time
+    ( module System.Win32.WindowsString.Time
+    , module System.Win32.Time
+    ) where
+
+import System.Win32.Time.Internal
+import System.Win32.Time hiding (getTimeFormatEx, getTimeFormat)
+
+import System.Win32.WindowsString.String  ( peekTStringLen, withTString )
+import System.Win32.WindowsString.Types   ( LCID, failIf )
+import System.Win32.Utils   ( trySized )
+
+import Foreign          ( Storable(sizeOf)
+                        , nullPtr, castPtr
+                        , with, allocaBytes )
+import Foreign.C        ( CWchar(..)
+                        , withCWString )
+import Foreign.Marshal.Utils (maybeWith)
+import System.OsString.Windows
+
+##include "windows_cconv.h"
+#include <windows.h>
+#include "alignment.h"
+#include "winnls_compat.h"
+
+
+getTimeFormatEx :: Maybe WindowsString
+                -> GetTimeFormatFlags
+                -> Maybe SYSTEMTIME
+                -> Maybe WindowsString
+                -> 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
+
+getTimeFormat :: LCID -> GetTimeFormatFlags -> Maybe SYSTEMTIME -> Maybe String -> IO WindowsString
+getTimeFormat locale flags st fmt =
+    maybeWith with st $ \c_st ->
+    maybeWith withCWString fmt $ \c_fmt -> do
+        size <- c_GetTimeFormat locale flags c_st c_fmt nullPtr 0
+        allocaBytes ((fromIntegral size) * (sizeOf (undefined::CWchar))) $ \out -> do
+            size' <- failIf (==0) "getTimeFormat: GetTimeFormat" $
+                c_GetTimeFormat locale flags c_st c_fmt (castPtr out) size
+            peekTStringLen (out,fromIntegral size')

@@ -0,0 +1,166 @@+{-# LANGUAGE CPP #-}
+{-# LANGUAGE Trustworthy #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Win32.Types
+-- Copyright   :  (c) Alastair Reid, 1997-2003
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  Esa Ilari Vuokko <ei@vuokko.info>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- A collection of FFI declarations for interfacing with Win32.
+--
+-----------------------------------------------------------------------------
+
+module System.Win32.WindowsString.Types
+        ( module System.Win32.WindowsString.Types
+        , module System.Win32.Types
+        ) where
+
+import System.Win32.Types hiding (
+    withTString
+  , withTStringLen
+  , peekTString
+  , peekTStringLen
+  , newTString
+  , failIf
+  , failIf_
+  , failIfNeg
+  , failIfNull
+  , failIfZero
+  , failIfFalse_
+  , failUnlessSuccess
+  , failUnlessSuccessOr
+  , errorWin
+  , failWith
+  , try
+  )
+
+import System.OsString.Windows
+import System.OsString.Internal.Types
+import System.OsPath.Data.ByteString.Short.Word16 (
+  packCWString,
+  packCWStringLen,
+  useAsCWString,
+  useAsCWStringLen,
+  newCWString
+  )
+import Data.Bifunctor (first)
+import Data.Char (isSpace)
+import Numeric (showHex)
+import qualified System.IO as IO ()
+import System.IO.Error (ioeSetErrorString)
+import Foreign (allocaArray)
+import Foreign.Ptr ( Ptr )
+import Foreign.C.Error ( errnoToIOError )
+import Control.Exception ( throwIO )
+import GHC.Ptr (castPtr)
+
+#if !MIN_VERSION_base(4,8,0)
+import Data.Word (Word)
+#endif
+
+import GHC.IO.Encoding.UTF16 ( mkUTF16le )
+import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )
+
+#include <fcntl.h>
+#include <windows.h>
+##include "windows_cconv.h"
+
+
+----------------------------------------------------------------
+-- Chars and strings
+----------------------------------------------------------------
+
+withTString    :: WindowsString -> (LPTSTR -> IO a) -> IO a
+withTStringLen :: WindowsString -> ((LPTSTR, Int) -> IO a) -> IO a
+peekTString    :: LPCTSTR -> IO WindowsString
+peekTStringLen :: (LPCTSTR, Int) -> IO WindowsString
+newTString     :: WindowsString -> IO LPCTSTR
+
+-- UTF-16 version:
+-- the casts are from 'Ptr Word16' to 'Ptr CWchar', which is safe
+withTString (WindowsString str) f    = useAsCWString str (\ptr -> f (castPtr ptr))
+withTStringLen (WindowsString str) f = useAsCWStringLen str (\(ptr, len) -> f (castPtr ptr, len))
+peekTString    = fmap WindowsString . packCWString . castPtr
+peekTStringLen = fmap WindowsString . packCWStringLen . first castPtr
+newTString (WindowsString str) = fmap castPtr $ newCWString str
+
+----------------------------------------------------------------
+-- Errors
+----------------------------------------------------------------
+
+failIf :: (a -> Bool) -> String -> IO a -> IO a
+failIf p wh act = do
+  v <- act
+  if p v then errorWin wh else return v
+
+failIf_ :: (a -> Bool) -> String -> IO a -> IO ()
+failIf_ p wh act = do
+  v <- act
+  if p v then errorWin wh else return ()
+
+failIfNeg :: (Num a, Ord a) => String -> IO a -> IO a
+failIfNeg = failIf (< 0)
+
+failIfNull :: String -> IO (Ptr a) -> IO (Ptr a)
+failIfNull = failIf (== nullPtr)
+
+failIfZero :: (Eq a, Num a) => String -> IO a -> IO a
+failIfZero = failIf (== 0)
+
+failIfFalse_ :: String -> IO Bool -> IO ()
+failIfFalse_ = failIf_ not
+
+failUnlessSuccess :: String -> IO ErrCode -> IO ()
+failUnlessSuccess fn_name act = do
+  r <- act
+  if r == 0 then return () else failWith fn_name r
+
+failUnlessSuccessOr :: ErrCode -> String -> IO ErrCode -> IO Bool
+failUnlessSuccessOr val fn_name act = do
+  r <- act
+  if r == 0 then return False
+    else if r == val then return True
+    else failWith fn_name r
+
+
+errorWin :: String -> IO a
+errorWin fn_name = do
+  err_code <- getLastError
+  failWith fn_name err_code
+
+failWith :: String -> ErrCode -> IO a
+failWith fn_name err_code = do
+  c_msg <- getErrorMessage err_code
+
+  msg <- either (fail . show) pure . decodeWith (mkUTF16le TransliterateCodingFailure) =<< if c_msg == nullPtr
+           then either (fail . show) pure . encodeWith (mkUTF16le TransliterateCodingFailure) $ "Error 0x" ++ Numeric.showHex err_code ""
+           else do msg <- peekTString c_msg
+                   -- We ignore failure of freeing c_msg, given we're already failing
+                   _ <- localFree c_msg
+                   return msg
+  -- turn GetLastError() into errno, which errnoToIOError knows how to convert
+  -- to an IOException we can throw.
+  errno <- c_maperrno_func err_code
+  let msg' = reverse $ dropWhile isSpace $ reverse msg -- drop trailing \n
+      ioerror = errnoToIOError fn_name errno Nothing Nothing
+                  `ioeSetErrorString` msg'
+  throwIO ioerror
+
+
+-- 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 double the buffer size and try again.
+try :: String -> (LPTSTR -> UINT -> IO UINT) -> UINT -> IO WindowsString
+try 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
+            str <- peekTStringLen (lptstr, fromIntegral r)
+            return (Right str)
+   case e of
+        Left n'   -> try loc f n'
+        Right str -> return str

@@ -0,0 +1,63 @@+{- |
+   Module      :  System.Win32.Utils
+   Copyright   :  2009 Balazs Komuves, 2013 shelarcy
+   License     :  BSD-style
+
+   Maintainer  :  shelarcy@gmail.com
+   Stability   :  Provisional
+   Portability :  Non-portable (Win32 API)
+
+   Utilities for calling Win32 API
+-}
+module System.Win32.WindowsString.Utils
+  ( module System.Win32.WindowsString.Utils
+  , module System.Win32.Utils
+  ) where
+
+import Foreign.C.Types             ( CInt )
+import Foreign.Marshal.Array       ( allocaArray )
+import Foreign.Ptr                 ( nullPtr )
+
+import System.Win32.Utils hiding
+  ( try
+  , tryWithoutNull
+  , trySized
+  )
+import System.Win32.WindowsString.String         ( LPTSTR, peekTString, peekTStringLen
+                                   , withTStringBufferLen )
+import System.Win32.WindowsString.Types          ( UINT
+                                   , failIfZero
+                                  )
+import qualified System.Win32.WindowsString.Types ( try )
+import System.OsString.Windows
+
+
+-- | 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.
+try :: String -> (LPTSTR -> UINT -> IO UINT) -> UINT -> IO WindowsString
+try = System.Win32.WindowsString.Types.try
+{-# INLINE try #-}
+
+tryWithoutNull :: String -> (LPTSTR -> UINT -> IO UINT) -> UINT -> IO WindowsString
+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
+            str <- peekTString lptstr
+            return (Right str)
+   case e of
+        Left r'   -> tryWithoutNull 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 WindowsString
+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

@@ -1,5 +1,5 @@ name:           Win32-version:        2.13.2.1+version:        2.13.3.0 license:        BSD3 license-file:   LICENSE author:         Alastair Reid, shelarcy, Tamar Christina@@ -28,7 +28,12 @@         build-depends: unbuildable<0         buildable: False -    build-depends:      base >= 4.5 && < 5, filepath+    build-depends:      base >= 4.5 && < 5++    -- AFPP support+    if impl(ghc >= 8.0)+        build-depends:      filepath    >= 1.4.100.0+     -- Black list hsc2hs 0.68.6 which is horribly broken.     build-tool-depends: hsc2hs:hsc2hs > 0 && < 0.68.6 || > 0.68.6     ghc-options:        -Wall -fno-warn-name-shadowing@@ -102,6 +107,35 @@         System.Win32.Thread         System.Win32.Utils         System.Win32.Word++    -- AFPP support+    if impl(ghc >= 8.0)+        exposed-modules:+            System.Win32.WindowsString.Types+            System.Win32.WindowsString.DebugApi+            System.Win32.WindowsString.DLL+            System.Win32.WindowsString.Shell+            System.Win32.WindowsString.String+            System.Win32.WindowsString.File+            System.Win32.WindowsString.Time+            System.Win32.WindowsString.Info+            System.Win32.WindowsString.FileMapping+            System.Win32.WindowsString.HardLink+            System.Win32.WindowsString.Path+            System.Win32.WindowsString.SymbolicLink+            System.Win32.WindowsString.Utils++    other-modules:+        System.Win32.DebugApi.Internal+        System.Win32.DLL.Internal+        System.Win32.File.Internal+        System.Win32.FileMapping.Internal+        System.Win32.HardLink.Internal+        System.Win32.Info.Internal+        System.Win32.Path.Internal+        System.Win32.Shell.Internal+        System.Win32.SymbolicLink.Internal+        System.Win32.Time.Internal      extra-libraries:         "user32", "gdi32", "winmm", "advapi32", "shell32", "shfolder", "shlwapi", "msimg32", "imm32"

@@ -1,5 +1,9 @@ # Changelog for [`Win32` package](http://hackage.haskell.org/package/Win32) +## 2.13.3.0 July 2022++* Add AFPP support (see #198)+ ## 2.13.2.1 July 2022  * Add function `createIcon` (see #194)