522b740 · vty · git.iko.soy

git.iko.soy/vty

on master help sign in

add a debug log for input

522b740Corey O'Connor12 years ago

CHANGELOG+15−5

compare with master

unifiedsplit

@@ -1,17 +1,21 @@

15.0.0

2 * The naming convention now matches:

3 * http://www.haskell.org/haskellwiki/Programming_guidelines#Naming_Conventions

4− * all projects using vty for input must be compiled with -threaded. This could be resolved but

4+ * all projects using vty for input must be compiled with -threaded. Please notify vty author if

5− would like to avoid the complexity for now.

5+ this is not acceptable.

6 * mkVtyEscDelay has been removed. Use "mkVty def". Which initialized vty with the default

7 configuration.

8 * input handling changes

9 * KASCII is now KChar

10 * KPN5 is now KCenter

11 * tests exist.

12+ * Applications add to the input tables by setting inputOverrides of the Config.

13+ See Graphics.Vty.Config

14+ * Users can define input table extensions that will apply to all vty applications.

15+ See Graphics.Vty.Config

12 * terminal timing is now handled by selecting an appropriate VTIME. Previously this was

16 * terminal timing is now handled by selecting an appropriate VTIME. Previously this was

13− implemented within Vty itself. This reduced complexity in vty but potentially provides

17+ implemented within Vty itself. This reduced complexity in vty but provides a different

14− a different meta key behavior.

18+ meta key behavior. There were no know users of the previous behavior.

15 * The time vty will wait to verify an ESC byte means a single ESC key is the

19 * The time vty will wait to verify an ESC byte means a single ESC key is the

16 singleEscPeriod of the Input Config structure.

20 singleEscPeriod of the Input Config structure.

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

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

@@ -25,7 +29,7 @@

25 * Each layer is an image.

29 * Each layer is an image.

26 * The layers for a picture are a list of images.

30 * The layers for a picture are a list of images.

27 * The first image is the top-most layer. The images are ordered from top to bottom.

31 * The first image is the top-most layer. The images are ordered from top to bottom.

28− * The transparent areas for a layer are the background_fill areas. These will be implicitly

32+ * The transparent areas for a layer are the backgroundFill areas. These will be implicitly

29 added to to pad images when images of different sizes are joined.

33 added to to pad images when images of different sizes are joined.

30 * If the background is clear there is no background layer.

34 * If the background is clear there is no background layer.

31 * If there is a background character then the bottom layer is the background layer.

35 * If there is a background character then the bottom layer is the background layer.

@@ -37,6 +41,12 @@

37 * alternate (setf/setb) color maps supported. Though colors beyond the first 8 are just a

41 * alternate (setf/setb) color maps supported. Though colors beyond the first 8 are just a

38 guess.

42 guess.

39 * added "rgbColor" for easy support of RGB specified colors.

43 * added "rgbColor" for easy support of RGB specified colors.

44+ * Both applications and users can add to the mapping used to translate from input bytes to

45+ events.

46+ * Additional information about input and output process can be appended to a debug log

47+ * Set environment variable VTY_DEBUG_LOG to path of debug log

48+ * Use "debugLog <path>" config directive

49+ * Set 'debugLog' property of Config

40 * examples moved to vty-examples package. See test directory for cabal file.

50 * examples moved to vty-examples package. See test directory for cabal file.

41 * vty-interactive-terminal-test

51 * vty-interactive-terminal-test

42 * interactive test. Useful for building a bug report for vty's author.

52 * interactive test. Useful for building a bug report for vty's author.

src/Graphics/Vty.hs+2−2

@@ -109,8 +109,8 @@ data Vty = Vty

109mkVty :: Config -> IO Vty

110mkVty appConfig = do

111 config <- mappend <$> pure appConfig <*> userConfig

112− input <- inputForCurrentTerminal config

112+ input <- inputForCurrentTerminal config

113− out <- outputForCurrentTerminal

113+ out <- outputForCurrentTerminal config

114 intMkVty input out

115

116intMkVty :: Input -> Output -> IO Vty

src/Graphics/Vty/Config.hs+46−12

@@ -10,18 +10,37 @@

10-- Each line of the input config is processed individually. Lines that fail to parse are ignored.

11-- Later entries take precedence over earlier.

12--

13−-- = Classify Table Overrides

13+-- For all directives:

14+--

15+-- @

16+-- string := \"\\\"\" chars+ \"\\\"\"

17+-- @

18+--

19+-- = Debug Directives

20+--

21+-- == @debugLog@

22+--

23+-- Format:

24+--

25+-- @

26+-- \"debugLog\" string

27+-- @

28+--

29+-- The value of the environment variable @VTY_DEBUG_LOG@ is equivalent to a debugLog entry at the

30+-- end of the last config file.

31+--

32+-- = Input Table Directives

14--

33--

15-- == @map@

34-- == @map@

16--

35--

17-- Directive format:

36-- Directive format:

18--

37--

19-- @

38-- @

20−-- entry := \"map\" string key modifier_list

39+-- \"map\" string key modifier_list

40+-- where

21−-- key := KEsc | KChar Char | KBS ... (same as 'Key')

41+-- key := KEsc | KChar Char | KBS ... (same as 'Key')

22−-- modifier_list := \"[\" modifier+ \"]\"

42+-- modifier_list := \"[\" modifier+ \"]\"

23−-- modifier := MShift | MCtrl | MMeta | MAlt

43+-- modifier := MShift | MCtrl | MMeta | MAlt

24−-- string := \"\\\"\" chars+ \"\\\"\"

25-- @

44-- @

26--

45--

27-- EG: If the contents are

46-- EG: If the contents are

@@ -34,6 +53,12 @@

34-- Then the bytes @\"\\ESC[B\"@ will result in the KUp event. The bytes @\"\\ESC[1;3B\"@ will result

53-- Then the bytes @\"\\ESC[B\"@ will result in the KUp event. The bytes @\"\\ESC[1;3B\"@ will result

35-- in the event KDown with the MAlt modifier.

54-- in the event KDown with the MAlt modifier.

36--

55--

56+-- If a debug log is requested then vty will output the current input table to the log in the above

57+-- format.

58+--

59+-- EG: Set VTY_DEBUG_LOG. Run vty. Check debug log for incorrect mappings. Add corrected mappings to

60+-- .vty/config

61+--

37module Graphics.Vty.Config where

62module Graphics.Vty.Config where

39-- ignore warning on GHC 7.6+. Required for GHC 7.4

64-- ignore warning on GHC 7.6+. Required for GHC 7.4

@@ -62,9 +87,10 @@ import qualified Text.Parsec.Token as P

63data Config = Config

88data Config = Config

64 { specifiedEscPeriod :: Maybe Int

89 { specifiedEscPeriod :: Maybe Int

65− -- | Debug information is appended to the file.

90+ -- | Debug information is appended to this file if not Nothing.

66 , debugLog :: Maybe FilePath

91 , debugLog :: Maybe FilePath

67− -- | The (input byte, output event) pairs override VTY\'s built-in tables as well as terminfo.

92+ -- | The (input byte, output event) pairs extend the internal input table of VTY and the table

93+ -- from terminfo.

68 --

94 --

69 -- See "Graphics.Vty.Config" module documentation for documentation of the @map@ directive.

95 -- See "Graphics.Vty.Config" module documentation for documentation of the @map@ directive.

70 , inputOverrides :: ClassifyTable

96 , inputOverrides :: ClassifyTable

@@ -97,10 +123,12 @@ type ConfigParser s a = ParsecT s () (Writer Config) a

97-- | Config from @'getAppUserDataDirectory'/config@ and @$VTY_CONFIG_FILE@

123-- | Config from @'getAppUserDataDirectory'/config@ and @$VTY_CONFIG_FILE@

98userConfig :: IO Config

124userConfig :: IO Config

99userConfig = do

125userConfig = do

100− vtyConfig <- (mappend <$> getAppUserDataDirectory "vty" <*> pure "/config") >>= parseConfigFile

126+ userConfig <- (mappend <$> getAppUserDataDirectory "vty" <*> pure "/config") >>= parseConfigFile

101 overridePath <- tryJust (guard . isDoesNotExistError) $ getEnv "VTY_CONFIG_FILE"

127 overridePath <- tryJust (guard . isDoesNotExistError) $ getEnv "VTY_CONFIG_FILE"

102 overrideConfig <- either (const $ return def) parseConfigFile overridePath

128 overrideConfig <- either (const $ return def) parseConfigFile overridePath

103− return $ vtyConfig `mappend` overrideConfig

129+ debugLogPath <- tryJust (guard . isDoesNotExistError) $ getEnv "VTY_DEBUG_LOG"

130+ let debugLogConfig = either (const $ return def) (def { debugLog = Just debugLogPath })

131+ return $ mconcat [userConfig, overrideConfig, debugLogConfig]

104

132

105parseConfigFile :: FilePath -> IO Config

133parseConfigFile :: FilePath -> IO Config

106parseConfigFile path = do

134parseConfigFile path = do

@@ -130,7 +158,7 @@ configLanguage = LanguageDef

130configLexer :: Stream s m Char => P.GenTokenParser s u m

158configLexer :: Stream s m Char => P.GenTokenParser s u m

131configLexer = P.makeTokenParser configLanguage

159configLexer = P.makeTokenParser configLanguage

132

160

133−parseOverride = do

161+mapDecl = do

134 void $ string "map"

162 void $ string "map"

135 P.whiteSpace configLexer

163 P.whiteSpace configLexer

136 bytes <- P.stringLiteral configLexer

164 bytes <- P.stringLiteral configLexer

@@ -181,9 +209,15 @@ parseModifier = do

181 "MAlt" -> return MAlt

209 "MAlt" -> return MAlt

182 _ -> fail $ m ++ " is not a valid modifier identifier"

210 _ -> fail $ m ++ " is not a valid modifier identifier"

183

211

212+debugLogDecl = do

213+ void $ string "debugLog"

214+ P.whiteSpace configLexer

215+ path <- P.stringLiteral configLexer

216+ lift $ tell $ def { debugLog = Just path }

217+

184ignoreLine = void $ manyTill anyChar newline

218ignoreLine = void $ manyTill anyChar newline

185

219

186parseConfig = void $ many $ do

220parseConfig = void $ many $ do

187 P.whiteSpace configLexer

221 P.whiteSpace configLexer

188− let directives = [parseOverride]

222+ let directives = [mapDecl, debugLogDecl]

189 try (choice directives) <|> ignoreLine

223 try (choice directives) <|> ignoreLine

src/Graphics/Vty/Input/Loop.hs+18

@@ -28,10 +28,13 @@ import Data.Word (Word8)

28import Foreign ( allocaArray, peekArray, Ptr )

29import Foreign.C.Types (CInt(..))

31+import System.IO

31import System.Posix.IO (fdReadBuf)

32import System.Posix.IO (fdReadBuf)

32import System.Posix.Terminal

33import System.Posix.Terminal

33import System.Posix.Types (Fd(..))

34import System.Posix.Types (Fd(..))

36+import Text.Printf (hPrintf)

37+

35data Input = Input

38data Input = Input

36 { -- | Channel of events direct from input processing. Unlike 'nextEvent' this will not refresh

39 { -- | Channel of events direct from input processing. Unlike 'nextEvent' this will not refresh

37 -- the display if the next event is an 'EvResize'.

40 -- the display if the next event is an 'EvResize'.

@@ -43,6 +46,8 @@ data Input = Input

43 , _configRef :: IORef Config

46 , _configRef :: IORef Config

44 -- | File descriptor used for input.

47 -- | File descriptor used for input.

45 , _inputFd :: Fd

48 , _inputFd :: Fd

49+ -- | input debug log

50+ , _inputDebug :: Maybe Handle

46 }

51 }

48makeLenses ''Input

53makeLenses ''Input

@@ -147,6 +152,16 @@ attributeControl fd = do

147 unsetAttrs = setTerminalAttributes fd original Immediately

152 unsetAttrs = setTerminalAttributes fd original Immediately

148 return (setAttrs,unsetAttrs)

153 return (setAttrs,unsetAttrs)

149

154

155+logClassifyTable :: Input -> ClassifyTable -> IO()

156+logClassifyTable input classifyTable = case _inputDebug input of

157+ Nothing -> return ()

158+ Just h -> do

159+ forM_ classifyTable $ \i -> case i of

160+ (inBytes, EvKey k mods) -> hPrintf h "map %s %s %s\n" (show inBytes)

161+ (show k)

162+ (show mods)

163+ _ -> return ()

164+

150initInputForFd :: Config -> ClassifyTable -> Fd -> IO Input

165initInputForFd :: Config -> ClassifyTable -> Fd -> IO Input

151initInputForFd config classifyTable inFd = do

166initInputForFd config classifyTable inFd = do

152 applyTimingConfig inFd config

167 applyTimingConfig inFd config

@@ -155,6 +170,9 @@ initInputForFd config classifyTable inFd = do

155 <*> pure (writeIORef stopFlag True)

170 <*> pure (writeIORef stopFlag True)

156 <*> newIORef config

171 <*> newIORef config

157 <*> pure inFd

172 <*> pure inFd

173+ <*> maybe Nothing (\f -> Just <$> openFile f AppendMode)

174+ (debugLog config)

175+ logClassifyTable classifyTable

158 _ <- forkOS $ runInputProcessorLoop classifyTable input stopFlag

176 _ <- forkOS $ runInputProcessorLoop classifyTable input stopFlag

159 return input

177 return input

160

178

src/Graphics/Vty/Output.hs+2−2

@@ -74,8 +74,8 @@ import System.IO

74--

75-- \todo add an implementation for windows that does not depend on terminfo. Should be installable

76-- with only what is provided in the haskell platform. Use ansi-terminal

77−outputForCurrentTerminal :: ( Applicative m, MonadIO m ) => m Output

77+outputForCurrentTerminal :: ( Applicative m, MonadIO m ) => Config -> m Output

78−outputForCurrentTerminal = do

78+outputForCurrentTerminal _config = do

79 termType <- liftIO $ getEnv "TERM"

80 outHandle <- liftIO $ hDuplicate stdout

81 outputForNameAndIO termType outHandle

test/VerifyConfig.hs+2−1

@@ -24,12 +24,13 @@ exampleConfig = [s|

24map "\ESC[B" KUp []

25askfjla dfasjdflk jasdlkfj asdfj -- lines failing parse should be ignored

26map "\ESC[1;3B" KDown [MAlt]

27+debugLog "/tmp/vty-debug.txt"

27|]

28|]

29exampleConfigConfig :: Config

30exampleConfigConfig :: Config

30exampleConfigConfig = Config

31exampleConfigConfig = Config

31 { specifiedEscPeriod = def

32 { specifiedEscPeriod = def

32− , debugLog = def

33+ , debugLog = Just "/tmp/vty-debug.txt"

33 , inputOverrides = [("\ESC[B", EvKey KUp []), ("\ESC[1;3B", EvKey KDown [MAlt])]

34 , inputOverrides = [("\ESC[B", EvKey KUp []), ("\ESC[1;3B", EvKey KDown [MAlt])]

34 }

35 }

vty.cabal+2−2

@@ -21,8 +21,8 @@ description:

21 If your terminal is not behaving as expected the results of the vty-interactive-terminal-test

22 executable should be sent to the Vty maintainter to aid in debugging the issue.

23 .

24− Notable infelicities: Sometimes poor efficiency; Assumes UTF-8 character encoding support by the

24+ Notable infelicities: Assumes UTF-8 character encoding support by the terminal; Poor signal

25− terminal; Poor signal handling; Requires terminfo.

25+ handling; Requires terminfo.

26 .

27 Project is hosted on github.com: https:\/\/github.com\/coreyoconnor\/vty

28 .