Skip to content

Commit 427f1a9

Browse files
hasufellMistuke
hasufell
authored and
Mistuke
committed
Add support for GetCommandLineW
1 parent 2ce3d8e commit 427f1a9

File tree

4 files changed

+290
-145
lines changed

4 files changed

+290
-145
lines changed

‎System/Win32/Console.hsc

Lines changed: 11 additions & 145 deletions
Original file line numberDiff line numberDiff line change
@@ -45,6 +45,8 @@ module System.Win32.Console (
4545
generateConsoleCtrlEvent,
4646
-- * Command line
4747
commandLineToArgv,
48+
getCommandLineW,
49+
getArgs,
4850
-- * Screen buffer
4951
CONSOLE_SCREEN_BUFFER_INFO(..),
5052
CONSOLE_SCREEN_BUFFER_INFOEX(..),
@@ -63,21 +65,15 @@ module System.Win32.Console (
6365
#include "wincon_compat.h"
6466

6567
import System.Win32.Types
68+
import System.Win32.Console.Internal
6669
import Graphics.Win32.Misc
6770
import Graphics.Win32.GDI.Types (COLORREF)
6871

69-
import Foreign.C.Types (CInt(..))
70-
import Foreign.C.String (withCWString, CWString)
71-
import Foreign.Ptr (Ptr, plusPtr)
72+
import Foreign.C.String (withCWString)
7273
import Foreign.Storable (Storable(..))
73-
import Foreign.Marshal.Array (peekArray, pokeArray)
74+
import Foreign.Marshal.Array (peekArray)
7475
import Foreign.Marshal.Alloc (alloca)
7576

76-
foreign import WINDOWS_CCONV unsafe "windows.h GetConsoleMode"
77-
c_GetConsoleMode :: HANDLE -> LPDWORD -> IO BOOL
78-
79-
foreign import WINDOWS_CCONV unsafe "windows.h SetConsoleMode"
80-
c_SetConsoleMode :: HANDLE -> DWORD -> IO BOOL
8177

8278
getConsoleMode :: HANDLE -> IO DWORD
8379
getConsoleMode h = alloca $ \ptr -> do
@@ -107,36 +103,12 @@ eNABLE_VIRTUAL_TERMINAL_PROCESSING = 4
107103
dISABLE_NEWLINE_AUTO_RETURN = 8
108104
eNABLE_LVB_GRID_WORLDWIDE = 16
109105

110-
foreign import WINDOWS_CCONV unsafe "windows.h GetConsoleCP"
111-
getConsoleCP :: IO UINT
112-
113-
foreign import WINDOWS_CCONV unsafe "windows.h SetConsoleCP"
114-
setConsoleCP :: UINT -> IO ()
115-
116-
foreign import WINDOWS_CCONV unsafe "windows.h GetConsoleOutputCP"
117-
getConsoleOutputCP :: IO UINT
118-
119-
foreign import WINDOWS_CCONV unsafe "windows.h SetConsoleOutputCP"
120-
setConsoleOutputCP :: UINT -> IO ()
121-
122-
type CtrlEvent = DWORD
123-
#{enum CtrlEvent,
124-
, cTRL_C_EVENT = 0
125-
, cTRL_BREAK_EVENT = 1
126-
}
127-
128106
generateConsoleCtrlEvent :: CtrlEvent -> DWORD -> IO ()
129107
generateConsoleCtrlEvent e p
130108
= failIfFalse_
131109
"generateConsoleCtrlEvent"
132110
$ c_GenerateConsoleCtrlEvent e p
133111

134-
foreign import WINDOWS_CCONV safe "windows.h GenerateConsoleCtrlEvent"
135-
c_GenerateConsoleCtrlEvent :: CtrlEvent -> DWORD -> IO BOOL
136-
137-
foreign import WINDOWS_CCONV unsafe "Shellapi.h CommandLineToArgvW"
138-
c_CommandLineToArgvW :: CWString -> Ptr CInt -> IO (Ptr CWString)
139-
140112
-- | This function can be used to parse command line arguments and return
141113
-- the split up arguments as elements in a list.
142114
commandLineToArgv :: String -> IO [String]
@@ -150,118 +122,12 @@ commandLineToArgv arg =
150122
_ <- localFree res
151123
mapM peekTString args
152124

153-
data CONSOLE_SCREEN_BUFFER_INFO = CONSOLE_SCREEN_BUFFER_INFO
154-
{ dwSize :: COORD
155-
, dwCursorPosition :: COORD
156-
, wAttributes :: WORD
157-
, srWindow :: SMALL_RECT
158-
, dwMaximumWindowSize :: COORD
159-
} deriving (Show, Eq)
160-
161-
instance Storable CONSOLE_SCREEN_BUFFER_INFO where
162-
sizeOf = const #{size CONSOLE_SCREEN_BUFFER_INFO}
163-
alignment _ = #alignment CONSOLE_SCREEN_BUFFER_INFO
164-
peek buf = do
165-
dwSize' <- (#peek CONSOLE_SCREEN_BUFFER_INFO, dwSize) buf
166-
dwCursorPosition' <- (#peek CONSOLE_SCREEN_BUFFER_INFO, dwCursorPosition) buf
167-
wAttributes' <- (#peek CONSOLE_SCREEN_BUFFER_INFO, wAttributes) buf
168-
srWindow' <- (#peek CONSOLE_SCREEN_BUFFER_INFO, srWindow) buf
169-
dwMaximumWindowSize' <- (#peek CONSOLE_SCREEN_BUFFER_INFO, dwMaximumWindowSize) buf
170-
return $ CONSOLE_SCREEN_BUFFER_INFO dwSize' dwCursorPosition' wAttributes' srWindow' dwMaximumWindowSize'
171-
poke buf info = do
172-
(#poke CONSOLE_SCREEN_BUFFER_INFO, dwSize) buf (dwSize info)
173-
(#poke CONSOLE_SCREEN_BUFFER_INFO, dwCursorPosition) buf (dwCursorPosition info)
174-
(#poke CONSOLE_SCREEN_BUFFER_INFO, wAttributes) buf (wAttributes info)
175-
(#poke CONSOLE_SCREEN_BUFFER_INFO, srWindow) buf (srWindow info)
176-
(#poke CONSOLE_SCREEN_BUFFER_INFO, dwMaximumWindowSize) buf (dwMaximumWindowSize info)
177-
178-
data CONSOLE_SCREEN_BUFFER_INFOEX = CONSOLE_SCREEN_BUFFER_INFOEX
179-
{ dwSizeEx :: COORD
180-
, dwCursorPositionEx :: COORD
181-
, wAttributesEx :: WORD
182-
, srWindowEx :: SMALL_RECT
183-
, dwMaximumWindowSizeEx :: COORD
184-
, wPopupAttributes :: WORD
185-
, bFullscreenSupported :: BOOL
186-
, colorTable :: [COLORREF]
187-
-- ^ Only the first 16 'COLORREF' values passed to the Windows Console
188-
-- API. If fewer than 16 values, the remainder are padded with @0@ when
189-
-- passed to the API.
190-
} deriving (Show, Eq)
191-
192-
instance Storable CONSOLE_SCREEN_BUFFER_INFOEX where
193-
sizeOf = const #{size CONSOLE_SCREEN_BUFFER_INFOEX}
194-
alignment = const #{alignment CONSOLE_SCREEN_BUFFER_INFOEX}
195-
peek buf = do
196-
dwSize' <- (#peek CONSOLE_SCREEN_BUFFER_INFOEX, dwSize) buf
197-
dwCursorPosition' <- (#peek CONSOLE_SCREEN_BUFFER_INFOEX, dwCursorPosition) buf
198-
wAttributes' <- (#peek CONSOLE_SCREEN_BUFFER_INFOEX, wAttributes) buf
199-
srWindow' <- (#peek CONSOLE_SCREEN_BUFFER_INFOEX, srWindow) buf
200-
dwMaximumWindowSize' <- (#peek CONSOLE_SCREEN_BUFFER_INFOEX, dwMaximumWindowSize) buf
201-
wPopupAttributes' <- (#peek CONSOLE_SCREEN_BUFFER_INFOEX, wPopupAttributes) buf
202-
bFullscreenSupported' <- (#peek CONSOLE_SCREEN_BUFFER_INFOEX, bFullscreenSupported) buf
203-
colorTable' <- peekArray 16 ((#ptr CONSOLE_SCREEN_BUFFER_INFOEX, ColorTable) buf)
204-
return $ CONSOLE_SCREEN_BUFFER_INFOEX dwSize' dwCursorPosition'
205-
wAttributes' srWindow' dwMaximumWindowSize' wPopupAttributes'
206-
bFullscreenSupported' colorTable'
207-
poke buf info = do
208-
(#poke CONSOLE_SCREEN_BUFFER_INFOEX, cbSize) buf cbSize
209-
(#poke CONSOLE_SCREEN_BUFFER_INFOEX, dwSize) buf (dwSizeEx info)
210-
(#poke CONSOLE_SCREEN_BUFFER_INFOEX, dwCursorPosition) buf (dwCursorPositionEx info)
211-
(#poke CONSOLE_SCREEN_BUFFER_INFOEX, wAttributes) buf (wAttributesEx info)
212-
(#poke CONSOLE_SCREEN_BUFFER_INFOEX, srWindow) buf (srWindowEx info)
213-
(#poke CONSOLE_SCREEN_BUFFER_INFOEX, dwMaximumWindowSize) buf (dwMaximumWindowSizeEx info)
214-
(#poke CONSOLE_SCREEN_BUFFER_INFOEX, wPopupAttributes) buf (wPopupAttributes info)
215-
(#poke CONSOLE_SCREEN_BUFFER_INFOEX, bFullscreenSupported) buf (bFullscreenSupported info)
216-
pokeArray ((#ptr CONSOLE_SCREEN_BUFFER_INFOEX, ColorTable) buf) colorTable'
217-
where
218-
cbSize :: ULONG
219-
cbSize = #{size CONSOLE_SCREEN_BUFFER_INFOEX}
220-
colorTable' = take 16 $ colorTable info ++ repeat 0
221-
222-
data COORD = COORD
223-
{ xPos :: SHORT
224-
, yPos :: SHORT
225-
} deriving (Show, Eq)
226-
227-
instance Storable COORD where
228-
sizeOf = const #{size COORD}
229-
alignment _ = #alignment COORD
230-
peek buf = do
231-
x' <- (#peek COORD, X) buf
232-
y' <- (#peek COORD, Y) buf
233-
return $ COORD x' y'
234-
poke buf coord = do
235-
(#poke COORD, X) buf (xPos coord)
236-
(#poke COORD, Y) buf (yPos coord)
237-
238-
data SMALL_RECT = SMALL_RECT
239-
{ leftPos :: SHORT
240-
, topPos :: SHORT
241-
, rightPos :: SHORT
242-
, bottomPos :: SHORT
243-
} deriving (Show, Eq)
244-
245-
instance Storable SMALL_RECT where
246-
sizeOf _ = #{size SMALL_RECT}
247-
alignment _ = #alignment SMALL_RECT
248-
peek buf = do
249-
left' <- (#peek SMALL_RECT, Left) buf
250-
top' <- (#peek SMALL_RECT, Top) buf
251-
right' <- (#peek SMALL_RECT, Right) buf
252-
bottom' <- (#peek SMALL_RECT, Bottom) buf
253-
return $ SMALL_RECT left' top' right' bottom'
254-
poke buf small_rect = do
255-
(#poke SMALL_RECT, Left) buf (leftPos small_rect)
256-
(#poke SMALL_RECT, Top) buf (topPos small_rect)
257-
(#poke SMALL_RECT, Right) buf (rightPos small_rect)
258-
(#poke SMALL_RECT, Bottom) buf (bottomPos small_rect)
259-
260-
foreign import WINDOWS_CCONV safe "windows.h GetConsoleScreenBufferInfo"
261-
c_GetConsoleScreenBufferInfo :: HANDLE -> Ptr CONSOLE_SCREEN_BUFFER_INFO -> IO BOOL
262-
263-
foreign import WINDOWS_CCONV safe "windows.h GetConsoleScreenBufferInfoEx"
264-
c_GetConsoleScreenBufferInfoEx :: HANDLE -> Ptr CONSOLE_SCREEN_BUFFER_INFOEX -> IO BOOL
125+
-- | Based on 'GetCommandLineW'. This behaves slightly different
126+
-- than 'System.Environment.getArgs'. See the online documentation:
127+
-- <https://learn.microsoft.com/en-us/windows/win32/api/processenv/nf-processenv-getcommandlinew>
128+
getArgs :: IO [String]
129+
getArgs = do
130+
getCommandLineW >>= peekTString >>= commandLineToArgv
265131

266132
getConsoleScreenBufferInfo :: HANDLE -> IO CONSOLE_SCREEN_BUFFER_INFO
267133
getConsoleScreenBufferInfo h = alloca $ \ptr -> do

‎System/Win32/Console/Internal.hsc

Lines changed: 181 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,181 @@
1+
#if __GLASGOW_HASKELL__ >= 709
2+
{-# LANGUAGE Safe #-}
3+
#else
4+
{-# LANGUAGE Trustworthy #-}
5+
#endif
6+
-----------------------------------------------------------------------------
7+
-- |
8+
-- Module : System.Win32.Console.Internal
9+
-- Copyright : (c) University of Glasgow 2023
10+
-- License : BSD-style (see the file LICENSE)
11+
--
12+
-- Maintainer : Esa Ilari Vuokko <ei@vuokko.info>
13+
-- Stability : provisional
14+
-- Portability : portable
15+
--
16+
-- Internals for Console modules.
17+
--
18+
-----------------------------------------------------------------------------
19+
20+
module System.Win32.Console.Internal where
21+
22+
#include <windows.h>
23+
#include "alignment.h"
24+
##include "windows_cconv.h"
25+
#include "wincon_compat.h"
26+
27+
import System.Win32.Types
28+
import Graphics.Win32.GDI.Types (COLORREF)
29+
30+
import Foreign.C.Types (CInt(..))
31+
import Foreign.C.String (CWString)
32+
import Foreign.Ptr (Ptr, plusPtr)
33+
import Foreign.Storable (Storable(..))
34+
import Foreign.Marshal.Array (peekArray, pokeArray)
35+
36+
foreign import WINDOWS_CCONV unsafe "windows.h GetConsoleMode"
37+
c_GetConsoleMode :: HANDLE -> LPDWORD -> IO BOOL
38+
39+
foreign import WINDOWS_CCONV unsafe "windows.h SetConsoleMode"
40+
c_SetConsoleMode :: HANDLE -> DWORD -> IO BOOL
41+
42+
foreign import WINDOWS_CCONV unsafe "windows.h GetConsoleCP"
43+
getConsoleCP :: IO UINT
44+
45+
foreign import WINDOWS_CCONV unsafe "windows.h SetConsoleCP"
46+
setConsoleCP :: UINT -> IO ()
47+
48+
foreign import WINDOWS_CCONV unsafe "windows.h GetConsoleOutputCP"
49+
getConsoleOutputCP :: IO UINT
50+
51+
foreign import WINDOWS_CCONV unsafe "windows.h SetConsoleOutputCP"
52+
setConsoleOutputCP :: UINT -> IO ()
53+
54+
type CtrlEvent = DWORD
55+
#{enum CtrlEvent,
56+
, cTRL_C_EVENT = 0
57+
, cTRL_BREAK_EVENT = 1
58+
}
59+
60+
foreign import WINDOWS_CCONV safe "windows.h GenerateConsoleCtrlEvent"
61+
c_GenerateConsoleCtrlEvent :: CtrlEvent -> DWORD -> IO BOOL
62+
63+
foreign import WINDOWS_CCONV unsafe "Shellapi.h CommandLineToArgvW"
64+
c_CommandLineToArgvW :: CWString -> Ptr CInt -> IO (Ptr CWString)
65+
66+
foreign import WINDOWS_CCONV unsafe "processenv.h GetCommandLineW"
67+
getCommandLineW :: IO LPWSTR
68+
69+
data CONSOLE_SCREEN_BUFFER_INFO = CONSOLE_SCREEN_BUFFER_INFO
70+
{ dwSize :: COORD
71+
, dwCursorPosition :: COORD
72+
, wAttributes :: WORD
73+
, srWindow :: SMALL_RECT
74+
, dwMaximumWindowSize :: COORD
75+
} deriving (Show, Eq)
76+
77+
instance Storable CONSOLE_SCREEN_BUFFER_INFO where
78+
sizeOf = const #{size CONSOLE_SCREEN_BUFFER_INFO}
79+
alignment _ = #alignment CONSOLE_SCREEN_BUFFER_INFO
80+
peek buf = do
81+
dwSize' <- (#peek CONSOLE_SCREEN_BUFFER_INFO, dwSize) buf
82+
dwCursorPosition' <- (#peek CONSOLE_SCREEN_BUFFER_INFO, dwCursorPosition) buf
83+
wAttributes' <- (#peek CONSOLE_SCREEN_BUFFER_INFO, wAttributes) buf
84+
srWindow' <- (#peek CONSOLE_SCREEN_BUFFER_INFO, srWindow) buf
85+
dwMaximumWindowSize' <- (#peek CONSOLE_SCREEN_BUFFER_INFO, dwMaximumWindowSize) buf
86+
return $ CONSOLE_SCREEN_BUFFER_INFO dwSize' dwCursorPosition' wAttributes' srWindow' dwMaximumWindowSize'
87+
poke buf info = do
88+
(#poke CONSOLE_SCREEN_BUFFER_INFO, dwSize) buf (dwSize info)
89+
(#poke CONSOLE_SCREEN_BUFFER_INFO, dwCursorPosition) buf (dwCursorPosition info)
90+
(#poke CONSOLE_SCREEN_BUFFER_INFO, wAttributes) buf (wAttributes info)
91+
(#poke CONSOLE_SCREEN_BUFFER_INFO, srWindow) buf (srWindow info)
92+
(#poke CONSOLE_SCREEN_BUFFER_INFO, dwMaximumWindowSize) buf (dwMaximumWindowSize info)
93+
94+
data CONSOLE_SCREEN_BUFFER_INFOEX = CONSOLE_SCREEN_BUFFER_INFOEX
95+
{ dwSizeEx :: COORD
96+
, dwCursorPositionEx :: COORD
97+
, wAttributesEx :: WORD
98+
, srWindowEx :: SMALL_RECT
99+
, dwMaximumWindowSizeEx :: COORD
100+
, wPopupAttributes :: WORD
101+
, bFullscreenSupported :: BOOL
102+
, colorTable :: [COLORREF]
103+
-- ^ Only the first 16 'COLORREF' values passed to the Windows Console
104+
-- API. If fewer than 16 values, the remainder are padded with @0@ when
105+
-- passed to the API.
106+
} deriving (Show, Eq)
107+
108+
instance Storable CONSOLE_SCREEN_BUFFER_INFOEX where
109+
sizeOf = const #{size CONSOLE_SCREEN_BUFFER_INFOEX}
110+
alignment = const #{alignment CONSOLE_SCREEN_BUFFER_INFOEX}
111+
peek buf = do
112+
dwSize' <- (#peek CONSOLE_SCREEN_BUFFER_INFOEX, dwSize) buf
113+
dwCursorPosition' <- (#peek CONSOLE_SCREEN_BUFFER_INFOEX, dwCursorPosition) buf
114+
wAttributes' <- (#peek CONSOLE_SCREEN_BUFFER_INFOEX, wAttributes) buf
115+
srWindow' <- (#peek CONSOLE_SCREEN_BUFFER_INFOEX, srWindow) buf
116+
dwMaximumWindowSize' <- (#peek CONSOLE_SCREEN_BUFFER_INFOEX, dwMaximumWindowSize) buf
117+
wPopupAttributes' <- (#peek CONSOLE_SCREEN_BUFFER_INFOEX, wPopupAttributes) buf
118+
bFullscreenSupported' <- (#peek CONSOLE_SCREEN_BUFFER_INFOEX, bFullscreenSupported) buf
119+
colorTable' <- peekArray 16 ((#ptr CONSOLE_SCREEN_BUFFER_INFOEX, ColorTable) buf)
120+
return $ CONSOLE_SCREEN_BUFFER_INFOEX dwSize' dwCursorPosition'
121+
wAttributes' srWindow' dwMaximumWindowSize' wPopupAttributes'
122+
bFullscreenSupported' colorTable'
123+
poke buf info = do
124+
(#poke CONSOLE_SCREEN_BUFFER_INFOEX, cbSize) buf cbSize
125+
(#poke CONSOLE_SCREEN_BUFFER_INFOEX, dwSize) buf (dwSizeEx info)
126+
(#poke CONSOLE_SCREEN_BUFFER_INFOEX, dwCursorPosition) buf (dwCursorPositionEx info)
127+
(#poke CONSOLE_SCREEN_BUFFER_INFOEX, wAttributes) buf (wAttributesEx info)
128+
(#poke CONSOLE_SCREEN_BUFFER_INFOEX, srWindow) buf (srWindowEx info)
129+
(#poke CONSOLE_SCREEN_BUFFER_INFOEX, dwMaximumWindowSize) buf (dwMaximumWindowSizeEx info)
130+
(#poke CONSOLE_SCREEN_BUFFER_INFOEX, wPopupAttributes) buf (wPopupAttributes info)
131+
(#poke CONSOLE_SCREEN_BUFFER_INFOEX, bFullscreenSupported) buf (bFullscreenSupported info)
132+
pokeArray ((#ptr CONSOLE_SCREEN_BUFFER_INFOEX, ColorTable) buf) colorTable'
133+
where
134+
cbSize :: ULONG
135+
cbSize = #{size CONSOLE_SCREEN_BUFFER_INFOEX}
136+
colorTable' = take 16 $ colorTable info ++ repeat 0
137+
138+
data COORD = COORD
139+
{ xPos :: SHORT
140+
, yPos :: SHORT
141+
} deriving (Show, Eq)
142+
143+
instance Storable COORD where
144+
sizeOf = const #{size COORD}
145+
alignment _ = #alignment COORD
146+
peek buf = do
147+
x' <- (#peek COORD, X) buf
148+
y' <- (#peek COORD, Y) buf
149+
return $ COORD x' y'
150+
poke buf coord = do
151+
(#poke COORD, X) buf (xPos coord)
152+
(#poke COORD, Y) buf (yPos coord)
153+
154+
data SMALL_RECT = SMALL_RECT
155+
{ leftPos :: SHORT
156+
, topPos :: SHORT
157+
, rightPos :: SHORT
158+
, bottomPos :: SHORT
159+
} deriving (Show, Eq)
160+
161+
instance Storable SMALL_RECT where
162+
sizeOf _ = #{size SMALL_RECT}
163+
alignment _ = #alignment SMALL_RECT
164+
peek buf = do
165+
left' <- (#peek SMALL_RECT, Left) buf
166+
top' <- (#peek SMALL_RECT, Top) buf
167+
right' <- (#peek SMALL_RECT, Right) buf
168+
bottom' <- (#peek SMALL_RECT, Bottom) buf
169+
return $ SMALL_RECT left' top' right' bottom'
170+
poke buf small_rect = do
171+
(#poke SMALL_RECT, Left) buf (leftPos small_rect)
172+
(#poke SMALL_RECT, Top) buf (topPos small_rect)
173+
(#poke SMALL_RECT, Right) buf (rightPos small_rect)
174+
(#poke SMALL_RECT, Bottom) buf (bottomPos small_rect)
175+
176+
foreign import WINDOWS_CCONV safe "windows.h GetConsoleScreenBufferInfo"
177+
c_GetConsoleScreenBufferInfo :: HANDLE -> Ptr CONSOLE_SCREEN_BUFFER_INFO -> IO BOOL
178+
179+
foreign import WINDOWS_CCONV safe "windows.h GetConsoleScreenBufferInfoEx"
180+
c_GetConsoleScreenBufferInfoEx :: HANDLE -> Ptr CONSOLE_SCREEN_BUFFER_INFOEX -> IO BOOL
181+

0 commit comments

Comments
 (0)