-- | This module provides a simple parser for parsing input event

-- control sequences.

module Graphics.Vty.Platform.Windows.Input.Classify.Parse
  ( Parser
  , runParser
  , failParse
  , readInt
  , readChar
  , expectChar
  )
where

import Control.Monad (unless)
import Control.Monad.Trans.Maybe ( MaybeT(runMaybeT) )
import Control.Monad.State
    ( MonadState(put, get), State, runState )

import qualified Data.ByteString.Char8 as BS8
import Data.ByteString.Char8 (ByteString)
import Graphics.Vty.Input.Events ( Event )
import Graphics.Vty.Platform.Windows.Input.Classify.Types
    ( KClass(Valid, Invalid) )

-- | Represents current state of parsing input data

type Parser a = MaybeT (State ByteString) a

-- | Run a parser on a given input string. If the parser fails, return

-- 'Invalid'. Otherwise return the valid event ('Valid') and the

-- remaining unparsed characters.

runParser :: ByteString -> Parser Event -> KClass
runParser :: ByteString -> Parser Event -> KClass
runParser ByteString
s Parser Event
parser =
    case State ByteString (Maybe Event)
-> ByteString -> (Maybe Event, ByteString)
forall s a. State s a -> s -> (a, s)
runState (Parser Event -> State ByteString (Maybe Event)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT Parser Event
parser) ByteString
s of
        (Maybe Event
Nothing, ByteString
_)        -> KClass
Invalid
        (Just Event
e, ByteString
remaining) -> Event -> ByteString -> KClass
Valid Event
e ByteString
remaining

-- | Fail a parsing operation.

failParse :: Parser a
failParse :: forall a. Parser a
failParse = String -> MaybeT (State ByteString) a
forall a. String -> MaybeT (State ByteString) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid parse"

-- | Read an integer from the input stream. If an integer cannot be

-- read, fail parsing. E.g. calling readInt on an input of "123abc" will

-- return '123' and consume those characters.

readInt :: Parser Int
readInt :: Parser Int
readInt = do
    String
s <- ByteString -> String
BS8.unpack (ByteString -> String)
-> MaybeT (State ByteString) ByteString
-> MaybeT (State ByteString) String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeT (State ByteString) ByteString
forall s (m :: * -> *). MonadState s m => m s
get
    case (ReadS Int
forall a. Read a => ReadS a
reads :: ReadS Int) String
s of
        [(Int
i, String
rest)] -> ByteString -> MaybeT (State ByteString) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (String -> ByteString
BS8.pack String
rest) MaybeT (State ByteString) () -> Parser Int -> Parser Int
forall a b.
MaybeT (State ByteString) a
-> MaybeT (State ByteString) b -> MaybeT (State ByteString) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Parser Int
forall a. a -> MaybeT (State ByteString) a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
        [(Int, String)]
_ -> Parser Int
forall a. Parser a
failParse

-- | Read a character from the input stream. If one cannot be read (e.g.

-- we are out of characters), fail parsing.

readChar :: Parser Char
readChar :: Parser Char
readChar = do
    ByteString
s <- MaybeT (State ByteString) ByteString
forall s (m :: * -> *). MonadState s m => m s
get
    case ByteString -> Maybe (Char, ByteString)
BS8.uncons ByteString
s of
        Just (Char
c,ByteString
rest) -> ByteString -> MaybeT (State ByteString) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ByteString
rest MaybeT (State ByteString) () -> Parser Char -> Parser Char
forall a b.
MaybeT (State ByteString) a
-> MaybeT (State ByteString) b -> MaybeT (State ByteString) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser Char
forall a. a -> MaybeT (State ByteString) a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
        Maybe (Char, ByteString)
Nothing -> Parser Char
forall a. Parser a
failParse

-- | Read a character from the input stream and fail parsing if it is

-- not the specified character.

expectChar :: Char -> Parser ()
expectChar :: Char -> MaybeT (State ByteString) ()
expectChar Char
c = do
    Char
c' <- Parser Char
readChar
    Bool
-> MaybeT (State ByteString) () -> MaybeT (State ByteString) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Char
c' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) MaybeT (State ByteString) ()
forall a. Parser a
failParse