{-# 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
    ( SystemColor
    , cOLOR_SCROLLBAR
    , cOLOR_BACKGROUND
    , cOLOR_ACTIVECAPTION
    , cOLOR_INACTIVECAPTION
    , cOLOR_MENU
    , cOLOR_WINDOW
    , cOLOR_WINDOWFRAME
    , cOLOR_MENUTEXT
    , cOLOR_WINDOWTEXT
    , cOLOR_CAPTIONTEXT
    , cOLOR_ACTIVEBORDER
    , cOLOR_INACTIVEBORDER
    , cOLOR_APPWORKSPACE
    , cOLOR_HIGHLIGHT
    , cOLOR_HIGHLIGHTTEXT
    , cOLOR_BTNFACE
    , cOLOR_BTNSHADOW
    , cOLOR_GRAYTEXT
    , cOLOR_BTNTEXT
    , cOLOR_INACTIVECAPTIONTEXT
    , cOLOR_BTNHIGHLIGHT

      -- * Standard directories

    , getSystemDirectory
    , getWindowsDirectory
    , getCurrentDirectory
    , getTemporaryDirectory
    , getFullPathName
    , getLongPathName
    , getShortPathName
    , searchPath

      -- * System information

    , ProcessorArchitecture(..)
    , SYSTEM_INFO(..)
    , getSystemInfo

      -- * System metrics

    , SMSetting
    , sM_ARRANGE
    , sM_CLEANBOOT
    , sM_CMETRICS
    , sM_CMOUSEBUTTONS
    , sM_CXBORDER
    , sM_CYBORDER
    , sM_CXCURSOR
    , sM_CYCURSOR
    , sM_CXDLGFRAME
    , sM_CYDLGFRAME
    , sM_CXDOUBLECLK
    , sM_CYDOUBLECLK
    , sM_CXDRAG
    , sM_CYDRAG
    , sM_CXEDGE
    , sM_CYEDGE
    , sM_CXFRAME
    , sM_CYFRAME
    , sM_CXFULLSCREEN
    , sM_CYFULLSCREEN
    , sM_CXHSCROLL
    , sM_CYVSCROLL
    , sM_CXICON
    , sM_CYICON
    , sM_CXICONSPACING
    , sM_CYICONSPACING
    , sM_CXMAXIMIZED
    , sM_CYMAXIMIZED
    , sM_CXMENUCHECK
    , sM_CYMENUCHECK
    , sM_CXMENUSIZE
    , sM_CYMENUSIZE
    , sM_CXMIN
    , sM_CYMIN
    , sM_CXMINIMIZED
    , sM_CYMINIMIZED
    , sM_CXMINTRACK
    , sM_CYMINTRACK
    , sM_CXSCREEN
    , sM_CYSCREEN
    , sM_CXSIZE
    , sM_CYSIZE
    , sM_CXSIZEFRAME
    , sM_CYSIZEFRAME
    , sM_CXSMICON
    , sM_CYSMICON
    , sM_CXSMSIZE
    , sM_CYSMSIZE
    , sM_CXVSCROLL
    , sM_CYHSCROLL
    , sM_CYVTHUMB
    , sM_CYCAPTION
    , sM_CYKANJIWINDOW
    , sM_CYMENU
    , sM_CYSMCAPTION
    , sM_DBCSENABLED
    , sM_DEBUG
    , sM_MENUDROPALIGNMENT
    , sM_MIDEASTENABLED
    , sM_MOUSEPRESENT
    , sM_NETWORK
    , sM_PENWINDOWS
    , sM_SECURE
    , sM_SHOWSOUNDS
    , sM_SLOWMACHINE
    , sM_SWAPBUTTON

      -- * User name

    , 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 (nullPtr)
import Foreign.Storable (Storable(..))
import System.IO.Error (isDoesNotExistError)
import System.Win32.Types (failIfFalse_, peekTStringLen, withTString, try)


{-# LINE 145 "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


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

-- Standard Directories

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


getSystemDirectory :: IO String
getSystemDirectory :: IO String
getSystemDirectory = String -> (LPTSTR -> DWORD -> IO DWORD) -> DWORD -> IO String
try String
"GetSystemDirectory" LPTSTR -> DWORD -> IO DWORD
c_getSystemDirectory DWORD
512

getWindowsDirectory :: IO String
getWindowsDirectory :: IO String
getWindowsDirectory = String -> (LPTSTR -> DWORD -> IO DWORD) -> DWORD -> IO String
try String
"GetWindowsDirectory" LPTSTR -> DWORD -> IO DWORD
c_getWindowsDirectory DWORD
512

getCurrentDirectory :: IO String
getCurrentDirectory :: IO String
getCurrentDirectory = String -> (LPTSTR -> DWORD -> IO DWORD) -> DWORD -> IO String
try String
"GetCurrentDirectory" ((DWORD -> LPTSTR -> IO DWORD) -> LPTSTR -> DWORD -> IO DWORD
forall a b c. (a -> b -> c) -> b -> a -> c
flip DWORD -> LPTSTR -> IO DWORD
c_getCurrentDirectory) DWORD
512

getTemporaryDirectory :: IO String
getTemporaryDirectory :: IO String
getTemporaryDirectory = String -> (LPTSTR -> DWORD -> IO DWORD) -> DWORD -> IO String
try String
"GetTempPath" ((DWORD -> LPTSTR -> IO DWORD) -> LPTSTR -> DWORD -> IO DWORD
forall a b c. (a -> b -> c) -> b -> a -> c
flip DWORD -> LPTSTR -> IO DWORD
c_getTempPath) DWORD
512

getFullPathName :: FilePath -> IO FilePath
getFullPathName :: String -> IO String
getFullPathName String
name = do
  String -> (LPTSTR -> IO String) -> IO String
forall a. String -> (LPTSTR -> IO a) -> IO a
withTString String
name ((LPTSTR -> IO String) -> IO String)
-> (LPTSTR -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \ LPTSTR
c_name ->
    String -> (LPTSTR -> DWORD -> IO DWORD) -> DWORD -> IO String
try String
"getFullPathName"
      (\LPTSTR
buf DWORD
len -> LPTSTR -> DWORD -> LPTSTR -> Ptr LPTSTR -> IO DWORD
c_GetFullPathName LPTSTR
c_name DWORD
len LPTSTR
buf Ptr LPTSTR
forall a. Ptr a
nullPtr) DWORD
512

getLongPathName :: FilePath -> IO FilePath
getLongPathName :: String -> IO String
getLongPathName String
name = do
  String -> (LPTSTR -> IO String) -> IO String
forall a. String -> (LPTSTR -> IO a) -> IO a
withTString String
name ((LPTSTR -> IO String) -> IO String)
-> (LPTSTR -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \ LPTSTR
c_name ->
    String -> (LPTSTR -> DWORD -> IO DWORD) -> DWORD -> IO String
try String
"getLongPathName"
      (LPTSTR -> LPTSTR -> DWORD -> IO DWORD
c_GetLongPathName LPTSTR
c_name) DWORD
512

getShortPathName :: FilePath -> IO FilePath
getShortPathName :: String -> IO String
getShortPathName String
name = do
  String -> (LPTSTR -> IO String) -> IO String
forall a. String -> (LPTSTR -> IO a) -> IO a
withTString String
name ((LPTSTR -> IO String) -> IO String)
-> (LPTSTR -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \ LPTSTR
c_name ->
    String -> (LPTSTR -> DWORD -> IO DWORD) -> DWORD -> IO String
try String
"getShortPathName"
      (LPTSTR -> LPTSTR -> DWORD -> IO DWORD
c_GetShortPathName LPTSTR
c_name) DWORD
512

searchPath :: Maybe String -> FilePath -> Maybe String -> IO (Maybe FilePath)
searchPath :: Maybe String -> String -> Maybe String -> IO (Maybe String)
searchPath Maybe String
path String
filename Maybe String
ext =
  ((LPTSTR -> IO (Maybe String)) -> IO (Maybe String))
-> (String -> (LPTSTR -> IO (Maybe String)) -> IO (Maybe String))
-> Maybe String
-> (LPTSTR -> IO (Maybe String))
-> IO (Maybe String)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((LPTSTR -> IO (Maybe String)) -> LPTSTR -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ LPTSTR
forall a. Ptr a
nullPtr) String -> (LPTSTR -> IO (Maybe String)) -> IO (Maybe String)
forall a. String -> (LPTSTR -> IO a) -> IO a
withTString Maybe String
path ((LPTSTR -> IO (Maybe String)) -> IO (Maybe String))
-> (LPTSTR -> IO (Maybe String)) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ \LPTSTR
p_path ->
  String -> (LPTSTR -> IO (Maybe String)) -> IO (Maybe String)
forall a. String -> (LPTSTR -> IO a) -> IO a
withTString String
filename ((LPTSTR -> IO (Maybe String)) -> IO (Maybe String))
-> (LPTSTR -> IO (Maybe String)) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ \LPTSTR
p_filename ->
  (String -> (LPTSTR -> IO (Maybe String)) -> IO (Maybe String))
-> Maybe String
-> (LPTSTR -> IO (Maybe String))
-> IO (Maybe String)
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith String -> (LPTSTR -> IO (Maybe String)) -> IO (Maybe String)
forall a. String -> (LPTSTR -> IO a) -> IO a
withTString Maybe String
ext      ((LPTSTR -> IO (Maybe String)) -> IO (Maybe String))
-> (LPTSTR -> IO (Maybe String)) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ \LPTSTR
p_ext ->
  (Ptr LPTSTR -> IO (Maybe String)) -> IO (Maybe String)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr LPTSTR -> IO (Maybe String)) -> IO (Maybe String))
-> (Ptr LPTSTR -> IO (Maybe String)) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ \Ptr LPTSTR
ppFilePart -> (do
    s <- String -> (LPTSTR -> DWORD -> IO DWORD) -> DWORD -> IO String
try String
"searchPath" (\LPTSTR
buf DWORD
len -> LPTSTR
-> LPTSTR -> LPTSTR -> DWORD -> LPTSTR -> Ptr LPTSTR -> IO DWORD
c_SearchPath LPTSTR
p_path LPTSTR
p_filename LPTSTR
p_ext
                          DWORD
len LPTSTR
buf Ptr LPTSTR
ppFilePart) DWORD
512
    return (Just s))
     IO (Maybe String)
-> (IOError -> IO (Maybe String)) -> IO (Maybe String)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \IOError
e -> if IOError -> Bool
isDoesNotExistError IOError
e
                       then Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
                       else IOError -> IO (Maybe String)
forall a. HasCallStack => IOError -> IO a
ioError IOError
e

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

-- System Info (Info about processor and memory subsystem)

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


getSystemInfo :: IO SYSTEM_INFO
getSystemInfo :: IO SYSTEM_INFO
getSystemInfo = (Ptr SYSTEM_INFO -> IO SYSTEM_INFO) -> IO SYSTEM_INFO
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr SYSTEM_INFO -> IO SYSTEM_INFO) -> IO SYSTEM_INFO)
-> (Ptr SYSTEM_INFO -> IO SYSTEM_INFO) -> IO SYSTEM_INFO
forall a b. (a -> b) -> a -> b
$ \Ptr SYSTEM_INFO
ret -> do
    Ptr SYSTEM_INFO -> IO ()
c_GetSystemInfo Ptr SYSTEM_INFO
ret
    Ptr SYSTEM_INFO -> IO SYSTEM_INFO
forall a. Storable a => Ptr a -> IO a
peek Ptr SYSTEM_INFO
ret

-- %fun GetSystemMetrics :: SMSetting -> IO Int


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

-- Thread Desktops

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


-- %fun GetThreadDesktop :: ThreadId -> IO HDESK

-- %fun SetThreadDesktop :: ThreadId -> HDESK -> IO ()


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

-- User name

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


-- %fun GetUserName :: IO String


getUserName :: IO String
getUserName :: IO String
getUserName =
  Int -> (LPTSTR -> IO String) -> IO String
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
512 ((LPTSTR -> IO String) -> IO String)
-> (LPTSTR -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \ LPTSTR
c_str ->
    DWORD -> (Ptr DWORD -> IO String) -> IO String
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with DWORD
512 ((Ptr DWORD -> IO String) -> IO String)
-> (Ptr DWORD -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \ Ptr DWORD
c_len -> do
        String -> IO Bool -> IO ()
failIfFalse_ String
"GetUserName" (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ LPTSTR -> Ptr DWORD -> IO Bool
c_GetUserName LPTSTR
c_str Ptr DWORD
c_len
        len <- Ptr DWORD -> IO DWORD
forall a. Storable a => Ptr a -> IO a
peek Ptr DWORD
c_len
        peekTStringLen (c_str, fromIntegral len - 1)

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

-- End

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