git.iko.soy/vty
on master help sign in
perf: Process chunks of bracketed pastes only once.
547ab19iphydf
src/Graphics/Vty/Input/Classify.hs+32−11
compare with master
unifiedsplit
@@ -5,6 +5,7 @@
5module Graphics.Vty.Input.Classify
5module Graphics.Vty.Input.Classify
6 ( classify
6 ( classify
7 , KClass(..)
7 , KClass(..)
8+ , ClassifierState(..)
8 )
9 )
9where
10where
10
11
@@ -27,6 +28,17 @@ import qualified Data.ByteString as BS
27import qualified Data.ByteString.Char8 as BS8
28import qualified Data.ByteString.Char8 as BS8
28import Data.ByteString.Char8 (ByteString)
29import Data.ByteString.Char8 (ByteString)
29
30
31+-- | Whether the classifier is currently processing a chunked format.
32+-- Currently, only bracketed pastes use this.
33+data ClassifierState
34+ = ClassifierStart
35+ -- ^ Not processing a chunked format.
36+ | ClassifierInChunk ByteString [ByteString]
37+ -- ^ Currently processing a chunked format. The initial chunk is in the
38+ -- first argument and a reversed remainder of the chunks is collected in
39+ -- the second argument. At the end of the processing, the chunks are
40+ -- reversed and concatenated with the final chunk.
41+
30compile :: ClassifyMap -> ByteString -> KClass
42compile :: ClassifyMap -> ByteString -> KClass
31compile table = cl' where
43compile table = cl' where
32 -- take all prefixes and create a set of these
44 -- take all prefixes and create a set of these
@@ -54,18 +66,27 @@ compile table = cl' where
54 -- neither a prefix or a full event.
66 -- neither a prefix or a full event.
55 [] -> Invalid
67 [] -> Invalid
56
68
57−classify :: ClassifyMap -> ByteString -> KClass
69+classify :: ClassifyMap -> ClassifierState -> ByteString -> KClass
58−classify table =
70+classify table = process
71+ where
59− let standardClassifier = compile table
72+ standardClassifier = compile table
73+
74+ process ClassifierStart s =
60− in \s -> case BS.uncons s of
75+ case BS.uncons s of
61− _ | bracketedPasteStarted s ->
76+ _ | bracketedPasteStarted s ->
77+ if bracketedPasteFinished s
78+ then parseBracketedPaste s
79+ else Chunk
80+ _ | isMouseEvent s -> classifyMouseEvent s
81+ _ | isFocusEvent s -> classifyFocusEvent s
82+ Just (c,cs) | c >= 0xC2 -> classifyUtf8 c cs
83+ _ -> standardClassifier s
84+
85+ process (ClassifierInChunk p ps) s | bracketedPasteStarted p =
62 if bracketedPasteFinished s
86 if bracketedPasteFinished s
63− then parseBracketedPaste s
87+ then parseBracketedPaste $ BS.concat $ p:reverse (s:ps)
64− else Prefix
88+ else Chunk
65− _ | isMouseEvent s -> classifyMouseEvent s
89+ process ClassifierInChunk{} _ = Invalid
66− _ | isFocusEvent s -> classifyFocusEvent s
67− Just (c,cs) | c >= 0xC2 -> classifyUtf8 c cs
68− _ -> standardClassifier s
69
90
70classifyUtf8 :: Word8 -> ByteString -> KClass
91classifyUtf8 :: Word8 -> ByteString -> KClass
71classifyUtf8 c cs =
92classifyUtf8 c cs =
src/Graphics/Vty/Input/Classify/Types.hs+3
@@ -19,4 +19,7 @@ data KClass
19 | Prefix
19 | Prefix
20 -- ^ The input characters form the prefix of a valid event character
20 -- ^ The input characters form the prefix of a valid event character
21 -- sequence.
21 -- sequence.
22+ | Chunk
23+ -- ^ The input characters are either start of a bracketed paste chunk
24+ -- or in the middle of a bracketed paste chunk.
22 deriving(Show, Eq)
25 deriving(Show, Eq)
src/Graphics/Vty/Input/Loop.hs+20−7
@@ -80,9 +80,10 @@ makeLenses ''InputBuffer
80
80
81data InputState = InputState
81data InputState = InputState
82 { _unprocessedBytes :: ByteString
82 { _unprocessedBytes :: ByteString
83+ , _classifierState :: ClassifierState
83 , _appliedConfig :: Config
84 , _appliedConfig :: Config
84 , _inputBuffer :: InputBuffer
85 , _inputBuffer :: InputBuffer
85− , _classifier :: ByteString -> KClass
86+ , _classifier :: ClassifierState -> ByteString -> KClass
86 }
87 }
87
88
88makeLenses ''InputState
89makeLenses ''InputState
@@ -154,28 +155,40 @@ applyConfig _ _ = fail "(vty) applyConfig was not provided a complete configurat
154parseEvent :: InputM Event
155parseEvent :: InputM Event
155parseEvent = do
156parseEvent = do
156 c <- use classifier
157 c <- use classifier
158+ s <- use classifierState
157 b <- use unprocessedBytes
159 b <- use unprocessedBytes
158− case c b of
160+ case c s b of
159 Valid e remaining -> do
161 Valid e remaining -> do
160 logMsg $ "valid parse: " ++ show e
162 logMsg $ "valid parse: " ++ show e
161 logMsg $ "remaining: " ++ show remaining
163 logMsg $ "remaining: " ++ show remaining
164+ classifierState .= ClassifierStart
162 unprocessedBytes .= remaining
165 unprocessedBytes .= remaining
163 return e
166 return e
164− _ -> mzero
167+ _ -> mzero
165
168
166dropInvalid :: InputM ()
169dropInvalid :: InputM ()
167dropInvalid = do
170dropInvalid = do
168 c <- use classifier
171 c <- use classifier
172+ s <- use classifierState
169 b <- use unprocessedBytes
173 b <- use unprocessedBytes
174+ case c s b of
175+ Chunk -> do
176+ classifierState .=
177+ case s of
178+ ClassifierStart -> ClassifierInChunk b []
179+ ClassifierInChunk p bs -> ClassifierInChunk p (b:bs)
180+ unprocessedBytes .= BS8.empty
170− when (c b == Invalid) $ do
181+ Invalid -> do
171− logMsg "dropping input bytes"
182+ logMsg "dropping input bytes"
183+ classifierState .= ClassifierStart
172− unprocessedBytes .= BS8.empty
184+ unprocessedBytes .= BS8.empty
185+ _ -> return ()
173
186
174runInputProcessorLoop :: ClassifyMap -> Input -> IO ()
187runInputProcessorLoop :: ClassifyMap -> Input -> IO ()
175runInputProcessorLoop classifyTable input = do
188runInputProcessorLoop classifyTable input = do
176 let bufferSize = 1024
189 let bufferSize = 1024
177 allocaArray bufferSize $ \(bufferPtr :: Ptr Word8) -> do
190 allocaArray bufferSize $ \(bufferPtr :: Ptr Word8) -> do
178− s0 <- InputState BS8.empty
191+ s0 <- InputState BS8.empty ClassifierStart
179 <$> readIORef (_configRef input)
192 <$> readIORef (_configRef input)
180 <*> pure (InputBuffer bufferPtr bufferSize)
193 <*> pure (InputBuffer bufferPtr bufferSize)
181 <*> pure (classify classifyTable)
194 <*> pure (classify classifyTable)