cleanup

src/Graphics/Vty/Input.hs

@@ -22,9 +22,9 @@ import System.Console.Terminfo
 import System.Posix.Signals.Exts
 import System.Posix.Terminal
 import System.Posix.IO ( stdInput
-                        ,fdReadBuf
-                        ,setFdOption
-                        ,FdOption(..)
+                       , fdReadBuf
+                       , setFdOption
+                       , FdOption(..)
                        )
 
 import Foreign ( alloca, poke, peek, Ptr )
@@ -77,7 +77,7 @@ initTermInput escDelay terminal = do
                     loop
 
         extract_cap = first (getCapability terminal . tiGetStr)
-        caps_classify_table = map_to_legacy_table [(x,y) | (Just x,y) <- map extract_cap caps_table]
+        caps_classify_table = map_to_legacy_table [(x,y) | (Just x,y) <- map extract_cap keys_from_caps_table]
         term_event_classify_table = concat $ caps_classify_table : ansi_classify_table
         term_event_classifier = classify term_event_classify_table
 

src/Graphics/Vty/Input/Data.hs

@@ -38,8 +38,8 @@ map_to_legacy_table = map f
           f _                 = error "no mapping for mouse or resize events"
 
 -- | classify table directly generated from terminfo cap strings
-caps_table :: [(String, Event)]
-caps_table =
+keys_from_caps_table :: [(String, Event)]
+keys_from_caps_table =
     [ ("khome", EvKey KHome     [])
     , ("kend",  EvKey KEnd      [])
     , ("cbt",   EvKey KBackTab  [])

test/Verify.hs

@@ -14,6 +14,7 @@ module Verify ( module Verify
               , module Control.Monad
               , module Test.QuickCheck
               , module Test.QuickCheck.Modifiers
+              , module Text.Printf
               , succeeded
               , failed
               , result
@@ -37,6 +38,8 @@ import Test.QuickCheck.Property hiding ( Result(..) )
 import qualified Test.QuickCheck.Property as Prop
 import Test.QuickCheck.Monadic ( monadicIO ) 
 
+import Text.Printf
+
 import qualified Codec.Binary.UTF8.String as UTF8
 
 import Control.Applicative hiding ( (<|>) )

test/Verify/Graphics/Vty/Terminal.hs

@@ -8,9 +8,12 @@ import qualified Data.String.UTF8 as UTF8
 
 import Test.QuickCheck.Property
 
+import Verify
+
 -- A list of terminals that should be supported.
 -- This started with a list of terminals ubuntu supported. Then those terminals that really could
--- not be supported were removed.
+-- not be supported were removed. Then a few more were pruned until a reasonable looking set was
+-- made.
 terminals_of_interest = 
     [ "vt100"
     , "vt220"

test/VerifyEvalTerminfoCaps.hs

@@ -11,6 +11,7 @@ import Control.DeepSeq
 import qualified System.Console.Terminfo as Terminfo
 
 import Verify
+import Verify.Graphics.Vty.Terminal
 
 import Control.Applicative ( (<$>) )
 import Control.Exception ( try, SomeException(..) )
@@ -22,47 +23,6 @@ import Data.Word
 
 import Numeric
 
--- A list of terminals that ubuntu includes a terminfo cap file for. 
--- Assuming that is a good place to start.
-terminals_of_interest = 
-    [ "wsvt25"
-    , "wsvt25m"
-    , "vt52"
-    , "vt100"
-    , "vt220"
-    , "vt102"
-    , "xterm-r5"
-    , "xterm-xfree86"
-    , "xterm-r6"
-    , "xterm-256color"
-    , "xterm-vt220"
-    , "xterm-debian"
-    , "xterm-mono"
-    , "xterm-color"
-    , "xterm"
-    , "mach"
-    , "mach-bold"
-    , "mach-color"
-    , "linux"
-    , "ansi"
-    , "hurd"
-    , "Eterm"
-    , "pcansi"
-    , "screen-256color"
-    , "screen-bce"
-    , "screen-s"
-    , "screen-w"
-    , "screen"
-    , "screen-256color-bce"
-    , "sun"
-    , "rxvt"
-    , "rxvt-unicode"
-    , "rxvt-basic"
-    , "cygwin"
-    , "cons25"
-    , "dumb"
-    ]
-
 -- If a terminal defines one of the caps then it's expected to be parsable.
 caps_of_interest = 
     [ "cup"

test/VerifyParseTerminfoCaps.hs

@@ -6,6 +6,7 @@ import Prelude hiding ( catch )
 import qualified System.Console.Terminfo as Terminfo
 
 import Verify.Data.Terminfo.Parse
+import Verify.Graphics.Vty.Terminal
 import Verify
 
 import Data.Maybe ( catMaybes, fromJust )
@@ -13,48 +14,8 @@ import Data.Word
 
 import Numeric
 
--- A list of terminals that ubuntu includes a terminfo cap file for. 
--- Assuming that is a good place to start.
-terminals_of_interest = 
-    [ "wsvt25"
-    , "wsvt25m"
-    , "vt52"
-    , "vt100"
-    , "vt220"
-    , "vt102"
-    , "xterm-r5"
-    , "xterm-xfree86"
-    , "xterm-r6"
-    , "xterm-256color"
-    , "xterm-vt220"
-    , "xterm-debian"
-    , "xterm-mono"
-    , "xterm-color"
-    , "xterm"
-    , "mach"
-    , "mach-bold"
-    , "mach-color"
-    , "linux"
-    , "ansi"
-    , "hurd"
-    , "Eterm"
-    , "pcansi"
-    , "screen-256color"
-    , "screen-bce"
-    , "screen-s"
-    , "screen-w"
-    , "screen"
-    , "screen-256color-bce"
-    , "sun"
-    , "rxvt"
-    , "rxvt-unicode"
-    , "rxvt-basic"
-    , "cygwin"
-    , "cons25"
-    , "dumb"
-    ]
-
 -- If a terminal defines one of the caps then it's expected to be parsable.
+-- TODO: reduce duplication with terminfo terminal implementation.
 caps_of_interest = 
     [ "cup"
     , "sc"
@@ -80,7 +41,6 @@ from_capname ti name = fromJust $ Terminfo.getCapability ti (Terminfo.tiGetStr n
 tests :: IO [Test]
 tests = do
     parse_tests <- concat <$> forM terminals_of_interest ( \term_name -> do
-        putStrLn $ "testing parsing of caps for terminal: " ++ term_name
         mti <- liftIO $ try $ Terminfo.setupTerm term_name
         case mti of
             Left (_e :: SomeException)

test/VerifyUsingMockInput.hs

@@ -5,6 +5,8 @@
 module VerifyUsingMockInput where
 import Verify hiding (classify)
 
+import Verify.Graphics.Vty.Terminal
+
 import Graphics.Vty hiding (resize)
 import Graphics.Vty.Input
 import Graphics.Vty.Input.Data
@@ -46,12 +48,15 @@ assert_events_from_input_block table input_spec expected_events = do
     input <- newChan
     output <- newChan
     forkIO $ write_input_spec_to_chan input input_spec
-    handle (\(e :: BlockedIndefinitelyOnMVar) ->
-                return $ failed { reason = show expected_events ++ " -> " ++ show e }
-           ) $ do
-        inputToEventThread classifier input output
-        out_events <- replicateM (length expected_events) (readChan output)
-        return $ out_events ?== expected_events
+    inputToEventThread classifier input output
+    -- H: all events are available in output channel
+    -- TODO: switch to using explicit control events. Currently the channel is passing around a
+    -- magic FFFX characters
+    -- TODO: use STM channel
+    let collect_events = handle (\(e :: BlockedIndefinitelyOnMVar) -> return [])
+                                ((:) <$> readChan output <*> collect_events)
+    out_events <- collect_events
+    return $ out_events ?== expected_events
 
 write_input_spec_to_chan :: Chan Char -> InputSpec -> IO ()
 write_input_spec_to_chan chan [] = writeChan chan '\xFFFD'
@@ -62,15 +67,21 @@ write_input_spec_to_chan chan (Delay t : input_spec')
 
 verify_simple_input_block_to_event :: Property
 verify_simple_input_block_to_event = do
+    -- Ouch! 16 is as high as this can go without taking far too long. :-\
     Positive block_length <- resize 16 $ arbitrary
     block_event_pairs <- vectorOf block_length $ elements $ simple_chars
     let input = [Bytes $ concatMap fst block_event_pairs]
         events = map (\(k,ms) -> EvKey k ms) $ map snd block_event_pairs
     morallyDubiousIOProperty $ assert_events_from_input_block simple_chars input events
 
+verify_keys_from_caps_table :: String -> Result
+verify_keys_from_caps_table term_name = succeeded
+
 tests :: IO [Test]
 tests = return
-    [ verify "basic block generated from ansi table to event translation"
-             verify_simple_input_block_to_event
+    [ verify "basic block generated from single ansi chars to event translation"
+        verify_simple_input_block_to_event
+    , verify "keys from caps table are parsed to the same key"
+        verify_keys_from_caps_table
     ]
 

vty.cabal

@@ -148,6 +148,7 @@ test-suite verify-using-mock-terminal
                        deepseq >= 1.1 && < 1.4,
                        mtl >= 1.1.1.0 && < 2.2,
                        text >= 0.11.3,
+                       terminfo,
                        unix,
                        utf8-string >= 0.3 && < 0.4,
                        vector >= 0.7
@@ -253,6 +254,7 @@ test-suite verify-eval-terminfo-caps
   test-module:         VerifyEvalTerminfoCaps
 
   other-modules:       Verify
+                       Verify.Graphics.Vty.Terminal
 
   build-depends:       vty,
                        Cabal == 1.18.*,
@@ -364,6 +366,7 @@ test-suite verify-parse-terminfo-caps
 
   other-modules:       Verify
                        Verify.Data.Terminfo.Parse
+                       Verify.Graphics.Vty.Terminal
 
   build-depends:       vty,
                        Cabal == 1.18.*,