dist-install\build\System\Win32\Info.hs

    {-# 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 <ei@vuokko.info>
    -- 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)
    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 -> String -> IO (Maybe FilePath)
    searchPath path filename ext =
      maybe ($ nullPtr) withTString path $ \p_path ->
      withTString filename $ \p_filename ->
      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
    ----------------------------------------------------------------