888b6d2 · vty · git.iko.soy

git.iko.soy/vty

resolve compilation issues and test failures

commit888b6d2589615b745579cc273a0c77379db88c29 authorCorey O'Connor <corey@ooyala.com> dateSun 19 Jan 2014, 00:19 (13 years ago) parent451b12e

11 files changed+186−164

compare with master

unifiedsplit

CHANGELOG+1−1 src/Graphics/Vty/Image.hs−70 src/Graphics/Vty/Image/Internal.hs+70 src/Graphics/Vty/Input.hs+1−1 src/Graphics/Vty/Input/Events.hs−10 src/Graphics/Vty/Input/Internal.hs+30−9 src/Graphics/Vty/Input/Terminfo.hs+19−15 src/Graphics/Vty/Input/Terminfo/ANSI.hs+13−11 src/Graphics/Vty/Input/Terminfo/XTerm7Bit.hs+22−17 test/Rouge.hs+1−1 test/VerifyUsingMockInput.hs+29−29

CHANGELOG+1−1

@@ -2,7 +2,7 @@

22 * removed the typeclass based terminal and display context interface in favor of a data

33 structure of properties interface.

44 * input handling changes

5− * KASCII is not KChar

5+ * KASCII is now KChar

66 * KPN5 is now KCenter

77 * tests exist.

88 * the default amount of time between ESC and a subsequent character that causes VTY to

src/Graphics/Vty/Image.hs−70

@@ -50,7 +50,6 @@ import Graphics.Text.Width

5050

5151import qualified Data.ByteString as B

5252import qualified Data.ByteString.Lazy as BL

53−import Data.Monoid

5453import qualified Data.Text as T

5554import qualified Data.Text.Encoding as T

5655import qualified Data.Text.Lazy as TL

@@ -60,75 +59,6 @@ import Data.Word

6059infixr 5 <|>

6160infixr 4 <->

6261

63−-- | Append in the Monoid instance is equivalent to <->.

64−instance Monoid Image where

65− mempty = EmptyImage

66− mappend = vert_join

67−

68−-- | combines two images side by side

69−--

70−-- Combines text chunks where possible. Assures output_width and output_height properties are not

71−-- violated.

72−--

73−-- The result image will have a width equal to the sum of the two images width. And the height will

74−-- equal the largest height of the two images. The area not defined in one image due to a height

75−-- missmatch will be filled with the background pattern.

76−--

77−-- TODO: the bg fill is biased towards top to bottom languages(?)

78−horiz_join :: Image -> Image -> Image

79−horiz_join EmptyImage i = i

80−horiz_join i EmptyImage = i

81−horiz_join i_0@(HorizText a_0 t_0 w_0 cw_0) i_1@(HorizText a_1 t_1 w_1 cw_1)

82− | a_0 == a_1 = HorizText a_0 (TL.append t_0 t_1) (w_0 + w_1) (cw_0 + cw_1)

83− -- TODO: assumes horiz text height is always 1

84− | otherwise = HorizJoin i_0 i_1 (w_0 + w_1) 1

85−horiz_join i_0 i_1

86− -- If the images are of the same height then no padding is required

87− | h_0 == h_1 = HorizJoin i_0 i_1 w h_0

88− -- otherwise one of the images needs to be padded to the right size.

89− | h_0 < h_1 -- Pad i_0

90− = let pad_amount = h_1 - h_0

91− in HorizJoin (VertJoin i_0 (BGFill w_0 pad_amount) w_0 h_1) i_1 w h_1

92− | h_0 > h_1 -- Pad i_1

93− = let pad_amount = h_0 - h_1

94− in HorizJoin i_0 (VertJoin i_1 (BGFill w_1 pad_amount) w_1 h_0) w h_0

95− where

96− w_0 = image_width i_0

97− w_1 = image_width i_1

98− w = w_0 + w_1

99− h_0 = image_height i_0

100− h_1 = image_height i_1

101−horiz_join _ _ = error "horiz_join applied to undefined values."

102−

103−-- | combines two images vertically

104−--

105−-- The result image will have a height equal to the sum of the heights of both images.

106−-- The width will equal the largest width of the two images.

107−-- The area not defined in one image due to a width missmatch will be filled with the background

108−-- pattern.

109−--

110−-- TODO: the bg fill is biased towards right to left languages(?)

111−vert_join :: Image -> Image -> Image

112−vert_join EmptyImage i = i

113−vert_join i EmptyImage = i

114−vert_join i_0 i_1

115− -- If the images are of the same width then no background padding is required

116− | w_0 == w_1 = VertJoin i_0 i_1 w_0 h

117− -- Otherwise one of the images needs to be padded to the size of the other image.

118− | w_0 < w_1

119− = let pad_amount = w_1 - w_0

120− in VertJoin (HorizJoin i_0 (BGFill pad_amount h_0) w_1 h_0) i_1 w_1 h

121− | w_0 > w_1

122− = let pad_amount = w_0 - w_1

123− in VertJoin i_0 (HorizJoin i_1 (BGFill pad_amount h_1) w_0 h_1) w_0 h

124− where

125− w_0 = image_width i_0

126− w_1 = image_width i_1

127− h_0 = image_height i_0

128− h_1 = image_height i_1

129− h = h_0 + h_1

130−vert_join _ _ = error "vert_join applied to undefined values."

131−

13262-- | An area of the picture's bacground (See Background) of w columns and h rows.

13363background_fill :: Int -> Int -> Image

13464background_fill w h

src/Graphics/Vty/Image/Internal.hs+70

@@ -7,6 +7,7 @@ import Graphics.Text.Width

88import Control.DeepSeq

10+import Data.Monoid

1011import qualified Data.Text.Lazy as TL

1112

1213-- | A display text is a Data.Text.Lazy

@@ -221,3 +222,72 @@ image_height CropBottom { output_height = h } = h

221222image_height CropTop { output_height = h } = h

222223image_height EmptyImage = 0

223224

225+-- | Append in the Monoid instance is equivalent to <->.

226+instance Monoid Image where

227+ mempty = EmptyImage

228+ mappend = vert_join

229+

230+-- | combines two images side by side

231+--

232+-- Combines text chunks where possible. Assures output_width and output_height properties are not

233+-- violated.

234+--

235+-- The result image will have a width equal to the sum of the two images width. And the height will

236+-- equal the largest height of the two images. The area not defined in one image due to a height

237+-- missmatch will be filled with the background pattern.

238+--

239+-- TODO: the bg fill is biased towards top to bottom languages(?)

240+horiz_join :: Image -> Image -> Image

241+horiz_join EmptyImage i = i

242+horiz_join i EmptyImage = i

243+horiz_join i_0@(HorizText a_0 t_0 w_0 cw_0) i_1@(HorizText a_1 t_1 w_1 cw_1)

244+ | a_0 == a_1 = HorizText a_0 (TL.append t_0 t_1) (w_0 + w_1) (cw_0 + cw_1)

245+ -- TODO: assumes horiz text height is always 1

246+ | otherwise = HorizJoin i_0 i_1 (w_0 + w_1) 1

247+horiz_join i_0 i_1

248+ -- If the images are of the same height then no padding is required

249+ | h_0 == h_1 = HorizJoin i_0 i_1 w h_0

250+ -- otherwise one of the images needs to be padded to the right size.

251+ | h_0 < h_1 -- Pad i_0

252+ = let pad_amount = h_1 - h_0

253+ in HorizJoin (VertJoin i_0 (BGFill w_0 pad_amount) w_0 h_1) i_1 w h_1

254+ | h_0 > h_1 -- Pad i_1

255+ = let pad_amount = h_0 - h_1

256+ in HorizJoin i_0 (VertJoin i_1 (BGFill w_1 pad_amount) w_1 h_0) w h_0

257+ where

258+ w_0 = image_width i_0

259+ w_1 = image_width i_1

260+ w = w_0 + w_1

261+ h_0 = image_height i_0

262+ h_1 = image_height i_1

263+horiz_join _ _ = error "horiz_join applied to undefined values."

264+

265+-- | combines two images vertically

266+--

267+-- The result image will have a height equal to the sum of the heights of both images.

268+-- The width will equal the largest width of the two images.

269+-- The area not defined in one image due to a width missmatch will be filled with the background

270+-- pattern.

271+--

272+-- TODO: the bg fill is biased towards right to left languages(?)

273+vert_join :: Image -> Image -> Image

274+vert_join EmptyImage i = i

275+vert_join i EmptyImage = i

276+vert_join i_0 i_1

277+ -- If the images are of the same width then no background padding is required

278+ | w_0 == w_1 = VertJoin i_0 i_1 w_0 h

279+ -- Otherwise one of the images needs to be padded to the size of the other image.

280+ | w_0 < w_1

281+ = let pad_amount = w_1 - w_0

282+ in VertJoin (HorizJoin i_0 (BGFill pad_amount h_0) w_1 h_0) i_1 w_1 h

283+ | w_0 > w_1

284+ = let pad_amount = w_0 - w_1

285+ in VertJoin i_0 (HorizJoin i_1 (BGFill pad_amount h_1) w_0 h_1) w_0 h

286+ where

287+ w_0 = image_width i_0

288+ w_1 = image_width i_1

289+ h_0 = image_height i_0

290+ h_1 = image_height i_1

291+ h = h_0 + h_1

292+vert_join _ _ = error "vert_join applied to undefined values."

293+

src/Graphics/Vty/Input.hs+1−1

@@ -89,7 +89,7 @@ input_for_name_and_io escDelay term_name term_in = do

8989 ]

9090 setTerminalAttributes term_in attr' Immediately

9191 set_term_timing term_in

92− let classify_table = classify_table_for_term terminal

92+ let classify_table = classify_table_for_term term_name terminal

9393 (eventChannel, shutdown_event_processing) <- initInputForFd escDelay classify_table term_in

9494 let pokeIO = Catch $ do

9595 let e = error "(getsize in input layer)"

src/Graphics/Vty/Input/Events.hs−10

@@ -38,15 +38,5 @@ data Event

3838 | EvResize Int Int

3939 deriving (Eq,Show,Ord)

4040

41−-- | representation of mapping from input bytes to key and modifier.

42−--

43−-- Deprecated. Only used internally

44−type ClassifyTableV1 = [(String, (Key, [Modifier]))]

45−

4641-- | representation of mapping from input bytes to event

4742type ClassifyTable = [(String, Event)]

48−

49−map_to_legacy_table :: ClassifyTable -> ClassifyTableV1

50−map_to_legacy_table = map f

51− where f (s, EvKey k mods) = (s, (k, mods))

52− f _ = error "no mapping for mouse or resize events"

src/Graphics/Vty/Input/Internal.hs+30−9

@@ -1,3 +1,7 @@

1+-- Much of the input layer used to be in a single module with a few large functions. I've refactored

2+-- the input layer into many small bits. Now, I think, the code is a better position to be

3+-- incrementally refined. Still, until there are proper tests in place much of the refinement must

4+-- wait.

15module Graphics.Vty.Input.Internal where

37import Graphics.Vty.Input.Events

@@ -15,6 +19,7 @@ import qualified Data.Set as S( fromList, member )

1519import Data.Word

1620

1721import Foreign ( alloca, poke, peek, Ptr )

22+import Foreign.C.Types (CInt(..))

1823

1924import System.Posix.IO ( fdReadBuf

2025 , setFdOption

@@ -52,6 +57,10 @@ inputToEventThread classifier inputChannel eventChannel = loop []

5257 if c == '\xFFFD'

5358 then return ()

5459 else loop (kb ++ [c])

60+ -- drop the entirety of invalid sequences. Probably better to drop only the first

61+ -- character. However, the read behavior of terminals (a single read corresponds to the

62+ -- bytes of a single event) might mean this results in quicker error recovery from a

63+ -- users perspective.

5564 Invalid -> do

5665 c <- readChan inputChannel

5766 if c == '\xFFFD'

@@ -61,7 +70,12 @@ inputToEventThread classifier inputChannel eventChannel = loop []

6170 MisPfx k m s -> writeChan eventChannel (EvKey k m) >> loop s

6271 Valid k m -> writeChan eventChannel (EvKey k m) >> loop ""

6372

64−compile :: ClassifyTableV1 -> [Char] -> KClass

73+-- This makes a kind of tri. Has space efficiency issues with large input blocks.

74+-- Likely building a parser and just applying that would be better.

75+-- I did not write this so I might just rewrite it for better understanding. Not the best of

76+-- reasons...

77+-- TODO: measure and rewrite if required.

78+compile :: ClassifyTable -> [Char] -> KClass

6579compile table = cl' where

6680 -- take all prefixes and create a set of these

6781 prefix_set = S.fromList $ concatMap (init . inits . fst) $ table

@@ -73,19 +87,18 @@ compile table = cl' where

7387 -- if the input_block is exactly what is expected for an event then consume the whole

7488 -- block and return the event

7589 False -> case event_for_input input_block of

76− Just (k,m) -> Valid k m

90+ Just (EvKey k m) -> Valid k m

7791 -- look up progressively large prefixes of the input block until an event is found

7892 -- H: There will always be one match. The prefix_set contains, by definition, all

7993 -- prefixes of an event.

8094 Nothing ->

8195 let input_prefixes = init $ inits input_block

8296 in case mapMaybe (\s -> (,) s `fmap` event_for_input s) input_prefixes of

83− (s,(k,m)) : _ -> MisPfx k m (drop (length s) input_block)

84− [] -> error $ "vty internal inconsistency - "

85− ++ "input not a prefix nor contains any event data "

86− ++ show input_block

97+ (s,EvKey k m) : _ -> MisPfx k m (drop (length s) input_block)

98+ -- neither a prefix or a full event. Might be interesting to log.

99+ [] -> error $ show input_block

87100

88−classify, classifyTab :: ClassifyTableV1 -> [Char] -> KClass

101+classify, classifyTab :: ClassifyTable -> [Char] -> KClass

89102

90103-- As soon as

91104classify _table "\xFFFD" = EndLoop

@@ -97,7 +110,7 @@ classify table other

97110

98111classifyUtf8 :: [Char] -> KClass

99112classifyUtf8 s = case decode ((map (fromIntegral . ord) s) :: [Word8]) of

100− Just (unicodeChar, _) -> Valid (KASCII unicodeChar) []

113+ Just (unicodeChar, _) -> Valid (KChar unicodeChar) []

101114 _ -> Invalid -- something bad happened; just ignore and continue.

102115

103116classifyTab table = compile table

@@ -112,7 +125,15 @@ utf8Length c

112125 | c < 0xF0 = 3

113126 | otherwise = 4

114127

115−initInputForFd :: Int -> ClassifyTableV1 -> Fd -> IO (Chan Event, IO ())

128+-- I gave a quick shot at replacing this code with some that removed the "odd" bits. The "obvious"

129+-- changes all failed testing. This is timing sensitive code.

130+-- I now think I can replace this wil code that makes the time sensitivity explicit. I am waiting

131+-- until I have a good set of characterization tests to verify the input to event timing is still

132+-- correct for a user. I estimate the current tests cover ~70% of the required cases.

133+--

134+-- This is an example of an algorithm where code coverage could be high, even 100%, but the

135+-- algorithm still under tested. I should collect more of these examples...

136+initInputForFd :: Int -> ClassifyTable -> Fd -> IO (Chan Event, IO ())

116137initInputForFd escDelay classify_table input_fd = do

117138 inputChannel <- newChan

118139 eventChannel <- newChan

src/Graphics/Vty/Input/Terminfo.hs+19−15

@@ -1,9 +1,10 @@

11module Graphics.Vty.Input.Terminfo where

33import Graphics.Vty.Input.Events

4−import qualified Graphics.Vty.Input.Terminfo.VT100 as VT100

4+import qualified Graphics.Vty.Input.Terminfo.ANSI as ANSI

55import qualified Graphics.Vty.Input.Terminfo.XTerm7Bit as XTerm7Bit

7+import Control.Arrow

78import System.Console.Terminfo

910-- | queries the terminal for all capability based input sequences then adds on a terminal dependent

@@ -33,21 +34,23 @@ import System.Console.Terminfo

3334--

3435-- \todo terminfo meta is not supported.

3536-- \todo no 8bit

36−classify_table_for_term :: String -> Terminal -> ClassifyTableV1

37+classify_table_for_term :: String -> Terminal -> ClassifyTable

3738classify_table_for_term term_name term =

38− concatMap map_to_legacy_table

39− $ caps_classify_table term keys_from_caps_table

40− : visible_chars

41− : ctrl_chars

42− : ctrl_meta_chars

43− : special_support_keys

44− : internal_tables term_name

39+ concat $ caps_classify_table term keys_from_caps_table

40+ : universal_table

41+ : term_specific_tables term_name

4542

46−caps_classify_table :: Terminal -> [(String,Event)] -> [(String,Event)]

43+-- | key table assumed to be applicable to all terminals.

44+universal_table :: ClassifyTable

45+universal_table = concat [visible_chars, ctrl_chars, ctrl_meta_chars, special_support_keys]

46+

47+caps_classify_table :: Terminal -> [(String,Event)] -> ClassifyTable

4748caps_classify_table terminal table = [(x,y) | (Just x,y) <- map extract_cap table]

4849 where extract_cap = first (getCapability terminal . tiGetStr)

4950

50−internal_tables term_name

51+-- | tables specific to a given terminal that are not derivable from terminfo.

52+term_specific_tables :: String -> [ClassifyTable]

53+term_specific_tables term_name

5154 | ANSI.supports term_name = ANSI.tables

5255 | XTerm7Bit.supports term_name = XTerm7Bit.tables

5356 | otherwise = []

@@ -64,19 +67,20 @@ visible_chars = [ ([x], EvKey (KChar x) [])

6467 | x <- [' ' .. toEnum 0xC1]

6568 ]

6669

67−-- | Non visible cahracters in the ISO-8859-1 and UTF-8 common set translated to ctrl + char.

70+-- | Non visible characters in the ISO-8859-1 and UTF-8 common set translated to ctrl + char.

6871--

6972-- \todo resolve CTRL-i is the same as tab

7073ctrl_chars :: ClassifyTable

7174ctrl_chars =

7275 [ ([toEnum x],EvKey (KChar y) [MCtrl])

7376 | (x,y) <- zip ([0..31]) ('@':['a'..'z']++['['..'_']),

74− y /= 'i' -- Resolve issue #3 where CTRL-i hides TAB.

77+ y /= 'i', -- Resolve issue #3 where CTRL-i hides TAB.

78+ y /= 'h' -- CTRL-h should not hide BS

7579 ]

7680

7781-- | Ctrl+Meta+Char

7882ctrl_meta_chars :: ClassifyTable

79−ctrl_meta_chars = map (\(s,EvKey c m) -> ('\ESC':s, EvKey c (MMeta:m)))

83+ctrl_meta_chars = map (\(s,EvKey c m) -> ('\ESC':s, EvKey c (MMeta:m))) ctrl_chars

8084

8185-- | esc, meta esc, delete, meta delete, enter, meta enter

8286special_support_keys :: ClassifyTable

@@ -88,7 +92,7 @@ special_support_keys =

8892 -- Special support for Enter

8993 , ("\ESC\^J",EvKey KEnter [MMeta]), ("\^J",EvKey KEnter [])

9094 -- explicit support for tab

91− , ("\t", EvKey KChar '\t' []

95+ , ("\t", EvKey (KChar '\t') [])

9296 ]

9397

9498-- | classify table directly generated from terminfo cap strings

src/Graphics/Vty/Input/Terminfo/ANSI.hs+13−11

@@ -24,7 +24,7 @@ nav_keys_0 =

2424-- | VT 100 (?) encoding for shift, meta and ctrl plus arrows/home/end

2525nav_keys_1 :: ClassifyTable

2626nav_keys_1 =

27− [("\ESC[" ++ charCnt ++ show mc++c,(s,m))

27+ [("\ESC[" ++ charCnt ++ show mc++c,EvKey s m)

2828 | charCnt <- ["1;", ""], -- we can have a count or not

2929 (m,mc) <- [([MShift],2::Int), ([MCtrl],5), ([MMeta],3),

3030 ([MShift, MCtrl],6), ([MShift, MMeta],4)], -- modifiers and their codes

@@ -33,16 +33,16 @@ nav_keys_1 =

3333 ]

3434

3535-- | VT 100 (?) encoding for ins, del, pageup, pagedown, home, end

36−nav_keys_2 :: ClassifyTableV1

36+nav_keys_2 :: ClassifyTable

3737nav_keys_2 =

38− let k n s = ("\ESC["++show n++"~",(s,[]))

38+ let k n s = ("\ESC["++show n++"~",EvKey s [])

3939 in zipWith k [2::Int,3,5,6,1,4]

4040 [KIns,KDel,KPageUp,KPageDown,KHome,KEnd]

4141

4242-- | VT 100 (?) encoding for ctrl + ins, del, pageup, pagedown, home, end

43−nav_keys_3 :: ClassifyTableV1

43+nav_keys_3 :: ClassifyTable

4444nav_keys_3 =

45− let k n s = ("\ESC["++show n++";5~",(s,[MCtrl]))

45+ let k n s = ("\ESC["++show n++";5~", EvKey s [MCtrl])

4646 in zipWith k [2::Int,3,5,6,1,4]

4747 [KIns,KDel,KPageUp,KPageDown,KHome,KEnd]

4848

@@ -55,9 +55,9 @@ nav_keys_3 =

5555-- ``meta mode'' on and off, they can be given as smm and rmm."

5656--

5757-- That is more complex than below. I cannot fault the original author for just hard coding a table.

58−function_keys_1 :: ClassifyTableV1

58+function_keys_1 :: ClassifyTable

5959function_keys_1 =

60− let f ff nrs m = [ ("\ESC["++show n++"~",(KFun (n-(nrs!!0)+ff), m)) | n <- nrs ] in

60+ let f ff nrs m = [ ("\ESC["++show n++"~",EvKey (KFun $ n-(nrs!!0)+ff) m) | n <- nrs ] in

6161 concat [f 1 [25,26] [MShift], f 3 [28,29] [MShift], f 5 [31..34] [MShift] ]

6262

6363-- | VT 100 (?) encoding for meta plus char

@@ -69,11 +69,13 @@ function_keys_1 =

6969-- the same as ESC should examine km and current encoding.

7070-- 3. stopped enumeration at '~' instead of '\DEL'. The latter is mapped to KBS by

7171-- special_support_keys.

72−function_keys_2 :: ClassifyTableV1

73−function_keys_2 = [ ('\ESC':[x],(KASCII x,[MMeta])) | x <- '\t':[' ' .. '~'],

74− x /= '[']

72+function_keys_2 :: ClassifyTable

73+function_keys_2 = [ ('\ESC':[x],EvKey (KChar x) [MMeta])

74+ | x <- '\t':[' ' .. '~']

75+ , x /= '['

76+ ]

7577

76−tables :: [ClassifyTableV1]

78+tables :: [ClassifyTable]

7779tables =

7880 [ nav_keys_0

7981 , nav_keys_1

src/Graphics/Vty/Input/Terminfo/XTerm7Bit.hs+22−17

@@ -1,17 +1,20 @@

1−module Graphics.Vty.Input.Terminfo.XTerm where

1+module Graphics.Vty.Input.Terminfo.XTerm7Bit where

33import Graphics.Vty.Input.Events

5+import Data.List (isInfixOf, isPrefixOf)

57-- | The built in input augmentation for XTerm supports any TERM starting with xterm except those

68-- containing 8bit.

7−supports term_name = "xterm" `isPrefixOf` term_name && !("8bit" `isInfixOf` term_name)

9+supports :: String -> Bool

10+supports term_name = "xterm" `isPrefixOf` term_name && not ("8bit" `isInfixOf` term_name)

811

912-- | Encoding for navigation keys.

1013--

1114-- TODO: This is not the same as the input bytes pulled from teh caps table.

12−nav_keys_0 :: ClassifyTableV1

15+nav_keys_0 :: ClassifyTable

1316nav_keys_0 =

14− [ k "G" KNP5

17+ [ k "G" KCenter

1518 , k "P" KPause

1619 , k "A" KUp

1720 , k "B" KDown

@@ -21,12 +24,12 @@ nav_keys_0 =

2124 , k "F" KEnd

2225 , k "E" KBegin

2326 ]

24− where k c s = ("\ESC["++c,(s,[]))

27+ where k c s = ("\ESC["++c,EvKey s [])

2528

2629-- | VT 100 (?) encoding for shift, meta and ctrl plus arrows/home/end

27−nav_keys_1 :: ClassifyTableV1

30+nav_keys_1 :: ClassifyTable

2831nav_keys_1 =

29− [("\ESC[" ++ charCnt ++ show mc++c,(s,m))

32+ [("\ESC[" ++ charCnt ++ show mc++c,EvKey s m)

3033 | charCnt <- ["1;", ""], -- we can have a count or not

3134 (m,mc) <- [([MShift],2::Int), ([MCtrl],5), ([MMeta],3),

3235 ([MShift, MCtrl],6), ([MShift, MMeta],4)], -- modifiers and their codes

@@ -34,16 +37,16 @@ nav_keys_1 =

3437 ]

3538

3639-- | VT 100 (?) encoding for ins, del, pageup, pagedown, home, end

37−nav_keys_2 :: ClassifyTableV1

40+nav_keys_2 :: ClassifyTable

3841nav_keys_2 =

39− let k n s = ("\ESC["++show n++"~",(s,[]))

42+ let k n s = ("\ESC["++show n++"~",EvKey s [])

4043 in zipWith k [2::Int,3,5,6,1,4]

4144 [KIns,KDel,KPageUp,KPageDown,KHome,KEnd]

4245

4346-- | VT 100 (?) encoding for ctrl + ins, del, pageup, pagedown, home, end

44−nav_keys_3 :: ClassifyTableV1

47+nav_keys_3 :: ClassifyTable

4548nav_keys_3 =

46− let k n s = ("\ESC["++show n++";5~",(s,[MCtrl]))

49+ let k n s = ("\ESC["++show n++";5~",EvKey s [MCtrl])

4750 in zipWith k [2::Int,3,5,6,1,4]

4851 [KIns,KDel,KPageUp,KPageDown,KHome,KEnd]

4952

@@ -56,9 +59,9 @@ nav_keys_3 =

5659-- ``meta mode'' on and off, they can be given as smm and rmm."

5760--

5861-- That is more complex than below. I cannot fault the original author for just hard coding a table.

59−function_keys_1 :: ClassifyTableV1

62+function_keys_1 :: ClassifyTable

6063function_keys_1 =

61− let f ff nrs m = [ ("\ESC["++show n++"~",(KFun (n-(nrs!!0)+ff), m)) | n <- nrs ] in

64+ let f ff nrs m = [ ("\ESC["++show n++"~",EvKey (KFun $ n-(nrs!!0)+ff) m) | n <- nrs ] in

6265 concat [f 1 [25,26] [MShift], f 3 [28,29] [MShift], f 5 [31..34] [MShift] ]

6366

6467-- | VT 100 (?) encoding for meta plus char

@@ -70,12 +73,14 @@ function_keys_1 =

7073-- the same as ESC should examine km and current encoding.

7174-- 3. stopped enumeration at '~' instead of '\DEL'. The latter is mapped to KBS by

7275-- special_support_keys.

73−function_keys_2 :: ClassifyTableV1

74−function_keys_2 = [ ('\ESC':[x],(KASCII x,[MMeta])) | x <- '\t':[' ' .. '~'],

75− x /= '[']

76+function_keys_2 :: ClassifyTable

77+function_keys_2 = [ ('\ESC':[x],EvKey (KChar x) [MMeta])

78+ | x <- '\t':[' ' .. '~']

79+ , x /= '['

80+ ]

7681

7782-- | classify table for ANSI terminals

78−tables :: [ClassifyTableV1]

83+tables :: [ClassifyTable]

7984tables =

8085 [ nav_keys_0

8186 , nav_keys_1

test/Rouge.hs+1−1

@@ -93,7 +93,7 @@ process_event = do

9393 then return True

9494 else do

9595 case k of

96− EvKey (KASCII 'r') [MCtrl] -> ask >>= liftIO . refresh

96+ EvKey (KChar 'r') [MCtrl] -> ask >>= liftIO . refresh

9797 EvKey KLeft [] -> move_dude (-1) 0

9898 EvKey KRight [] -> move_dude 1 0

9999 EvKey KUp [] -> move_dude 0 (-1)

test/VerifyUsingMockInput.hs+29−29

@@ -11,7 +11,7 @@ import Verify.Graphics.Vty.Output

1111import Data.List (intersperse)

1212

1313import Graphics.Vty hiding (resize)

14−import Graphics.Vty.Input.Data

14+import Graphics.Vty.Input.Events

1515import Graphics.Vty.Input.Internal

1616import Graphics.Vty.Input.Terminfo

1717

@@ -102,7 +102,7 @@ compare_events input_spec expected_events out_events = compare_events' expected_

102102 printf "received events %s\n" (show out_events) :: IO ()

103103 return False

104104

105−assert_events_from_syn_input :: ClassifyTableV1 -> InputSpec -> ExpectedSpec -> IO Bool

105+assert_events_from_syn_input :: ClassifyTable -> InputSpec -> ExpectedSpec -> IO Bool

106106assert_events_from_syn_input table input_spec expected_events = do

107107 let max_duration = sum [t | Delay t <- input_spec] + min_detectable_delay

108108 event_count = length expected_events

@@ -127,7 +127,7 @@ assert_events_from_syn_input table input_spec expected_events = do

127127 out_events <- reverse <$> readIORef events_ref

128128 compare_events input_spec expected_events out_events

129129

130−assert_events_from_input_block :: ClassifyTableV1 -> InputSpec -> ExpectedSpec -> IO Bool

130+assert_events_from_input_block :: ClassifyTable -> InputSpec -> ExpectedSpec -> IO Bool

131131assert_events_from_input_block table input_spec expected_events = do

132132 let classifier = classify table

133133 max_duration = sum [t | Delay t <- input_spec] + min_detectable_delay

@@ -168,12 +168,12 @@ instance Monad m => Serial m (InputBlocksUsingTable event) where

168168 selections [] = []

169169 selections (x:xs) = let z = selections xs in [x] : (z ++ map ((:) x) z)

170170

171−verify_simple_input_block_to_event :: Property IO

172−verify_simple_input_block_to_event = forAll $ \(InputBlocksUsingTable gen) -> do

173− let input_seq = gen simple_chars

171+verify_visible_input_block_to_event :: Property IO

172+verify_visible_input_block_to_event = forAll $ \(InputBlocksUsingTable gen) -> do

173+ let input_seq = gen visible_chars

174174 input = Bytes $ concat [s | (s,_) <- input_seq]

175− events = [e | (_,(k,ms)) <- input_seq, let e = EvKey k ms]

176− monadic $ assert_events_from_input_block simple_chars [input] events

175+ events = map snd input_seq

176+ monadic $ assert_events_from_input_block visible_chars [input] events

177177

178178verify_keys_from_caps_table_block_to_event :: Property IO

179179verify_keys_from_caps_table_block_to_event = forAll $ \(InputBlocksUsingTable gen) ->

@@ -181,19 +181,19 @@ verify_keys_from_caps_table_block_to_event = forAll $ \(InputBlocksUsingTable ge

181181 term <- setupTerm term_name

182182 let table = caps_classify_table term keys_from_caps_table

183183 input_seq = gen table

184− events = [e | (_,e) <- input_seq]

185− keydowns = [Bytes s | (s,_) <- input_seq]

184+ events = map snd input_seq

185+ keydowns = map (Bytes . fst) input_seq

186186 input = intersperse (Delay test_key_delay) keydowns ++ [Delay test_key_delay]

187− assert_events_from_input_block (map_to_legacy_table table) input events

187+ assert_events_from_input_block table input events

188188

189−verify_simple_syn_input_to_event :: Property IO

190−verify_simple_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) -> monadic $ do

191− let table = simple_chars

189+verify_visible_syn_input_to_event :: Property IO

190+verify_visible_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) -> monadic $ do

191+ let table = visible_chars

192192 input_seq = gen table

193− events = [EvKey k ms | (_,(k,ms)) <- input_seq]

194− keydowns = [Bytes s | (s,_) <- input_seq]

193+ events = map snd input_seq

194+ keydowns = map (Bytes . fst) input_seq

195195 input = intersperse (Delay test_key_delay) keydowns ++ [Delay test_key_delay]

196− assert_events_from_syn_input (concat ansi_classify_table) input events

196+ assert_events_from_syn_input universal_table input events

197197

198198verify_caps_syn_input_to_event :: Property IO

199199verify_caps_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) ->

@@ -201,39 +201,39 @@ verify_caps_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) ->

201201 term <- setupTerm term_name

202202 let table = caps_classify_table term keys_from_caps_table

203203 input_seq = gen table

204− events = [e | (_,e) <- input_seq]

205− keydowns = [Bytes s | (s,_) <- input_seq]

204+ events = map snd input_seq

205+ keydowns = map (Bytes . fst) input_seq

206206 input = intersperse (Delay test_key_delay) keydowns ++ [Delay test_key_delay]

207− assert_events_from_syn_input (map_to_legacy_table table) input events

207+ assert_events_from_syn_input table input events

208208

209209verify_special_syn_input_to_event :: Property IO

210210verify_special_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) -> monadic $ do

211− let table = function_keys_1 ++ function_keys_2

211+ let table = special_support_keys

212212 input_seq = gen table

213− events = [EvKey k ms | (_,(k,ms)) <- input_seq]

214− keydowns = [Bytes s | (s,_) <- input_seq]

213+ events = map snd input_seq

214+ keydowns = map (Bytes . fst) input_seq

215215 input = intersperse (Delay test_key_delay) keydowns ++ [Delay test_key_delay]

216− assert_events_from_syn_input (concat ansi_classify_table) input events

216+ assert_events_from_syn_input universal_table input events

217217

218218verify_full_syn_input_to_event :: Property IO

219219verify_full_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) ->

220220 forEachOf terminals_of_interest $ \term_name -> monadic $ do

221221 term <- setupTerm term_name

222− let table = classify_table_for_term term

222+ let table = classify_table_for_term term_name term

223223 input_seq = gen table

224− events = [EvKey k ms | (_,(k,ms)) <- input_seq]

225− keydowns = [Bytes s | (s,_) <- input_seq]

224+ events = map snd input_seq

225+ keydowns = map (Bytes . fst) input_seq

226226 input = intersperse (Delay test_key_delay) keydowns ++ [Delay test_key_delay]

227227 assert_events_from_syn_input table input events

228228

229229main :: IO ()

230230main = defaultMain

231231 [ testProperty "basic block generated from a single visible chars to event translation"

232− verify_simple_input_block_to_event

232+ verify_visible_input_block_to_event

233233 , testProperty "key sequences read from caps table map to expected events"

234234 verify_keys_from_caps_table_block_to_event

235235 , testProperty "synthesized typing from single visible chars translates to expected events"

236− verify_simple_syn_input_to_event

236+ verify_visible_syn_input_to_event

237237 , testProperty "synthesized typing from keys from capabilities tables translates to expected events"

238238 verify_caps_syn_input_to_event

239239 , testProperty "synthesized typing from hard coded special keys translates to expected events"