{-# LINE 1 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
{-# LINE 2 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
{-# LANGUAGE Safe #-}
{-# LINE 6 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
module System.Win32.Time where
import System.Win32.String ( peekTStringLen, withTString )
import System.Win32.Types ( BOOL, DDWORD, DWORD, HANDLE, LARGE_INTEGER, LCID
, LONG, LPCTSTR, LPCWSTR, LPTSTR, LPWSTR, UINT, WORD
, dwordsToDdword, ddwordToDwords, failIf
, failIfFalse_, failIf_ )
import System.Win32.Utils ( trySized )
import Control.Monad ( when, liftM3, liftM )
import Data.Word ( Word8 )
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 Foreign.Marshal.Utils (maybeWith)
#include "windows_cconv.h"
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)
instance Storable FILETIME where
sizeOf = const ((8))
{-# LINE 74 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
alignment _ = 4
{-# LINE 75 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
poke buf (FILETIME n) = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) buf low
{-# LINE 77 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) buf hi
{-# LINE 78 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
where (hi,low) = ddwordToDwords n
peek buf = do
low <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) buf
{-# LINE 81 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
hi <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) buf
{-# LINE 82 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
return $ FILETIME $ dwordsToDdword (hi,low)
instance Storable SYSTEMTIME where
sizeOf _ = (16)
{-# LINE 86 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
alignment _ = 2
{-# LINE 87 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
poke buf st = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) buf (wYear st)
{-# LINE 89 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 2)) buf (wMonth st)
{-# LINE 90 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) buf (wDayOfWeek st)
{-# LINE 91 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 6)) buf (wDay st)
{-# LINE 92 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) buf (wHour st)
{-# LINE 93 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 10)) buf (wMinute st)
{-# LINE 94 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 12)) buf (wSecond st)
{-# LINE 95 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 14)) buf (wMilliseconds st)
{-# LINE 96 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
peek buf = do
year <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) buf
{-# LINE 98 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
month <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) buf
{-# LINE 99 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
dow <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) buf
{-# LINE 100 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
day <- ((\hsc_ptr -> peekByteOff hsc_ptr 6)) buf
{-# LINE 101 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
hour <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) buf
{-# LINE 102 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
mins <- ((\hsc_ptr -> peekByteOff hsc_ptr 10)) buf
{-# LINE 103 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
sec <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) buf
{-# LINE 104 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
ms <- ((\hsc_ptr -> peekByteOff hsc_ptr 14)) buf
{-# LINE 105 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
return $ SYSTEMTIME year month dow day hour mins sec ms
instance Storable TIME_ZONE_INFORMATION where
sizeOf _ = ((172))
{-# LINE 109 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
alignment _ = 4
{-# LINE 110 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
poke buf tzi = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) buf (tziBias tzi)
{-# LINE 112 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 68)) buf (tziStandardDate tzi)
{-# LINE 113 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 84)) buf (tziStandardBias tzi)
{-# LINE 114 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 152)) buf (tziDaylightDate tzi)
{-# LINE 115 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 168)) buf (tziDaylightBias tzi)
{-# LINE 116 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
write buf ((4)) (tziStandardName tzi)
{-# LINE 117 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
write buf ((88)) (tziDaylightName tzi)
{-# LINE 118 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
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 <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) buf
{-# LINE 129 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
sdat <- ((\hsc_ptr -> peekByteOff hsc_ptr 68)) buf
{-# LINE 130 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
sbia <- ((\hsc_ptr -> peekByteOff hsc_ptr 84)) buf
{-# LINE 131 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
ddat <- ((\hsc_ptr -> peekByteOff hsc_ptr 152)) buf
{-# LINE 132 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
dbia <- ((\hsc_ptr -> peekByteOff hsc_ptr 168)) buf
{-# LINE 133 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
snam <- peekCWString (plusPtr buf ((4)))
{-# LINE 134 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
dnam <- peekCWString (plusPtr buf ((88)))
{-# LINE 135 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
return $ TIME_ZONE_INFORMATION bias snam sdat sbia dnam ddat dbia
instance Storable LASTINPUTINFO where
sizeOf = const ((8))
{-# LINE 139 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
alignment = sizeOf
poke buf (LASTINPUTINFO t) = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) buf (((8)) :: UINT)
{-# LINE 142 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) buf t
{-# LINE 143 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
peek buf = do
t <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) buf
{-# LINE 145 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
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" $
c_GetSystemTimeAdjustment ta ti enabled
enabled' <- peek enabled
if enabled'
then do
ta' <- peek ta
ti' <- peek ti
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
failIfFalse_ "GetLastInputInfo" $ c_GetLastInputInfo lii_p
LASTINPUTINFO lii <- peek lii_p
return lii
getIdleTime :: IO Integer
getIdleTime = do
lii <- getLastInputInfo
now <- getTickCount
return $ fromIntegral $ now - lii
foreign import WINDOWS_CCONV "windows.h SetSystemTimeAdjustment"
c_SetSystemTimeAdjustment :: DWORD -> BOOL -> IO BOOL
setSystemTimeAdjustment :: Maybe Int -> IO ()
setSystemTimeAdjustment ta =
failIf_ not "setSystemTimeAjustment: SetSystemTimeAdjustment" $
c_SetSystemTimeAdjustment time disabled
where
(time,disabled) = case ta of
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 (==(4294967295)) "getTimeZoneInformation: GetTimeZoneInformation" $
{-# LINE 227 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
c_GetTimeZoneInformation tzi
tzi' <- peek tzi
return . flip (,) tzi' $ case tz of
(0) -> TzIdUnknown
{-# LINE 231 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
(1) -> TzIdStandard
{-# LINE 232 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
(2) -> TzIdDaylight
{-# LINE 233 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
_ -> TzIdUnknown
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
liftM3 (,,) (peek crt) (peek acc) (peek wrt)
foreign import WINDOWS_CCONV "windows.h SetFileTime"
c_SetFileTime :: HANDLE -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> IO BOOL
setFileTime :: HANDLE -> FILETIME -> FILETIME -> FILETIME -> IO ()
setFileTime h crt acc wrt = with crt $
\c_crt -> with acc $
\c_acc -> with wrt $
\c_wrt -> do
failIf_ not "setFileTime: SetFileTime" $ c_SetFileTime h c_crt c_acc c_wrt
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"
$ c_LocalFileTimeToFileTime c_ft res
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
lOCALE_NOUSEROVERRIDE :: GetTimeFormatFlags
lOCALE_NOUSEROVERRIDE = 2147483648
lOCALE_USE_CP_ACP :: GetTimeFormatFlags
lOCALE_USE_CP_ACP = 1073741824
tIME_NOMINUTESORSECONDS :: GetTimeFormatFlags
tIME_NOMINUTESORSECONDS = 1
tIME_NOSECONDS :: GetTimeFormatFlags
tIME_NOSECONDS = 2
tIME_NOTIMEMARKER :: GetTimeFormatFlags
tIME_NOTIMEMARKER = 4
tIME_FORCE24HOURFORMAT :: GetTimeFormatFlags
tIME_FORCE24HOURFORMAT = 8
{-# LINE 337 "libraries\\Win32\\System\\Win32\\Time.hsc" #-}
getTimeFormatEx :: Maybe String
-> GetTimeFormatFlags
-> Maybe SYSTEMTIME
-> Maybe String
-> IO String
getTimeFormatEx locale flags st fmt =
maybeWith withTString locale $ \c_locale ->
maybeWith with st $ \c_st ->
maybeWith withTString fmt $ \c_fmt -> do
let c_func = c_GetTimeFormatEx c_locale flags c_st c_fmt
trySized "GetTimeFormatEx" c_func
foreign import WINDOWS_CCONV "windows.h GetTimeFormatEx"
c_GetTimeFormatEx :: LPCWSTR
-> GetTimeFormatFlags
-> Ptr SYSTEMTIME
-> LPCWSTR
-> LPWSTR
-> CInt
-> IO CInt
foreign import WINDOWS_CCONV "windows.h GetTimeFormatW"
c_GetTimeFormat :: LCID -> GetTimeFormatFlags -> Ptr SYSTEMTIME -> LPCTSTR -> LPTSTR -> CInt -> IO CInt
getTimeFormat :: LCID -> GetTimeFormatFlags -> Maybe SYSTEMTIME -> Maybe String -> IO String
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')