424e6a8 · vty · git.iko.soy

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

compare with master

unifiedsplit

@@ -22,9 +22,9 @@ import System.Console.Terminfo

22import System.Posix.Signals.Exts

23import System.Posix.Terminal

24import System.Posix.IO ( stdInput

25− ,fdReadBuf

25+ , fdReadBuf

26− ,setFdOption

26+ , setFdOption

27− ,FdOption(..)

27+ , FdOption(..)

28 )

29

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

@@ -77,7 +77,7 @@ initTermInput escDelay terminal = do

77 loop

78

79 extract_cap = first (getCapability terminal . tiGetStr)

80− caps_classify_table = map_to_legacy_table [(x,y) | (Just x,y) <- map extract_cap caps_table]

80+ caps_classify_table = map_to_legacy_table [(x,y) | (Just x,y) <- map extract_cap keys_from_caps_table]

81 term_event_classify_table = concat $ caps_classify_table : ansi_classify_table

82 term_event_classifier = classify term_event_classify_table

83

src/Graphics/Vty/Input/Data.hs+2−2

@@ -38,8 +38,8 @@ map_to_legacy_table = map f

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

39

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

41−caps_table :: [(String, Event)]

41+keys_from_caps_table :: [(String, Event)]

42−caps_table =

42+keys_from_caps_table =

43 [ ("khome", EvKey KHome [])

44 , ("kend", EvKey KEnd [])

45 , ("cbt", EvKey KBackTab [])

test/Verify.hs+3

@@ -14,6 +14,7 @@ module Verify ( module Verify

14 , module Control.Monad

15 , module Test.QuickCheck

16 , module Test.QuickCheck.Modifiers

17+ , module Text.Printf

17 , succeeded

18 , succeeded

18 , failed

19 , failed

19 , result

20 , result

@@ -37,6 +38,8 @@ import Test.QuickCheck.Property hiding ( Result(..) )

37import qualified Test.QuickCheck.Property as Prop

38import qualified Test.QuickCheck.Property as Prop

38import Test.QuickCheck.Monadic ( monadicIO )

39import Test.QuickCheck.Monadic ( monadicIO )

39

40

41+import Text.Printf

42+

40import qualified Codec.Binary.UTF8.String as UTF8

43import qualified Codec.Binary.UTF8.String as UTF8

41

44

42import Control.Applicative hiding ( (<|>) )

45import Control.Applicative hiding ( (<|>) )

test/Verify/Graphics/Vty/Terminal.hs+4−1

@@ -8,9 +8,12 @@ import qualified Data.String.UTF8 as UTF8

8

9import Test.QuickCheck.Property

10

11+import Verify

12+

11-- A list of terminals that should be supported.

13-- A list of terminals that should be supported.

12-- This started with a list of terminals ubuntu supported. Then those terminals that really could

14-- This started with a list of terminals ubuntu supported. Then those terminals that really could

13−-- not be supported were removed.

15+-- not be supported were removed. Then a few more were pruned until a reasonable looking set was

16+-- made.

14terminals_of_interest =

17terminals_of_interest =

15 [ "vt100"

18 [ "vt100"

16 , "vt220"

19 , "vt220"

test/VerifyEvalTerminfoCaps.hs+1−41

@@ -11,6 +11,7 @@ import Control.DeepSeq

11import qualified System.Console.Terminfo as Terminfo

12

13import Verify

14+import Verify.Graphics.Vty.Terminal

14

15

15import Control.Applicative ( (<$>) )

16import Control.Applicative ( (<$>) )

16import Control.Exception ( try, SomeException(..) )

17import Control.Exception ( try, SomeException(..) )

@@ -22,47 +23,6 @@ import Data.Word

22

23

23import Numeric

24import Numeric

24

25

25−-- A list of terminals that ubuntu includes a terminfo cap file for.

26−-- Assuming that is a good place to start.

27−terminals_of_interest =

28− [ "wsvt25"

29− , "wsvt25m"

30− , "vt52"

31− , "vt100"

32− , "vt220"

33− , "vt102"

34− , "xterm-r5"

35− , "xterm-xfree86"

36− , "xterm-r6"

37− , "xterm-256color"

38− , "xterm-vt220"

39− , "xterm-debian"

40− , "xterm-mono"

41− , "xterm-color"

42− , "xterm"

43− , "mach"

44− , "mach-bold"

45− , "mach-color"

46− , "linux"

47− , "ansi"

48− , "hurd"

49− , "Eterm"

50− , "pcansi"

51− , "screen-256color"

52− , "screen-bce"

53− , "screen-s"

54− , "screen-w"

55− , "screen"

56− , "screen-256color-bce"

57− , "sun"

58− , "rxvt"

59− , "rxvt-unicode"

60− , "rxvt-basic"

61− , "cygwin"

62− , "cons25"

63− , "dumb"

64− ]

65−

66-- If a terminal defines one of the caps then it's expected to be parsable.

26-- If a terminal defines one of the caps then it's expected to be parsable.

67caps_of_interest =

27caps_of_interest =

68 [ "cup"

28 [ "cup"

test/VerifyParseTerminfoCaps.hs+2−42

@@ -6,6 +6,7 @@ import Prelude hiding ( catch )

6import qualified System.Console.Terminfo as Terminfo

7

8import Verify.Data.Terminfo.Parse

9+import Verify.Graphics.Vty.Terminal

9import Verify

10import Verify

10

11

11import Data.Maybe ( catMaybes, fromJust )

12import Data.Maybe ( catMaybes, fromJust )

@@ -13,48 +14,8 @@ import Data.Word

13

14

14import Numeric

15import Numeric

15

16

16−-- A list of terminals that ubuntu includes a terminfo cap file for.

17−-- Assuming that is a good place to start.

18−terminals_of_interest =

19− [ "wsvt25"

20− , "wsvt25m"

21− , "vt52"

22− , "vt100"

23− , "vt220"

24− , "vt102"

25− , "xterm-r5"

26− , "xterm-xfree86"

27− , "xterm-r6"

28− , "xterm-256color"

29− , "xterm-vt220"

30− , "xterm-debian"

31− , "xterm-mono"

32− , "xterm-color"

33− , "xterm"

34− , "mach"

35− , "mach-bold"

36− , "mach-color"

37− , "linux"

38− , "ansi"

39− , "hurd"

40− , "Eterm"

41− , "pcansi"

42− , "screen-256color"

43− , "screen-bce"

44− , "screen-s"

45− , "screen-w"

46− , "screen"

47− , "screen-256color-bce"

48− , "sun"

49− , "rxvt"

50− , "rxvt-unicode"

51− , "rxvt-basic"

52− , "cygwin"

53− , "cons25"

54− , "dumb"

55− ]

56−

57-- If a terminal defines one of the caps then it's expected to be parsable.

17-- If a terminal defines one of the caps then it's expected to be parsable.

18+-- TODO: reduce duplication with terminfo terminal implementation.

58caps_of_interest =

19caps_of_interest =

59 [ "cup"

20 [ "cup"

60 , "sc"

21 , "sc"

@@ -80,7 +41,6 @@ from_capname ti name = fromJust $ Terminfo.getCapability ti (Terminfo.tiGetStr n

80tests :: IO [Test]

41tests :: IO [Test]

81tests = do

42tests = do

82 parse_tests <- concat <$> forM terminals_of_interest ( \term_name -> do

43 parse_tests <- concat <$> forM terminals_of_interest ( \term_name -> do

83− putStrLn $ "testing parsing of caps for terminal: " ++ term_name

84 mti <- liftIO $ try $ Terminfo.setupTerm term_name

44 mti <- liftIO $ try $ Terminfo.setupTerm term_name

85 case mti of

45 case mti of

86 Left (_e :: SomeException)

46 Left (_e :: SomeException)

test/VerifyUsingMockInput.hs+19−8

@@ -5,6 +5,8 @@

5module VerifyUsingMockInput where

6import Verify hiding (classify)

7

8+import Verify.Graphics.Vty.Terminal

9+

8import Graphics.Vty hiding (resize)

10import Graphics.Vty hiding (resize)

9import Graphics.Vty.Input

11import Graphics.Vty.Input

10import Graphics.Vty.Input.Data

12import Graphics.Vty.Input.Data

@@ -46,12 +48,15 @@ assert_events_from_input_block table input_spec expected_events = do

46 input <- newChan

48 input <- newChan

47 output <- newChan

49 output <- newChan

48 forkIO $ write_input_spec_to_chan input input_spec

50 forkIO $ write_input_spec_to_chan input input_spec

51+ inputToEventThread classifier input output

52+ -- H: all events are available in output channel

53+ -- TODO: switch to using explicit control events. Currently the channel is passing around a

54+ -- magic FFFX characters

55+ -- TODO: use STM channel

49− handle (\(e :: BlockedIndefinitelyOnMVar) ->

56+ let collect_events = handle (\(e :: BlockedIndefinitelyOnMVar) -> return [])

50− return $ failed { reason = show expected_events ++ " -> " ++ show e }

57+ ((:) <$> readChan output <*> collect_events)

51− ) $ do

58+ out_events <- collect_events

52− inputToEventThread classifier input output

53− out_events <- replicateM (length expected_events) (readChan output)

54− return $ out_events ?== expected_events

59+ return $ out_events ?== expected_events

55

60

56write_input_spec_to_chan :: Chan Char -> InputSpec -> IO ()

61write_input_spec_to_chan :: Chan Char -> InputSpec -> IO ()

57write_input_spec_to_chan chan [] = writeChan chan '\xFFFD'

62write_input_spec_to_chan chan [] = writeChan chan '\xFFFD'

@@ -62,15 +67,21 @@ write_input_spec_to_chan chan (Delay t : input_spec')

62

67

63verify_simple_input_block_to_event :: Property

68verify_simple_input_block_to_event :: Property

64verify_simple_input_block_to_event = do

69verify_simple_input_block_to_event = do

70+ -- Ouch! 16 is as high as this can go without taking far too long. :-\

65 Positive block_length <- resize 16 $ arbitrary

71 Positive block_length <- resize 16 $ arbitrary

66 block_event_pairs <- vectorOf block_length $ elements $ simple_chars

72 block_event_pairs <- vectorOf block_length $ elements $ simple_chars

67 let input = [Bytes $ concatMap fst block_event_pairs]

73 let input = [Bytes $ concatMap fst block_event_pairs]

68 events = map (\(k,ms) -> EvKey k ms) $ map snd block_event_pairs

74 events = map (\(k,ms) -> EvKey k ms) $ map snd block_event_pairs

69 morallyDubiousIOProperty $ assert_events_from_input_block simple_chars input events

75 morallyDubiousIOProperty $ assert_events_from_input_block simple_chars input events

70

76

77+verify_keys_from_caps_table :: String -> Result

78+verify_keys_from_caps_table term_name = succeeded

79+

71tests :: IO [Test]

80tests :: IO [Test]

72tests = return

81tests = return

73− [ verify "basic block generated from ansi table to event translation"

82+ [ verify "basic block generated from single ansi chars to event translation"

74− verify_simple_input_block_to_event

83+ verify_simple_input_block_to_event

84+ , verify "keys from caps table are parsed to the same key"

85+ verify_keys_from_caps_table

75 ]

86 ]

76

87

vty.cabal+3

@@ -148,6 +148,7 @@ test-suite verify-using-mock-terminal

148 deepseq >= 1.1 && < 1.4,

149 mtl >= 1.1.1.0 && < 2.2,

150 text >= 0.11.3,

151+ terminfo,

151 unix,

152 unix,

152 utf8-string >= 0.3 && < 0.4,

153 utf8-string >= 0.3 && < 0.4,

153 vector >= 0.7

154 vector >= 0.7

@@ -253,6 +254,7 @@ test-suite verify-eval-terminfo-caps

253 test-module: VerifyEvalTerminfoCaps

254 test-module: VerifyEvalTerminfoCaps

254

255

255 other-modules: Verify

256 other-modules: Verify

257+ Verify.Graphics.Vty.Terminal

256

258

257 build-depends: vty,

259 build-depends: vty,

258 Cabal == 1.18.*,

260 Cabal == 1.18.*,

@@ -364,6 +366,7 @@ test-suite verify-parse-terminfo-caps

364

366

365 other-modules: Verify

367 other-modules: Verify

366 Verify.Data.Terminfo.Parse

368 Verify.Data.Terminfo.Parse

369+ Verify.Graphics.Vty.Terminal

367

370

368 build-depends: vty,

371 build-depends: vty,

369 Cabal == 1.18.*,

372 Cabal == 1.18.*,