{-# LINE 1 "libraries\\Win32\\System\\Win32\\WindowsString\\Console.hsc" #-}
{-# LANGUAGE PackageImports #-}
module System.Win32.WindowsString.Console (
getConsoleMode,
setConsoleMode,
eNABLE_ECHO_INPUT,
eNABLE_EXTENDED_FLAGS,
eNABLE_INSERT_MODE,
eNABLE_LINE_INPUT,
eNABLE_MOUSE_INPUT,
eNABLE_PROCESSED_INPUT,
eNABLE_QUICK_EDIT_MODE,
eNABLE_WINDOW_INPUT,
eNABLE_VIRTUAL_TERMINAL_INPUT,
eNABLE_PROCESSED_OUTPUT,
eNABLE_WRAP_AT_EOL_OUTPUT,
eNABLE_VIRTUAL_TERMINAL_PROCESSING,
dISABLE_NEWLINE_AUTO_RETURN,
eNABLE_LVB_GRID_WORLDWIDE,
getConsoleCP,
setConsoleCP,
getConsoleOutputCP,
setConsoleOutputCP,
CtrlEvent, cTRL_C_EVENT, cTRL_BREAK_EVENT,
generateConsoleCtrlEvent,
commandLineToArgv,
getCommandLineW,
getArgs,
CONSOLE_SCREEN_BUFFER_INFO(..),
CONSOLE_SCREEN_BUFFER_INFOEX(..),
COORD(..),
SMALL_RECT(..),
COLORREF,
getConsoleScreenBufferInfo,
getCurrentConsoleScreenBufferInfo,
getConsoleScreenBufferInfoEx,
getCurrentConsoleScreenBufferInfoEx,
getEnv,
getEnvironment
) where
#include "windows_cconv.h"
import System.Win32.WindowsString.Types
import System.Win32.WindowsString.String (withTStringBufferLen)
import System.Win32.Console.Internal
import System.Win32.Console hiding (getArgs, commandLineToArgv, getEnv, getEnvironment)
import System.OsString.Windows
import System.OsString.Internal.Types
import Foreign.C.Types (CWchar)
import Foreign.C.String (CWString)
import Foreign.Ptr (plusPtr)
import Foreign.Storable (Storable(..))
import Foreign.Marshal.Array (peekArray, peekArray0)
import Foreign.Marshal.Alloc (alloca)
import GHC.IO (bracket)
import GHC.IO.Exception (IOException(..), IOErrorType(OtherError))
import Prelude hiding (break, length, tail)
import qualified Prelude as P
{-# LINE 97 "libraries\\Win32\\System\\Win32\\WindowsString\\Console.hsc" #-}
commandLineToArgv :: WindowsString -> IO [WindowsString]
commandLineToArgv arg
| arg == mempty = return []
| otherwise = withTString arg $ \c_arg -> do
alloca $ \c_size -> do
res <- c_CommandLineToArgvW c_arg c_size
size <- peek c_size
args <- peekArray (fromIntegral size) res
_ <- localFree res
mapM peekTString args
getArgs :: IO [WindowsString]
getArgs = do
getCommandLineW >>= peekTString >>= commandLineToArgv
getEnv :: WindowsString -> IO (Maybe WindowsString)
getEnv name =
withTString name $ \c_name -> withTStringBufferLen maxLength $ \(buf, len) -> do
let c_len = fromIntegral len
c_len' <- c_GetEnvironmentVariableW c_name buf c_len
case c_len' of
0 -> do
err_code <- getLastError
if err_code == eERROR_ENVVAR_NOT_FOUND
then return Nothing
else errorWin "GetEnvironmentVariableW"
_ | c_len' > fromIntegral maxLength ->
ioError (IOError Nothing OtherError "GetEnvironmentVariableW" ("Unexpected return code: " <> show c_len') Nothing Nothing)
| otherwise -> do
let len' = fromIntegral c_len'
Just <$> peekTStringLen (buf, len')
where
maxLength :: Int
maxLength = 65535
getEnvironment :: IO [(WindowsString, WindowsString)]
getEnvironment = bracket c_GetEnvironmentStringsW c_FreeEnvironmentStrings $ \lpwstr -> do
strs <- builder lpwstr
return (divvy <$> strs)
where
divvy :: WindowsString -> (WindowsString, WindowsString)
divvy str =
case break (== unsafeFromChar '=') str of
(xs,ys)
| ys == mempty -> (xs,ys)
(name, ys) -> let value = tail ys in (name,value)
builder :: LPWSTR -> IO [WindowsString]
builder ptr = go 0
where
go :: Int -> IO [WindowsString]
go off = do
(str, l) <- peekCWStringOff ptr off
if l == 0
then pure []
else (str:) <$> go (((l + 1) * 2) + off)
peekCWStringOff :: CWString -> Int -> IO (WindowsString, Int)
peekCWStringOff cp off = do
cs <- peekArray0 wNUL (cp `plusPtr` off)
return (cWcharsToChars cs, P.length cs)
wNUL :: CWchar
wNUL = 0
cWcharsToChars :: [CWchar] -> WindowsString
cWcharsToChars = pack . fmap (WindowsChar . fromIntegral)