@@ -6,7 +6,10 @@
66-- TODO: measure and rewrite if required.
77-- TODO: The ClassifyMap interface requires this code to always assure later entries override
88-- earlier.
9−module Graphics.Vty.Input.Classify where
9+module Graphics.Vty.Input.Classify
10+ ( classify
11+ , KClass(..)
12+ ) where
1013
1114import Graphics.Vty.Input.Events
1215
@@ -53,28 +56,22 @@ compile table = cl' where
5356 -- TODO: debug log
5457 [] -> Invalid
5558
56−classify, classifyTab :: ClassifyMap -> [Char] -> KClass
57−
58−-- As soon as
59−classify _table s@(c:_) | ord c >= 0xC2
60− = if utf8Length (ord c) > length s then Prefix else classifyUtf8 s -- beginning of an utf8 sequence
61−classify table other
62− = classifyTab table other
59+classify :: ClassifyMap -> [Char] -> KClass
60+classify table =
61+ let fallbackClassifier = compile table
62+ in \s -> case s of
63+ (c:_) | ord c >= 0xC2 && utf8Length (ord c) > length s -> Prefix -- beginning of an utf8 sequence
64+ (c:_) | ord c >= 0xC2 -> classifyUtf8 s -- As soon as
65+ _ -> fallbackClassifier s
6366
6467classifyUtf8 :: [Char] -> KClass
6568classifyUtf8 s = case decode ((map (fromIntegral . ord) s) :: [Word8]) of
6669 Just (unicodeChar, _) -> Valid (EvKey (KChar unicodeChar) []) []
6770 _ -> Invalid -- something bad happened; just ignore and continue.
6871
69−classifyTab table = compile table
70−
71−first :: (a -> b) -> (a,c) -> (b,c)
72−first f (x,y) = (f x, y)
73−
7472utf8Length :: (Num t, Ord a, Num a) => a -> t
7573utf8Length c
7674 | c < 0x80 = 1
7775 | c < 0xE0 = 2
7876 | c < 0xF0 = 3
7977 | otherwise = 4
80−