add a debug log for input

CHANGELOG

@@ -1,17 +1,21 @@
 5.0.0
     * The naming convention now matches:
         * http://www.haskell.org/haskellwiki/Programming_guidelines#Naming_Conventions
-    * all projects using vty for input must be compiled with -threaded. This could be resolved but
-      would like to avoid the complexity for now.
+    * all projects using vty for input must be compiled with -threaded. Please notify vty author if
+      this is not acceptable.
     * mkVtyEscDelay has been removed. Use "mkVty def". Which initialized vty with the default
       configuration.
     * input handling changes
         * KASCII is now KChar
         * KPN5 is now KCenter
         * tests exist.
+        * Applications add to the input tables by setting inputOverrides of the Config.
+          See Graphics.Vty.Config
+        * Users can define input table extensions that will apply to all vty applications.
+          See Graphics.Vty.Config
         * terminal timing is now handled by selecting an appropriate VTIME. Previously this was
-          implemented within Vty itself. This reduced complexity in vty but potentially provides
-          a different meta key behavior.
+          implemented within Vty itself. This reduced complexity in vty but provides a different
+          meta key behavior. There were no know users of the previous behavior.
         * The time vty will wait to verify an ESC byte means a single ESC key is the
           singleEscPeriod of the Input Config structure.
     * removed the typeclass based terminal and display context interface in favor of a data
@@ -25,7 +29,7 @@
         * Each layer is an image.
         * The layers for a picture are a list of images.
         * The first image is the top-most layer. The images are ordered from top to bottom.
-        * The transparent areas for a layer are the background_fill areas. These will be implicitly
+        * The transparent areas for a layer are the backgroundFill areas. These will be implicitly
           added to to pad images when images of different sizes are joined.
         * If the background is clear there is no background layer.
         * If there is a background character then the bottom layer is the background layer.
@@ -37,6 +41,12 @@
         * alternate (setf/setb) color maps supported. Though colors beyond the first 8 are just a
           guess.
         * added "rgbColor" for easy support of RGB specified colors.
+        * Both applications and users can add to the mapping used to translate from input bytes to
+          events.
+    * Additional information about input and output process can be appended to a debug log
+        * Set environment variable VTY_DEBUG_LOG to path of debug log
+        * Use "debugLog <path>" config directive
+        * Set 'debugLog' property of Config
     * examples moved to vty-examples package. See test directory for cabal file.
         * vty-interactive-terminal-test
             * interactive test. Useful for building a bug report for vty's author.

src/Graphics/Vty.hs

@@ -109,8 +109,8 @@ data Vty = Vty
 mkVty :: Config -> IO Vty
 mkVty appConfig = do
     config <- mappend <$> pure appConfig <*> userConfig
-    input <- inputForCurrentTerminal config
-    out <- outputForCurrentTerminal
+    input  <- inputForCurrentTerminal config
+    out    <- outputForCurrentTerminal config
     intMkVty input out
 
 intMkVty :: Input -> Output -> IO Vty

src/Graphics/Vty/Config.hs

@@ -10,18 +10,37 @@
 -- Each line of the input config is processed individually. Lines that fail to parse are ignored.
 -- Later entries take precedence over earlier.
 --
--- = Classify Table Overrides
+-- For all directives:
+-- 
+-- @
+--  string := \"\\\"\" chars+ \"\\\"\"
+-- @
+--
+-- = Debug Directives
+--
+-- == @debugLog@
+--
+-- Format:
+--
+-- @
+--  \"debugLog\" string
+-- @
+--
+-- The value of the environment variable @VTY_DEBUG_LOG@ is equivalent to a debugLog entry at the
+-- end of the last config file.
+--
+-- = Input Table Directives
 --
 -- == @map@
 --
 -- Directive format:
 --
 -- @
---  entry := \"map\" string key modifier_list
---  key := KEsc | KChar Char | KBS ... (same as 'Key')
---  modifier_list := \"[\" modifier+ \"]\"
---  modifier := MShift | MCtrl | MMeta | MAlt
---  string := \"\\\"\" chars+ \"\\\"\"
+--  \"map\" string key modifier_list
+--  where 
+--      key := KEsc | KChar Char | KBS ... (same as 'Key')
+--      modifier_list := \"[\" modifier+ \"]\"
+--      modifier := MShift | MCtrl | MMeta | MAlt
 -- @
 --
 -- EG: If the contents are
@@ -34,6 +53,12 @@
 -- Then the bytes @\"\\ESC[B\"@ will result in the KUp event. The bytes @\"\\ESC[1;3B\"@ will result
 -- in the event KDown with the MAlt modifier.
 --
+-- If a debug log is requested then vty will output the current input table to the log in the above
+-- format.
+--
+-- EG: Set VTY_DEBUG_LOG. Run vty. Check debug log for incorrect mappings. Add corrected mappings to
+-- .vty/config
+--
 module Graphics.Vty.Config where
 
 -- ignore warning on GHC 7.6+. Required for GHC 7.4
@@ -62,9 +87,10 @@ import qualified Text.Parsec.Token as P
 
 data Config = Config
     { specifiedEscPeriod :: Maybe Int            
-    -- | Debug information is appended to the file.
+    -- | Debug information is appended to this file if not Nothing.
     , debugLog           :: Maybe FilePath
-    -- | The (input byte, output event) pairs override VTY\'s built-in tables as well as terminfo.
+    -- | The (input byte, output event) pairs extend the internal input table of VTY and the table
+    -- from terminfo.
     --
     -- See "Graphics.Vty.Config" module documentation for documentation of the @map@ directive.
     , inputOverrides     :: ClassifyTable
@@ -97,10 +123,12 @@ type ConfigParser s a = ParsecT s () (Writer Config) a
 -- | Config from @'getAppUserDataDirectory'/config@ and @$VTY_CONFIG_FILE@
 userConfig :: IO Config
 userConfig = do
-    vtyConfig <- (mappend <$> getAppUserDataDirectory "vty" <*> pure "/config") >>= parseConfigFile
+    userConfig <- (mappend <$> getAppUserDataDirectory "vty" <*> pure "/config") >>= parseConfigFile
     overridePath <- tryJust (guard . isDoesNotExistError) $ getEnv "VTY_CONFIG_FILE"
     overrideConfig <- either (const $ return def) parseConfigFile overridePath
-    return $ vtyConfig `mappend` overrideConfig
+    debugLogPath <- tryJust (guard . isDoesNotExistError) $ getEnv "VTY_DEBUG_LOG"
+    let debugLogConfig = either (const $ return def) (def { debugLog = Just debugLogPath })
+    return $ mconcat [userConfig, overrideConfig, debugLogConfig]
 
 parseConfigFile :: FilePath -> IO Config
 parseConfigFile path = do
@@ -130,7 +158,7 @@ configLanguage = LanguageDef
 configLexer :: Stream s m Char => P.GenTokenParser s u m
 configLexer = P.makeTokenParser configLanguage
 
-parseOverride = do
+mapDecl = do
     void $ string "map"
     P.whiteSpace configLexer
     bytes <- P.stringLiteral configLexer
@@ -181,9 +209,15 @@ parseModifier = do
         "MAlt" -> return MAlt
         _ -> fail $ m ++ " is not a valid modifier identifier"
 
+debugLogDecl = do
+    void $ string "debugLog"
+    P.whiteSpace configLexer
+    path <- P.stringLiteral configLexer
+    lift $ tell $ def { debugLog = Just path }
+
 ignoreLine = void $ manyTill anyChar newline
 
 parseConfig = void $ many $ do
     P.whiteSpace configLexer
-    let directives = [parseOverride]
+    let directives = [mapDecl, debugLogDecl]
     try (choice directives) <|> ignoreLine

src/Graphics/Vty/Input/Loop.hs

@@ -28,10 +28,13 @@ import Data.Word (Word8)
 import Foreign ( allocaArray, peekArray, Ptr )
 import Foreign.C.Types (CInt(..))
 
+import System.IO
 import System.Posix.IO (fdReadBuf)
 import System.Posix.Terminal
 import System.Posix.Types (Fd(..))
 
+import Text.Printf (hPrintf)
+
 data Input = Input
     { -- | Channel of events direct from input processing. Unlike 'nextEvent' this will not refresh
       -- the display if the next event is an 'EvResize'.
@@ -43,6 +46,8 @@ data Input = Input
     , _configRef :: IORef Config
       -- | File descriptor used for input.
     , _inputFd :: Fd
+      -- | input debug log
+    , _inputDebug :: Maybe Handle
     }
 
 makeLenses ''Input
@@ -147,6 +152,16 @@ attributeControl fd = do
         unsetAttrs = setTerminalAttributes fd original Immediately
     return (setAttrs,unsetAttrs)
 
+logClassifyTable :: Input -> ClassifyTable -> IO()
+logClassifyTable input classifyTable = case _inputDebug input of
+    Nothing -> return ()
+    Just h  -> do
+        forM_ classifyTable $ \i -> case i of
+            (inBytes, EvKey k mods) -> hPrintf h "map %s %s %s\n" (show inBytes)
+                                                                  (show k)
+                                                                  (show mods)
+            _ -> return ()
+
 initInputForFd :: Config -> ClassifyTable -> Fd -> IO Input
 initInputForFd config classifyTable inFd = do
     applyTimingConfig inFd config
@@ -155,6 +170,9 @@ initInputForFd config classifyTable inFd = do
                    <*> pure (writeIORef stopFlag True)
                    <*> newIORef config
                    <*> pure inFd
+                   <*> maybe Nothing (\f -> Just <$> openFile f AppendMode)
+                                     (debugLog config)
+    logClassifyTable classifyTable
     _ <- forkOS $ runInputProcessorLoop classifyTable input stopFlag
     return input
 

src/Graphics/Vty/Output.hs

@@ -74,8 +74,8 @@ import System.IO
 --
 -- \todo add an implementation for windows that does not depend on terminfo. Should be installable
 -- with only what is provided in the haskell platform. Use ansi-terminal
-outputForCurrentTerminal :: ( Applicative m, MonadIO m ) => m Output
-outputForCurrentTerminal = do
+outputForCurrentTerminal :: ( Applicative m, MonadIO m ) => Config -> m Output
+outputForCurrentTerminal _config = do
     termType <- liftIO $ getEnv "TERM"
     outHandle <- liftIO $ hDuplicate stdout
     outputForNameAndIO termType outHandle

test/VerifyConfig.hs

@@ -24,12 +24,13 @@ exampleConfig = [s|
 map "\ESC[B" KUp []
 askfjla dfasjdflk jasdlkfj asdfj -- lines failing parse should be ignored
 map "\ESC[1;3B" KDown [MAlt]
+debugLog "/tmp/vty-debug.txt"
 |]
 
 exampleConfigConfig :: Config
 exampleConfigConfig = Config
     { specifiedEscPeriod = def
-    , debugLog = def
+    , debugLog = Just "/tmp/vty-debug.txt"
     , inputOverrides = [("\ESC[B", EvKey KUp []), ("\ESC[1;3B", EvKey KDown [MAlt])]
     }
 

vty.cabal

@@ -21,8 +21,8 @@ description:
   If your terminal is not behaving as expected the results of the vty-interactive-terminal-test
   executable should be sent to the Vty maintainter to aid in debugging the issue.
   .
-  Notable infelicities: Sometimes poor efficiency; Assumes UTF-8 character encoding support by the
-  terminal; Poor signal handling; Requires terminfo.
+  Notable infelicities: Assumes UTF-8 character encoding support by the terminal; Poor signal
+  handling; Requires terminfo.
   .
   Project is hosted on github.com: https:\/\/github.com\/coreyoconnor\/vty
   .