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

{-# LANGUAGE CPP #-}

{- |

   Module      :  System.Win32.Info.Computer

   Copyright   :  2012-2013 shelarcy

   License     :  BSD-style



   Maintainer  :  shelarcy@gmail.com

   Stability   :  Provisional

   Portability :  Non-portable (Win32 API)



   Information about your computer.

-}

module System.Win32.Info.Computer

  ( -- * Environment Strings

    expandEnvironmentStrings, c_ExpandEnvironmentStrings



    -- * Computer Name

  , getComputerName, setComputerName

  , c_GetComputerName, c_SetComputerName



    -- * System metrics

  , getSystemMetrics

  , sM_CMONITORS

  , sM_IMMENABLED

  , sM_MOUSEWHEELPRESENT

  , sM_REMOTESESSION

  , sM_SAMEDISPLAYFORMAT

  , sM_XVIRTUALSCREEN

  , sM_YVIRTUALSCREEN

  , sM_SERVERR2

  , sM_MEDIACENTER

  , sM_STARTER

  , sM_TABLETPC



  -- * User name

  , getUserName, c_GetUserName



  -- * Version Info

  , OSVERSIONINFOEX(..), POSVERSIONINFOEX, LPOSVERSIONINFOEX

  , ProductType(..)

  , getVersionEx, c_GetVersionEx



  -- * Processor features

  , ProcessorFeature

  , isProcessorFeaturePresent

  , pF_3DNOW_INSTRUCTIONS_AVAILABLE

  , pF_COMPARE_EXCHANGE_DOUBLE

  , pF_FLOATING_POINT_EMULATED

  , pF_FLOATING_POINT_PRECISION_ERRATA

  , pF_MMX_INSTRUCTIONS_AVAILABLE

  , pF_PAE_ENABLED

  , pF_RDTSC_INSTRUCTION_AVAILABLE

  , pF_XMMI_INSTRUCTIONS_AVAILABLE

  , pF_XMMI64_INSTRUCTIONS_AVAILABLE

  ) where



import Foreign.Marshal.Utils ( with )

import Foreign.Storable      ( Storable(..) )

import System.Win32.Info     ( SMSetting )

import System.Win32.Info.Version

import System.Win32.String   ( LPCTSTR, LPTSTR, withTString, withTStringBuffer

                             , peekTString, peekTStringLen )

import System.Win32.Types    ( BOOL, failIfFalse_ )

import System.Win32.Utils    ( tryWithoutNull )

import System.Win32.Word     ( DWORD, LPDWORD )









#include "windows_cconv.h"



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

-- Environment Strings

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

expandEnvironmentStrings :: String -> IO String

expandEnvironmentStrings name =

  withTString name $ \ c_name ->

    tryWithoutNull (unwords ["ExpandEnvironmentStrings", name])

      (\buf len -> c_ExpandEnvironmentStrings c_name buf len) 512



foreign import WINDOWS_CCONV unsafe "windows.h ExpandEnvironmentStringsW"

  c_ExpandEnvironmentStrings :: LPCTSTR -> LPTSTR -> DWORD -> IO DWORD



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

-- Computer Name

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



getComputerName :: IO String

getComputerName =

  withTStringBuffer  maxLength  $ \buf ->

  with (fromIntegral maxLength) $ \len -> do

      failIfFalse_ "GetComputerName"

        $ c_GetComputerName buf len

      len' <- peek len

      peekTStringLen (buf, (fromIntegral len'))

  where

    maxLength = 15

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



foreign import WINDOWS_CCONV unsafe "GetComputerNameW"

  c_GetComputerName :: LPTSTR -> LPDWORD -> IO Bool



setComputerName :: String -> IO ()

setComputerName name =

  withTString name $ \buf ->

      failIfFalse_ (unwords ["SetComputerName", name])

        $ c_SetComputerName buf



foreign import WINDOWS_CCONV unsafe "SetComputerNameW"

  c_SetComputerName :: LPTSTR -> IO Bool

{-

type COMPUTER_NAME_FORMAT = UINT

{enum COMPUTER_NAME_FORMAT,

 , computerNameNetBIOS                   = ComputerNameNetBIOS

 , computerNameDnsHostname               = ComputerNameDnsHostname

 , computerNameDnsDomain                 = ComputerNameDnsDomain

 , computerNameDnsFullyQualified         = ComputerNameDnsFullyQualified

 , computerNamePhysicalNetBIOS           = ComputerNamePhysicalNetBIOS

 , computerNamePhysicalDnsHostname       = ComputerNamePhysicalDnsHostname

 , computerNamePhysicalDnsDomain         = ComputerNamePhysicalDnsFullyQualified

 , computerNamePhysicalDnsFullyQualified = ComputerNamePhysicalDnsFullyQualified

 , computerNameMax                       = ComputerNameMax

 }

-}



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

-- Hardware Profiles

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

{-

-- TODO: Deside HW_PROFILE_INFO type design



type LPHW_PROFILE_INFO = Ptr HW_PROFILE_INFO



data HW_PROFILE_INFO = HW_PROFILE_INFO

     { dwDockInfo       :: DWORD

     , szHwProfileGuid  :: String -- Should we use GUID type instead of String?

     , szHwProfileName  :: String

     } deriving Show



instance Storable HW_PROFILE_INFO where

    sizeOf = const #{size HW_PROFILE_INFOW}

    alignment _ = #alignment HW_PROFILE_INFOW

    poke buf info = do

        (#poke HW_PROFILE_INFOW, dwDockInfo) buf (dwDockInfo info)

        withTString (szHwProfileGuid info) $ \szHwProfileGuid' ->

          (#poke HW_PROFILE_INFOW, szHwProfileGuid) buf szHwProfileGuid'

        withTString (szHwProfileName info) $ \szHwProfileName' ->

          (#poke HW_PROFILE_INFOW, szHwProfileName) buf szHwProfileName'



    peek buf = do

        dockInfo       <- (#peek HW_PROFILE_INFOW, dwDockInfo) buf

        hwProfileGuid  <- peekTString $ (#ptr HW_PROFILE_INFOW, szHwProfileGuid) buf

        hwProfileName  <- peekTString $ (#ptr HW_PROFILE_INFOW, szHwProfileName) buf

        return $ HW_PROFILE_INFO dockInfo hwProfileGuid hwProfileName



getCurrentHwProfile :: IO HW_PROFILE_INFO

getCurrentHwProfile =

  alloca $ \buf -> do

    failIfFalse_ "GetCurrentHwProfile"

      $ c_GetCurrentHwProfile buf

    peek buf



foreign import WINDOWS_CCONV unsafe "windows.h GetCurrentHwProfileW"

  c_GetCurrentHwProfile :: LPHW_PROFILE_INFO -> IO Bool

-}



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

-- System metrics

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



foreign import WINDOWS_CCONV unsafe "windows.h GetSystemMetrics"

  getSystemMetrics :: SMSetting -> IO Int



sM_CMONITORS            :: SMSetting

sM_CMONITORS            =  80

sM_IMMENABLED           :: SMSetting

sM_IMMENABLED           =  82

sM_MOUSEWHEELPRESENT    :: SMSetting

sM_MOUSEWHEELPRESENT    =  75

sM_REMOTESESSION        :: SMSetting

sM_REMOTESESSION        =  4096

sM_SAMEDISPLAYFORMAT    :: SMSetting

sM_SAMEDISPLAYFORMAT    =  81

sM_XVIRTUALSCREEN       :: SMSetting

sM_XVIRTUALSCREEN       =  76

sM_YVIRTUALSCREEN       :: SMSetting

sM_YVIRTUALSCREEN       =  77

sM_SERVERR2             :: SMSetting

sM_SERVERR2             =  89

sM_MEDIACENTER          :: SMSetting

sM_MEDIACENTER          =  87

sM_STARTER              :: SMSetting

sM_STARTER              =  88

sM_TABLETPC             :: SMSetting

sM_TABLETPC             =  86



{-# LINE 186 "System\\Win32\\Info\\Computer.hsc" #-}



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

-- User name

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



-- | Get user name. See: <https://github.com/haskell/win32/issues/8>, <http://lpaste.net/41521>

getUserName :: IO String

getUserName =

  withTStringBuffer  maxLength  $ \buf ->

  with (fromIntegral maxLength) $ \len -> do

      failIfFalse_ "GetComputerName"

        $ c_GetUserName buf len

      -- GetUserNameW includes NUL charactor.

      peekTString buf

  where

    -- This requires Lmcons.h

    maxLength = 256

{-# LINE 203 "System\\Win32\\Info\\Computer.hsc" #-}



foreign import WINDOWS_CCONV unsafe "windows.h GetUserNameW"

  c_GetUserName :: LPTSTR -> LPDWORD -> IO Bool



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

-- Processor features

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



foreign import WINDOWS_CCONV unsafe "windows.h IsProcessorFeaturePresent"

  isProcessorFeaturePresent :: ProcessorFeature -> IO BOOL



type ProcessorFeature   = DWORD



pF_3DNOW_INSTRUCTIONS_AVAILABLE      :: ProcessorFeature

pF_3DNOW_INSTRUCTIONS_AVAILABLE      =  7

pF_COMPARE_EXCHANGE_DOUBLE           :: ProcessorFeature

pF_COMPARE_EXCHANGE_DOUBLE           =  2

pF_FLOATING_POINT_EMULATED           :: ProcessorFeature

pF_FLOATING_POINT_EMULATED           =  1

pF_FLOATING_POINT_PRECISION_ERRATA   :: ProcessorFeature

pF_FLOATING_POINT_PRECISION_ERRATA   =  0

pF_MMX_INSTRUCTIONS_AVAILABLE        :: ProcessorFeature

pF_MMX_INSTRUCTIONS_AVAILABLE        =  3

pF_PAE_ENABLED                       :: ProcessorFeature

pF_PAE_ENABLED                       =  9

pF_RDTSC_INSTRUCTION_AVAILABLE       :: ProcessorFeature

pF_RDTSC_INSTRUCTION_AVAILABLE       =  8

pF_XMMI_INSTRUCTIONS_AVAILABLE       :: ProcessorFeature

pF_XMMI_INSTRUCTIONS_AVAILABLE       =  6

pF_XMMI64_INSTRUCTIONS_AVAILABLE     :: ProcessorFeature

pF_XMMI64_INSTRUCTIONS_AVAILABLE     =  10



{-# LINE 227 "System\\Win32\\Info\\Computer.hsc" #-}



{-

 , pF_CHANNELS_ENABLED                 = PF_CHANNELS_ENABLED

 , pF_NX_ENABLED                       = PF_NX_ENABLED

 , pF_COMPARE_EXCHANGE128              = PF_COMPARE_EXCHANGE128

 , pF_COMPARE64_EXCHANGE128            = PF_COMPARE64_EXCHANGE128

 , pF_SECOND_LEVEL_ADDRESS_TRANSLATION = PF_SECOND_LEVEL_ADDRESS_TRANSLATION

 , pF_SSE3_INSTRUCTIONS_AVAILABLE      = PF_SSE3_INSTRUCTIONS_AVAILABLE

 , pF_VIRT_FIRMWARE_ENABLED            = PF_VIRT_FIRMWARE_ENABLED

 , pF_XSAVE_ENABLED                    = PF_XSAVE_ENABLED

-}