{-# LINE 1 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}

{-# LINE 2 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
{-# LANGUAGE Safe #-}

{-# LINE 6 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
-----------------------------------------------------------------------------

-- |

-- Module      :  System.Win32.Info

-- Copyright   :  (c) Alastair Reid, 1997-2003

-- License     :  BSD-style (see the file libraries/base/LICENSE)

--

-- Maintainer  :  Esa Ilari Vuokko <[email protected]>

-- Stability   :  provisional

-- Portability :  portable

--

-- A collection of FFI declarations for interfacing with Win32.

--

-----------------------------------------------------------------------------


module System.Win32.Info where

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.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)


{-# LINE 35 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}

#include "windows_cconv.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.


cOLOR_SCROLLBAR       :: SystemColor
cOLOR_SCROLLBAR       =  0
cOLOR_BACKGROUND      :: SystemColor
cOLOR_BACKGROUND      =  1
cOLOR_ACTIVECAPTION   :: SystemColor
cOLOR_ACTIVECAPTION   =  2
cOLOR_INACTIVECAPTION  :: SystemColor
cOLOR_INACTIVECAPTION  =  3
cOLOR_MENU            :: SystemColor
cOLOR_MENU            =  4
cOLOR_WINDOW          :: SystemColor
cOLOR_WINDOW          =  5
cOLOR_WINDOWFRAME     :: SystemColor
cOLOR_WINDOWFRAME     =  6
cOLOR_MENUTEXT        :: SystemColor
cOLOR_MENUTEXT        =  7
cOLOR_WINDOWTEXT      :: SystemColor
cOLOR_WINDOWTEXT      =  8
cOLOR_CAPTIONTEXT     :: SystemColor
cOLOR_CAPTIONTEXT     =  9
cOLOR_ACTIVEBORDER    :: SystemColor
cOLOR_ACTIVEBORDER    =  10
cOLOR_INACTIVEBORDER  :: SystemColor
cOLOR_INACTIVEBORDER  =  11
cOLOR_APPWORKSPACE    :: SystemColor
cOLOR_APPWORKSPACE    =  12
cOLOR_HIGHLIGHT       :: SystemColor
cOLOR_HIGHLIGHT       =  13
cOLOR_HIGHLIGHTTEXT   :: SystemColor
cOLOR_HIGHLIGHTTEXT   =  14
cOLOR_BTNFACE         :: SystemColor
cOLOR_BTNFACE         =  15
cOLOR_BTNSHADOW       :: SystemColor
cOLOR_BTNSHADOW       =  16
cOLOR_GRAYTEXT        :: SystemColor
cOLOR_GRAYTEXT        =  17
cOLOR_BTNTEXT         :: SystemColor
cOLOR_BTNTEXT         =  18
cOLOR_INACTIVECAPTIONTEXT  :: SystemColor
cOLOR_INACTIVECAPTIONTEXT  =  19
cOLOR_BTNHIGHLIGHT    :: SystemColor
cOLOR_BTNHIGHLIGHT    =  20

{-# LINE 98 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}

-- %fun GetSysColor :: SystemColor -> IO COLORREF

-- %fun SetSysColors :: [(SystemColor,COLORREF)] -> IO ()


----------------------------------------------------------------

-- Standard Directories

----------------------------------------------------------------


getSystemDirectory :: IO String
getSystemDirectory = try "GetSystemDirectory" c_getSystemDirectory 512

getWindowsDirectory :: IO String
getWindowsDirectory = try "GetWindowsDirectory" c_getWindowsDirectory 512

getCurrentDirectory :: IO String
getCurrentDirectory = try "GetCurrentDirectory" (flip c_getCurrentDirectory) 512
getTemporaryDirectory :: IO String
getTemporaryDirectory = try "GetTempPath" (flip c_getTempPath) 512

getFullPathName :: FilePath -> IO FilePath
getFullPathName name = do
  withTString name $ \ c_name ->
    try "getFullPathName"
      (\buf len -> c_GetFullPathName c_name len buf nullPtr) 512

getLongPathName :: FilePath -> IO FilePath
getLongPathName name = do
  withTString name $ \ c_name ->
    try "getLongPathName"
      (c_GetLongPathName c_name) 512

getShortPathName :: FilePath -> IO FilePath
getShortPathName name = do
  withTString name $ \ c_name ->
    try "getShortPathName"
      (c_GetShortPathName c_name) 512

searchPath :: Maybe String -> FilePath -> Maybe String -> IO (Maybe FilePath)
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

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     -> 0
{-# LINE 186 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
        PaMips      -> 1
{-# LINE 187 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
        PaAlpha     -> 2
{-# LINE 188 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
        PaPpc       -> 3
{-# LINE 189 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
        PaIa64      -> 6
{-# LINE 190 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}

{-# LINE 191 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
        PaIa32OnIa64 -> 10
{-# LINE 192 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}

{-# LINE 193 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
        PaAmd64     -> 9
{-# LINE 194 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
    peek buf = do
        v <- (peekByteOff buf 0:: IO WORD)
        return $ case v of
            (0) -> PaIntel
{-# LINE 198 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
            (1)  -> PaMips
{-# LINE 199 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
            (2) -> PaAlpha
{-# LINE 200 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
            (3)   -> PaPpc
{-# LINE 201 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
            (6)  -> PaIa64
{-# LINE 202 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}

{-# LINE 203 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
            (10) -> PaIa32OnIa64
{-# LINE 204 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}

{-# LINE 205 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
            (9) -> PaAmd64
{-# LINE 206 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
            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 (48)
{-# LINE 222 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
    alignment _ = 8
{-# LINE 223 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
    poke buf si = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) buf (siProcessorArchitecture si)
{-# LINE 225 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 4))             buf (siPageSize si)
{-# LINE 226 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) buf (siMinimumApplicationAddress si)
{-# LINE 227 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) buf (siMaximumApplicationAddress si)
{-# LINE 228 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 24))  buf (siActiveProcessorMask si)
{-# LINE 229 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 32))   buf (siNumberOfProcessors si)
{-# LINE 230 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 36))        buf (siProcessorType si)
{-# LINE 231 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 40)) buf (siAllocationGranularity si)
{-# LINE 232 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 44))        buf (siProcessorLevel si)
{-# LINE 233 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 46))     buf (siProcessorRevision si)
{-# LINE 234 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}

    peek buf = do
        processorArchitecture <-
            ((\hsc_ptr -> peekByteOff hsc_ptr 0)) buf
{-# LINE 238 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
        pageSize            <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) buf
{-# LINE 239 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
        minimumApplicationAddress <-
            ((\hsc_ptr -> peekByteOff hsc_ptr 8)) buf
{-# LINE 241 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
        maximumApplicationAddress <-
            ((\hsc_ptr -> peekByteOff hsc_ptr 16)) buf
{-# LINE 243 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
        activeProcessorMask <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) buf
{-# LINE 244 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
        numberOfProcessors  <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) buf
{-# LINE 245 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
        processorType       <- ((\hsc_ptr -> peekByteOff hsc_ptr 36)) buf
{-# LINE 246 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
        allocationGranularity <-
            ((\hsc_ptr -> peekByteOff hsc_ptr 40)) buf
{-# LINE 248 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
        processorLevel      <- ((\hsc_ptr -> peekByteOff hsc_ptr 44)) buf
{-# LINE 249 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
        processorRevision   <- ((\hsc_ptr -> peekByteOff hsc_ptr 46)) buf
{-# LINE 250 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}
        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

sM_ARRANGE            :: SMSetting
sM_ARRANGE            =  56
sM_CLEANBOOT          :: SMSetting
sM_CLEANBOOT          =  67
sM_CMETRICS           :: SMSetting
sM_CMETRICS           =  97
sM_CMOUSEBUTTONS      :: SMSetting
sM_CMOUSEBUTTONS      =  43
sM_CXBORDER           :: SMSetting
sM_CXBORDER           =  5
sM_CYBORDER           :: SMSetting
sM_CYBORDER           =  6
sM_CXCURSOR           :: SMSetting
sM_CXCURSOR           =  13
sM_CYCURSOR           :: SMSetting
sM_CYCURSOR           =  14
sM_CXDLGFRAME         :: SMSetting
sM_CXDLGFRAME         =  7
sM_CYDLGFRAME         :: SMSetting
sM_CYDLGFRAME         =  8
sM_CXDOUBLECLK        :: SMSetting
sM_CXDOUBLECLK        =  36
sM_CYDOUBLECLK        :: SMSetting
sM_CYDOUBLECLK        =  37
sM_CXDRAG             :: SMSetting
sM_CXDRAG             =  68
sM_CYDRAG             :: SMSetting
sM_CYDRAG             =  69
sM_CXEDGE             :: SMSetting
sM_CXEDGE             =  45
sM_CYEDGE             :: SMSetting
sM_CYEDGE             =  46
sM_CXFRAME            :: SMSetting
sM_CXFRAME            =  32
sM_CYFRAME            :: SMSetting
sM_CYFRAME            =  33
sM_CXFULLSCREEN       :: SMSetting
sM_CXFULLSCREEN       =  16
sM_CYFULLSCREEN       :: SMSetting
sM_CYFULLSCREEN       =  17
sM_CXHSCROLL          :: SMSetting
sM_CXHSCROLL          =  21
sM_CYVSCROLL          :: SMSetting
sM_CYVSCROLL          =  20
sM_CXICON             :: SMSetting
sM_CXICON             =  11
sM_CYICON             :: SMSetting
sM_CYICON             =  12
sM_CXICONSPACING      :: SMSetting
sM_CXICONSPACING      =  38
sM_CYICONSPACING      :: SMSetting
sM_CYICONSPACING      =  39
sM_CXMAXIMIZED        :: SMSetting
sM_CXMAXIMIZED        =  61
sM_CYMAXIMIZED        :: SMSetting
sM_CYMAXIMIZED        =  62
sM_CXMENUCHECK        :: SMSetting
sM_CXMENUCHECK        =  71
sM_CYMENUCHECK        :: SMSetting
sM_CYMENUCHECK        =  72
sM_CXMENUSIZE         :: SMSetting
sM_CXMENUSIZE         =  54
sM_CYMENUSIZE         :: SMSetting
sM_CYMENUSIZE         =  55
sM_CXMIN              :: SMSetting
sM_CXMIN              =  28
sM_CYMIN              :: SMSetting
sM_CYMIN              =  29
sM_CXMINIMIZED        :: SMSetting
sM_CXMINIMIZED        =  57
sM_CYMINIMIZED        :: SMSetting
sM_CYMINIMIZED        =  58
sM_CXMINTRACK         :: SMSetting
sM_CXMINTRACK         =  34
sM_CYMINTRACK         :: SMSetting
sM_CYMINTRACK         =  35
sM_CXSCREEN           :: SMSetting
sM_CXSCREEN           =  0
sM_CYSCREEN           :: SMSetting
sM_CYSCREEN           =  1
sM_CXSIZE             :: SMSetting
sM_CXSIZE             =  30
sM_CYSIZE             :: SMSetting
sM_CYSIZE             =  31
sM_CXSIZEFRAME        :: SMSetting
sM_CXSIZEFRAME        =  32
sM_CYSIZEFRAME        :: SMSetting
sM_CYSIZEFRAME        =  33
sM_CXSMICON           :: SMSetting
sM_CXSMICON           =  49
sM_CYSMICON           :: SMSetting
sM_CYSMICON           =  50
sM_CXSMSIZE           :: SMSetting
sM_CXSMSIZE           =  52
sM_CYSMSIZE           :: SMSetting
sM_CYSMSIZE           =  53
sM_CXVSCROLL          :: SMSetting
sM_CXVSCROLL          =  2
sM_CYHSCROLL          :: SMSetting
sM_CYHSCROLL          =  3
sM_CYVTHUMB           :: SMSetting
sM_CYVTHUMB           =  9
sM_CYCAPTION          :: SMSetting
sM_CYCAPTION          =  4
sM_CYKANJIWINDOW      :: SMSetting
sM_CYKANJIWINDOW      =  18
sM_CYMENU             :: SMSetting
sM_CYMENU             =  15
sM_CYSMCAPTION        :: SMSetting
sM_CYSMCAPTION        =  51
sM_DBCSENABLED        :: SMSetting
sM_DBCSENABLED        =  42
sM_DEBUG              :: SMSetting
sM_DEBUG              =  22
sM_MENUDROPALIGNMENT  :: SMSetting
sM_MENUDROPALIGNMENT  =  40
sM_MIDEASTENABLED     :: SMSetting
sM_MIDEASTENABLED     =  74
sM_MOUSEPRESENT       :: SMSetting
sM_MOUSEPRESENT       =  19
sM_NETWORK            :: SMSetting
sM_NETWORK            =  63
sM_PENWINDOWS         :: SMSetting
sM_PENWINDOWS         =  41
sM_SECURE             :: SMSetting
sM_SECURE             =  44
sM_SHOWSOUNDS         :: SMSetting
sM_SHOWSOUNDS         =  70
sM_SLOWMACHINE        :: SMSetting
sM_SLOWMACHINE        =  73
sM_SWAPBUTTON         :: SMSetting
sM_SWAPBUTTON         =  23

{-# LINE 345 "libraries\\Win32\\System\\Win32\\Info.hsc" #-}

-- %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

getUserName :: IO String
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

----------------------------------------------------------------