    {-# OPTIONS_HADDOCK hide #-}
    -- This makes a kind of trie. Has space efficiency issues with large
    -- input blocks. Likely building a parser and just applying that would
    -- be better.
    module Graphics.Vty.Input.Classify
      ( classify
      , KClass(..)
      , ClassifierState(..)
      )
    where

    import Graphics.Vty.Input.Events
    import Graphics.Vty.Input.Mouse
    import Graphics.Vty.Input.Focus
    import Graphics.Vty.Input.Paste
    import Graphics.Vty.Input.Classify.Types

    import Codec.Binary.UTF8.Generic (decode)

    import Control.Arrow (first)
    import qualified Data.Map as M( fromList, lookup )
    import Data.Maybe ( mapMaybe )
    import qualified Data.Set as S( fromList, member )

    import Data.Word

    import qualified Data.ByteString as BS
    import qualified Data.ByteString.Char8 as BS8
    import Data.ByteString.Char8 (ByteString)

    -- | Whether the classifier is currently processing a chunked format.
    -- Currently, only bracketed pastes use this.
    data ClassifierState
        = ClassifierStart
        -- ^ Not processing a chunked format.
        | ClassifierInChunk ByteString [ByteString]
        -- ^ Currently processing a chunked format. The initial chunk is in the
        -- first argument and a reversed remainder of the chunks is collected in
        -- the second argument. At the end of the processing, the chunks are
        -- reversed and concatenated with the final chunk.

    compile :: ClassifyMap -> ByteString -> KClass
    compile :: ClassifyMap -> ByteString -> KClass
    compile ClassifyMap
    table = ByteString -> KClass
    cl' where
        -- take all prefixes and create a set of these
        prefixSet :: Set ByteString
    prefixSet = [ByteString] -> Set ByteString
    forall a. Ord a => [a] -> Set a
    S.fromList ([ByteString] -> Set ByteString) -> [ByteString] -> Set ByteString
    forall a b. (a -> b) -> a -> b
    $ ((String, Event) -> [ByteString]) -> ClassifyMap -> [ByteString]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ([ByteString] -> [ByteString]
    forall a. HasCallStack => [a] -> [a]
    init ([ByteString] -> [ByteString])
    -> ((String, Event) -> [ByteString])
    -> (String, Event)
    -> [ByteString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [ByteString]
    BS.inits (ByteString -> [ByteString])
    -> ((String, Event) -> ByteString)
    -> (String, Event)
    -> [ByteString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ByteString
    BS8.pack (String -> ByteString)
    -> ((String, Event) -> String) -> (String, Event) -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String, Event) -> String
    forall a b. (a, b) -> a
    fst) ClassifyMap
    table
        maxValidInputLength :: Int
    maxValidInputLength = [Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum (((String, Event) -> Int) -> ClassifyMap -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (String -> Int)
    -> ((String, Event) -> String) -> (String, Event) -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String, Event) -> String
    forall a b. (a, b) -> a
    fst) ClassifyMap
    table)
        eventForInput :: Map ByteString Event
    eventForInput = [(ByteString, Event)] -> Map ByteString Event
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(ByteString, Event)] -> Map ByteString Event)
    -> [(ByteString, Event)] -> Map ByteString Event
    forall a b. (a -> b) -> a -> b
    $ ((String, Event) -> (ByteString, Event))
    -> ClassifyMap -> [(ByteString, Event)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((String -> ByteString) -> (String, Event) -> (ByteString, Event)
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first String -> ByteString
    BS8.pack) ClassifyMap
    table
        cl' :: ByteString -> KClass
    cl' ByteString
    inputBlock | ByteString -> Bool
    BS8.null ByteString
    inputBlock = KClass
    Prefix
        cl' ByteString
    inputBlock = case ByteString -> Map ByteString Event -> Maybe Event
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup ByteString
    inputBlock Map ByteString Event
    eventForInput of
                -- if the inputBlock is exactly what is expected for an
                -- event then consume the whole block and return the event
                Just Event
    e -> Event -> ByteString -> KClass
    Valid Event
    e ByteString
    BS8.empty
                Maybe Event
    Nothing -> case ByteString -> Set ByteString -> Bool
    forall a. Ord a => a -> Set a -> Bool
    S.member ByteString
    inputBlock Set ByteString
    prefixSet of
                    Bool
    True -> KClass
    Prefix
                    -- look up progressively smaller tails of the input
                    -- block until an event is found The assumption is that
                    -- the event that consumes the most input bytes should
                    -- be produced.
                    -- The test verifyFullSynInputToEvent2x verifies this.
                    -- H: There will always be one match. The prefixSet
                    -- contains, by definition, all prefixes of an event.
                    Bool
    False ->
                        let inputPrefixes :: [ByteString]
    inputPrefixes = [ByteString] -> [ByteString]
    forall a. [a] -> [a]
    reverse ([ByteString] -> [ByteString])
    -> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [ByteString] -> [ByteString]
    forall a. Int -> [a] -> [a]
    take Int
    maxValidInputLength ([ByteString] -> [ByteString])
    -> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [ByteString] -> [ByteString]
    forall a. HasCallStack => [a] -> [a]
    tail ([ByteString] -> [ByteString])
    -> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [ByteString]
    BS8.inits (ByteString -> [ByteString]) -> ByteString -> [ByteString]
    forall a b. (a -> b) -> a -> b
    $ ByteString
    inputBlock
                        in case (ByteString -> Maybe (ByteString, Event))
    -> [ByteString] -> [(ByteString, Event)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (\ByteString
    s -> (,) ByteString
    s (Event -> (ByteString, Event))
    -> Maybe Event -> Maybe (ByteString, Event)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` ByteString -> Map ByteString Event -> Maybe Event
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup ByteString
    s Map ByteString Event
    eventForInput) [ByteString]
    inputPrefixes of
                            (ByteString
    s,Event
    e) : [(ByteString, Event)]
    _ -> Event -> ByteString -> KClass
    Valid Event
    e (Int -> ByteString -> ByteString
    BS8.drop (ByteString -> Int
    BS8.length ByteString
    s) ByteString
    inputBlock)
                            -- neither a prefix or a full event.
                            [] -> KClass
    Invalid

    classify :: ClassifyMap -> ClassifierState -> ByteString -> KClass
    classify :: ClassifyMap -> ClassifierState -> ByteString -> KClass
    classify ClassifyMap
    table = ClassifierState -> ByteString -> KClass
    process
        where
            standardClassifier :: ByteString -> KClass
    standardClassifier = ClassifyMap -> ByteString -> KClass
    compile ClassifyMap
    table

            process :: ClassifierState -> ByteString -> KClass
    process ClassifierState
    ClassifierStart ByteString
    s =
                case ByteString -> Maybe (Word8, ByteString)
    BS.uncons ByteString
    s of
                    Maybe (Word8, ByteString)
    _ | ByteString -> Bool
    bracketedPasteStarted ByteString
    s ->
                        if ByteString -> Bool
    bracketedPasteFinished ByteString
    s
                        then ByteString -> KClass
    parseBracketedPaste ByteString
    s
                        else KClass
    Chunk
                    Maybe (Word8, ByteString)
    _ | ByteString -> Bool
    isMouseEvent ByteString
    s      -> ByteString -> KClass
    classifyMouseEvent ByteString
    s
                    Maybe (Word8, ByteString)
    _ | ByteString -> Bool
    isFocusEvent ByteString
    s      -> ByteString -> KClass
    classifyFocusEvent ByteString
    s
                    Just (Word8
    c,ByteString
    cs) | Word8
    c Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Word8
    0xC2 -> Word8 -> ByteString -> KClass
    classifyUtf8 Word8
    c ByteString
    cs
                    Maybe (Word8, ByteString)
    _                       -> ByteString -> KClass
    standardClassifier ByteString
    s

            process (ClassifierInChunk ByteString
    p [ByteString]
    ps) ByteString
    s | ByteString -> Bool
    bracketedPasteStarted ByteString
    p =
                if ByteString -> Bool
    bracketedPasteFinished ByteString
    s
                then ByteString -> KClass
    parseBracketedPaste (ByteString -> KClass) -> ByteString -> KClass
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> ByteString
    BS.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString
    pByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :[ByteString] -> [ByteString]
    forall a. [a] -> [a]
    reverse (ByteString
    sByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :[ByteString]
    ps)
                else KClass
    Chunk
            process ClassifierInChunk{} ByteString
    _ = KClass
    Invalid

    classifyUtf8 :: Word8 -> ByteString -> KClass
    classifyUtf8 :: Word8 -> ByteString -> KClass
    classifyUtf8 Word8
    c ByteString
    cs =
      let n :: Int
    n = Word8 -> Int
    utf8Length Word8
    c
          (ByteString
    codepoint,ByteString
    rest) = Int -> ByteString -> (ByteString, ByteString)
    BS8.splitAt (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) ByteString
    cs

          codepoint8 :: [Word8]
          codepoint8 :: [Word8]
    codepoint8 = Word8
    cWord8 -> [Word8] -> [Word8]
    forall a. a -> [a] -> [a]
    :ByteString -> [Word8]
    BS.unpack ByteString
    codepoint

      in case [Word8] -> Maybe (Char, Int)
    forall b s. UTF8Bytes b s => b -> Maybe (Char, s)
    decode [Word8]
    codepoint8 of
           Maybe (Char, Int)
    _ | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < ByteString -> Int
    BS.length ByteString
    codepoint Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 -> KClass
    Prefix
           Just (Char
    unicodeChar, Int
    _)           -> Event -> ByteString -> KClass
    Valid (Key -> [Modifier] -> Event
    EvKey (Char -> Key
    KChar Char
    unicodeChar) []) ByteString
    rest
           -- something bad happened; just ignore and continue.
           Maybe (Char, Int)
    Nothing                         -> KClass
    Invalid

    utf8Length :: Word8 -> Int
    utf8Length :: Word8 -> Int
    utf8Length Word8
    c
        | Word8
    c Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word8
    0x80 = Int
    1
        | Word8
    c Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word8
    0xE0 = Int
    2
        | Word8
    c Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word8
    0xF0 = Int
    3
        | Bool
    otherwise = Int
    4