    -- | This module provides parsers for mouse events for both "normal" and
    -- "extended" modes. This implementation was informed by
    --
    -- http://invisible-island.net/xterm/ctlseqs/ctlseqs.html#h2-Mouse-Tracking
    module Graphics.Vty.Input.Mouse
      ( requestMouseEvents
      , disableMouseEvents
      , isMouseEvent
      , classifyMouseEvent
      )
    where

    import Graphics.Vty.Input.Events
    import Graphics.Vty.Input.Classify.Types
    import Graphics.Vty.Input.Classify.Parse

    import Control.Monad
    import Control.Monad.State
    import Data.Maybe (catMaybes)
    import Data.Bits ((.&.))

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

    -- A mouse event in SGR extended mode is
    --
    -- '\ESC' '[' '<' B ';' X ';' Y ';' ('M'|'m')
    --
    -- where
    --
    -- * B is the number with button and modifier bits set,
    -- * X is the X coordinate of the event starting at 1
    -- * Y is the Y coordinate of the event starting at 1
    -- * the final character is 'M' for a press, 'm' for a release

    -- | These sequences set xterm-based terminals to send mouse event
    -- sequences.
    requestMouseEvents :: ByteString
    requestMouseEvents :: ByteString
    requestMouseEvents = String -> ByteString
    BS8.pack String
    "\ESC[?1000h\ESC[?1002h\ESC[?1006h"

    -- | These sequences disable mouse events.
    disableMouseEvents :: ByteString
    disableMouseEvents :: ByteString
    disableMouseEvents = String -> ByteString
    BS8.pack String
    "\ESC[?1000l\ESC[?1002l\ESC[?1006l"

    -- | Does the specified string begin with a mouse event?
    isMouseEvent :: ByteString -> Bool
    isMouseEvent :: ByteString -> Bool
    isMouseEvent ByteString
    s = ByteString -> Bool
    isSGREvent ByteString
    s Bool -> Bool -> Bool
    || ByteString -> Bool
    isNormalEvent ByteString
    s

    isSGREvent :: ByteString -> Bool
    isSGREvent :: ByteString -> Bool
    isSGREvent = ByteString -> ByteString -> Bool
    BS8.isPrefixOf ByteString
    sgrPrefix

    sgrPrefix :: ByteString
    sgrPrefix :: ByteString
    sgrPrefix = String -> ByteString
    BS8.pack String
    "\ESC[M"

    isNormalEvent :: ByteString -> Bool
    isNormalEvent :: ByteString -> Bool
    isNormalEvent = ByteString -> ByteString -> Bool
    BS8.isPrefixOf ByteString
    normalPrefix

    normalPrefix :: ByteString
    normalPrefix :: ByteString
    normalPrefix = String -> ByteString
    BS8.pack String
    "\ESC[<"

    -- Modifier bits:
    shiftBit :: Int
    shiftBit :: Int
    shiftBit = Int
    4

    metaBit :: Int
    metaBit :: Int
    metaBit = Int
    8

    ctrlBit :: Int
    ctrlBit :: Int
    ctrlBit = Int
    16

    -- These bits indicate the buttons involved:
    buttonMask :: Int
    buttonMask :: Int
    buttonMask = Int
    67

    leftButton :: Int
    leftButton :: Int
    leftButton = Int
    0

    middleButton :: Int
    middleButton :: Int
    middleButton = Int
    1

    rightButton :: Int
    rightButton :: Int
    rightButton = Int
    2

    scrollUp :: Int
    scrollUp :: Int
    scrollUp = Int
    64

    scrollDown :: Int
    scrollDown :: Int
    scrollDown = Int
    65

    hasBitSet :: Int -> Int -> Bool
    hasBitSet :: Int -> Int -> Bool
    hasBitSet Int
    val Int
    bit = Int
    val Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .&. Int
    bit Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0

    -- | Attempt to classify an input string as a mouse event.
    classifyMouseEvent :: ByteString -> KClass
    classifyMouseEvent :: ByteString -> KClass
    classifyMouseEvent ByteString
    s = ByteString -> Parser Event -> KClass
    runParser ByteString
    s (Parser Event -> KClass) -> Parser Event -> KClass
    forall a b. (a -> b) -> a -> b
    $ do
        Bool
    -> MaybeT (State ByteString) () -> MaybeT (State ByteString) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Bool
    isMouseEvent ByteString
    s) MaybeT (State ByteString) ()
    forall a. Parser a
    failParse

        Char -> MaybeT (State ByteString) ()
    expectChar Char
    '\ESC'
        Char -> MaybeT (State ByteString) ()
    expectChar Char
    '['
        Char
    ty <- Parser Char
    readChar
        case Char
    ty of
            Char
    '<' -> Parser Event
    classifySGRMouseEvent
            Char
    'M' -> Parser Event
    classifyNormalMouseEvent
            Char
    _   -> Parser Event
    forall a. Parser a
    failParse

    -- Given a modifier/button value, determine which button was indicated
    getSGRButton :: Int -> Parser Button
    getSGRButton :: Int -> Parser Button
    getSGRButton Int
    mods =
        let buttonMap :: [(Int, Button)]
    buttonMap = [ (Int
    leftButton,   Button
    BLeft)
                        , (Int
    middleButton, Button
    BMiddle)
                        , (Int
    rightButton,  Button
    BRight)
                        , (Int
    scrollUp,     Button
    BScrollUp)
                        , (Int
    scrollDown,   Button
    BScrollDown)
                        ]
        in case Int -> [(Int, Button)] -> Maybe Button
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup (Int
    mods Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .&. Int
    buttonMask) [(Int, Button)]
    buttonMap of
            Maybe Button
    Nothing -> Parser Button
    forall a. Parser a
    failParse
            Just Button
    b -> Button -> Parser Button
    forall a. a -> MaybeT (State ByteString) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Button
    b

    getModifiers :: Int -> [Modifier]
    getModifiers :: Int -> [Modifier]
    getModifiers Int
    mods =
        [Maybe Modifier] -> [Modifier]
    forall a. [Maybe a] -> [a]
    catMaybes [ if Int
    mods Int -> Int -> Bool
    `hasBitSet` Int
    shiftBit then Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just Modifier
    MShift else Maybe Modifier
    forall a. Maybe a
    Nothing
                  , if Int
    mods Int -> Int -> Bool
    `hasBitSet` Int
    metaBit  then Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just Modifier
    MMeta  else Maybe Modifier
    forall a. Maybe a
    Nothing
                  , if Int
    mods Int -> Int -> Bool
    `hasBitSet` Int
    ctrlBit  then Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just Modifier
    MCtrl  else Maybe Modifier
    forall a. Maybe a
    Nothing
                  ]

    -- Attempt to classify a control sequence as a "normal" mouse event. To
    -- get here we should have already read "\ESC[M" so that will not be
    -- included in the string to be parsed.
    classifyNormalMouseEvent :: Parser Event
    classifyNormalMouseEvent :: Parser Event
    classifyNormalMouseEvent = do
        Char
    statusChar <- Parser Char
    readChar
        Char
    xCoordChar <- Parser Char
    readChar
        Char
    yCoordChar <- Parser Char
    readChar

        let xCoord :: Int
    xCoord = Char -> Int
    forall a. Enum a => a -> Int
    fromEnum Char
    xCoordChar Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    32
            yCoord :: Int
    yCoord = Char -> Int
    forall a. Enum a => a -> Int
    fromEnum Char
    yCoordChar Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    32
            status :: Int
    status = Char -> Int
    forall a. Enum a => a -> Int
    fromEnum Char
    statusChar
            modifiers :: [Modifier]
    modifiers = Int -> [Modifier]
    getModifiers Int
    status

        let press :: Bool
    press = Int
    status Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .&. Int
    buttonMask Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    3
        case Bool
    press of
                Bool
    True -> do
                    Button
    button <- Int -> Parser Button
    getSGRButton Int
    status
                    Event -> Parser Event
    forall a. a -> MaybeT (State ByteString) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Event -> Parser Event) -> Event -> Parser Event
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Button -> [Modifier] -> Event
    EvMouseDown (Int
    xCoordInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) (Int
    yCoordInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) Button
    button [Modifier]
    modifiers
                Bool
    False -> Event -> Parser Event
    forall a. a -> MaybeT (State ByteString) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Event -> Parser Event) -> Event -> Parser Event
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Maybe Button -> Event
    EvMouseUp (Int
    xCoordInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) (Int
    yCoordInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) Maybe Button
    forall a. Maybe a
    Nothing

    -- Attempt to classify a control sequence as an SGR mouse event. To
    -- get here we should have already read "\ESC[<" so that will not be
    -- included in the string to be parsed.
    classifySGRMouseEvent :: Parser Event
    classifySGRMouseEvent :: Parser Event
    classifySGRMouseEvent = do
        Int
    mods <- Parser Int
    readInt
        Char -> MaybeT (State ByteString) ()
    expectChar Char
    ';'
        Int
    xCoord <- Parser Int
    readInt
        Char -> MaybeT (State ByteString) ()
    expectChar Char
    ';'
        Int
    yCoord <- Parser Int
    readInt
        Char
    final <- Parser Char
    readChar

        let modifiers :: [Modifier]
    modifiers = Int -> [Modifier]
    getModifiers Int
    mods
        Button
    button <- Int -> Parser Button
    getSGRButton Int
    mods
        case Char
    final of
            Char
    'M' -> Event -> Parser Event
    forall a. a -> MaybeT (State ByteString) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Event -> Parser Event) -> Event -> Parser Event
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Button -> [Modifier] -> Event
    EvMouseDown (Int
    xCoordInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) (Int
    yCoordInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) Button
    button [Modifier]
    modifiers
            Char
    'm' -> Event -> Parser Event
    forall a. a -> MaybeT (State ByteString) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Event -> Parser Event) -> Event -> Parser Event
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Maybe Button -> Event
    EvMouseUp   (Int
    xCoordInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) (Int
    yCoordInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) (Button -> Maybe Button
    forall a. a -> Maybe a
    Just Button
    button)
            Char
    _ -> Parser Event
    forall a. Parser a
    failParse