{-# LINE 1 "libraries\\Win32\\System\\Win32\\WindowsString\\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.WindowsString.Info
    ( module System.Win32.WindowsString.Info
    , module System.Win32.Info
    ) where

import System.Win32.Info.Internal
import System.Win32.Info hiding (
    getSystemDirectory
  , getWindowsDirectory
  , getCurrentDirectory
  , getTemporaryDirectory
  , getFullPathName
  , getLongPathName
  , getShortPathName
  , searchPath
  , getUserName
  )
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.WindowsString.Types (failIfFalse_, peekTStringLen, withTString, try)
import System.OsPath.Windows


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

#include "windows_cconv.h"




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

-- Standard Directories

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


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

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

getCurrentDirectory :: IO WindowsString
getCurrentDirectory :: IO WindowsString
getCurrentDirectory = String
-> (LPTSTR -> DWORD -> IO DWORD) -> DWORD -> IO WindowsString
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 WindowsString
getTemporaryDirectory :: IO WindowsString
getTemporaryDirectory = String
-> (LPTSTR -> DWORD -> IO DWORD) -> DWORD -> IO WindowsString
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 :: WindowsPath -> IO WindowsPath
getFullPathName :: WindowsString -> IO WindowsString
getFullPathName WindowsString
name = do
  WindowsString -> (LPTSTR -> IO WindowsString) -> IO WindowsString
forall a. WindowsString -> (LPTSTR -> IO a) -> IO a
withTString WindowsString
name ((LPTSTR -> IO WindowsString) -> IO WindowsString)
-> (LPTSTR -> IO WindowsString) -> IO WindowsString
forall a b. (a -> b) -> a -> b
$ \ LPTSTR
c_name ->
    String
-> (LPTSTR -> DWORD -> IO DWORD) -> DWORD -> IO WindowsString
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 :: WindowsPath -> IO WindowsPath
getLongPathName :: WindowsString -> IO WindowsString
getLongPathName WindowsString
name = do
  WindowsString -> (LPTSTR -> IO WindowsString) -> IO WindowsString
forall a. WindowsString -> (LPTSTR -> IO a) -> IO a
withTString WindowsString
name ((LPTSTR -> IO WindowsString) -> IO WindowsString)
-> (LPTSTR -> IO WindowsString) -> IO WindowsString
forall a b. (a -> b) -> a -> b
$ \ LPTSTR
c_name ->
    String
-> (LPTSTR -> DWORD -> IO DWORD) -> DWORD -> IO WindowsString
try String
"getLongPathName"
      (LPTSTR -> LPTSTR -> DWORD -> IO DWORD
c_GetLongPathName LPTSTR
c_name) DWORD
512

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

searchPath :: Maybe WindowsString -> WindowsPath -> Maybe WindowsString -> IO (Maybe WindowsPath)
searchPath :: Maybe WindowsString
-> WindowsString -> Maybe WindowsString -> IO (Maybe WindowsString)
searchPath Maybe WindowsString
path WindowsString
filename Maybe WindowsString
ext =
  ((LPTSTR -> IO (Maybe WindowsString)) -> IO (Maybe WindowsString))
-> (WindowsString
    -> (LPTSTR -> IO (Maybe WindowsString))
    -> IO (Maybe WindowsString))
-> Maybe WindowsString
-> (LPTSTR -> IO (Maybe WindowsString))
-> IO (Maybe WindowsString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((LPTSTR -> IO (Maybe WindowsString))
-> LPTSTR -> IO (Maybe WindowsString)
forall a b. (a -> b) -> a -> b
$ LPTSTR
forall a. Ptr a
nullPtr) WindowsString
-> (LPTSTR -> IO (Maybe WindowsString)) -> IO (Maybe WindowsString)
forall a. WindowsString -> (LPTSTR -> IO a) -> IO a
withTString Maybe WindowsString
path ((LPTSTR -> IO (Maybe WindowsString)) -> IO (Maybe WindowsString))
-> (LPTSTR -> IO (Maybe WindowsString)) -> IO (Maybe WindowsString)
forall a b. (a -> b) -> a -> b
$ \LPTSTR
p_path ->
  WindowsString
-> (LPTSTR -> IO (Maybe WindowsString)) -> IO (Maybe WindowsString)
forall a. WindowsString -> (LPTSTR -> IO a) -> IO a
withTString WindowsString
filename ((LPTSTR -> IO (Maybe WindowsString)) -> IO (Maybe WindowsString))
-> (LPTSTR -> IO (Maybe WindowsString)) -> IO (Maybe WindowsString)
forall a b. (a -> b) -> a -> b
$ \LPTSTR
p_filename ->
  (WindowsString
 -> (LPTSTR -> IO (Maybe WindowsString))
 -> IO (Maybe WindowsString))
-> Maybe WindowsString
-> (LPTSTR -> IO (Maybe WindowsString))
-> IO (Maybe WindowsString)
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith WindowsString
-> (LPTSTR -> IO (Maybe WindowsString)) -> IO (Maybe WindowsString)
forall a. WindowsString -> (LPTSTR -> IO a) -> IO a
withTString Maybe WindowsString
ext      ((LPTSTR -> IO (Maybe WindowsString)) -> IO (Maybe WindowsString))
-> (LPTSTR -> IO (Maybe WindowsString)) -> IO (Maybe WindowsString)
forall a b. (a -> b) -> a -> b
$ \LPTSTR
p_ext ->
  (Ptr LPTSTR -> IO (Maybe WindowsString))
-> IO (Maybe WindowsString)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr LPTSTR -> IO (Maybe WindowsString))
 -> IO (Maybe WindowsString))
-> (Ptr LPTSTR -> IO (Maybe WindowsString))
-> IO (Maybe WindowsString)
forall a b. (a -> b) -> a -> b
$ \Ptr LPTSTR
ppFilePart -> (do
    s <- String
-> (LPTSTR -> DWORD -> IO DWORD) -> DWORD -> IO WindowsString
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 WindowsString)
-> (IOError -> IO (Maybe WindowsString))
-> IO (Maybe WindowsString)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \IOError
e -> if IOError -> Bool
isDoesNotExistError IOError
e
                       then Maybe WindowsString -> IO (Maybe WindowsString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe WindowsString
forall a. Maybe a
Nothing
                       else IOError -> IO (Maybe WindowsString)
forall a. HasCallStack => IOError -> IO a
ioError IOError
e

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

-- User name

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


-- %fun GetUserName :: IO String


getUserName :: IO WindowsString
getUserName :: IO WindowsString
getUserName =
  Int -> (LPTSTR -> IO WindowsString) -> IO WindowsString
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
512 ((LPTSTR -> IO WindowsString) -> IO WindowsString)
-> (LPTSTR -> IO WindowsString) -> IO WindowsString
forall a b. (a -> b) -> a -> b
$ \ LPTSTR
c_str ->
    DWORD -> (Ptr DWORD -> IO WindowsString) -> IO WindowsString
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with DWORD
512 ((Ptr DWORD -> IO WindowsString) -> IO WindowsString)
-> (Ptr DWORD -> IO WindowsString) -> IO WindowsString
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

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