    {-# LANGUAGE CPP #-}
    {-# LANGUAGE NoMonomorphismRestriction #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TemplateHaskell #-}
    {-# OPTIONS_HADDOCK hide #-}
    -- | The input layer used to be a single function that correctly
    -- accounted for the non-threaded runtime by emulating the terminal
    -- VMIN adn VTIME handling. This has been removed and replace with a
    -- more straightforward parser. The non-threaded runtime is no longer
    -- supported.
    --
    -- This is an example of an algorithm where code coverage could be high,
    -- even 100%, but the behavior is still under tested. I should collect
    -- more of these examples...
    --
    -- reference: http://www.unixwiz.net/techtips/termios-vmin-vtime.html
    module Graphics.Vty.Input.Loop
      ( Input(..)
      , eventChannel

      , initInput
      )
    where

    import Graphics.Vty.Config
    import Graphics.Vty.Input.Classify
    import Graphics.Vty.Input.Events

    import Control.Applicative
    import Control.Concurrent
    import Control.Concurrent.STM
    import Control.Exception (mask, try, SomeException)
    import Lens.Micro hiding ((<>~))
    import Lens.Micro.Mtl
    import Lens.Micro.TH
    import Control.Monad (when, mzero, forM_)
    import Control.Monad.IO.Class (liftIO)
    import Control.Monad.Trans.State (StateT(..), evalStateT)
    import Control.Monad.State.Class (MonadState, modify)
    import Control.Monad.Trans.Reader (ReaderT(..))

    import qualified Data.ByteString.Char8 as BS8
    import qualified Data.ByteString as BS
    import Data.ByteString.Char8 (ByteString)
    import Data.IORef
    import Data.Word (Word8)

    import Foreign (allocaArray)
    import Foreign.C.Types (CInt(..))
    import Foreign.Ptr (Ptr, castPtr)

    import System.IO
    import System.Posix.IO (fdReadBuf, setFdOption, FdOption(..))
    import System.Posix.Types (Fd(..))

    import Text.Printf (hPrintf)

    data Input = Input
        { -- | Channel of events direct from input processing. Unlike
          -- 'nextEvent' this will not refresh the display if the next event
          -- is an 'EvResize'.
          Input -> TChan InternalEvent
    _eventChannel  :: TChan InternalEvent
          -- | Shuts down the input processing. As part of shutting down the
          -- input, this should also restore the input state.
        , Input -> IO ()
    shutdownInput :: IO ()
          -- | Restore the terminal's input state to what it was prior
          -- to configuring input for Vty. This should be done as part of
          -- 'shutdownInput' but is exposed in case you need to access it
          -- directly.
        , Input -> IO ()
    restoreInputState :: IO ()
          -- | Changes to this value are reflected after the next event.
        , Input -> IORef Config
    _configRef :: IORef Config
          -- | input debug log
        , Input -> Maybe Handle
    _inputDebug :: Maybe Handle
        }

    makeLenses ''Input

    data InputBuffer = InputBuffer
        { InputBuffer -> Ptr Word8
    _ptr :: Ptr Word8
        , InputBuffer -> Int
    _size :: Int
        }

    makeLenses ''InputBuffer

    data InputState = InputState
        { InputState -> ByteString
    _unprocessedBytes :: ByteString
        , InputState -> ClassifierState
    _classifierState :: ClassifierState
        , InputState -> Config
    _appliedConfig :: Config
        , InputState -> InputBuffer
    _inputBuffer :: InputBuffer
        , InputState -> ClassifierState -> ByteString -> KClass
    _classifier :: ClassifierState -> ByteString -> KClass
        }

    makeLenses ''InputState

    type InputM a = StateT InputState (ReaderT Input IO) a

    logMsg :: String -> InputM ()
    logMsg :: String -> InputM ()
    logMsg String
    msg = do
        Maybe Handle
    d <- Getting (Maybe Handle) Input (Maybe Handle)
    -> StateT InputState (ReaderT Input IO) (Maybe Handle)
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting (Maybe Handle) Input (Maybe Handle)
    Lens' Input (Maybe Handle)
    inputDebug
        case Maybe Handle
    d of
            Maybe Handle
    Nothing -> () -> InputM ()
    forall a. a -> StateT InputState (ReaderT Input IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            Just Handle
    h -> IO () -> InputM ()
    forall a. IO a -> StateT InputState (ReaderT Input IO) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> InputM ()) -> IO () -> InputM ()
    forall a b. (a -> b) -> a -> b
    $ Handle -> String -> IO ()
    hPutStrLn Handle
    h String
    msg IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Handle -> IO ()
    hFlush Handle
    h

    -- this must be run on an OS thread dedicated to this input handling.
    -- otherwise the terminal timing read behavior will block the execution
    -- of the lightweight threads.
    loopInputProcessor :: InputM ()
    loopInputProcessor :: InputM ()
    loopInputProcessor = do
        InputM ByteString
    readFromDevice InputM ByteString -> (ByteString -> InputM ()) -> InputM ()
    forall a b.
    StateT InputState (ReaderT Input IO) a
    -> (a -> StateT InputState (ReaderT Input IO) b)
    -> StateT InputState (ReaderT Input IO) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ByteString -> InputM ()
    addBytesToProcess
        [Event]
    validEvents <- StateT InputState (ReaderT Input IO) Event
    -> StateT InputState (ReaderT Input IO) [Event]
    forall a.
    StateT InputState (ReaderT Input IO) a
    -> StateT InputState (ReaderT Input IO) [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many StateT InputState (ReaderT Input IO) Event
    parseEvent
        [Event] -> (Event -> InputM ()) -> InputM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Event]
    validEvents Event -> InputM ()
    emit
        InputM ()
    dropInvalid
        InputM ()
    loopInputProcessor

    addBytesToProcess :: ByteString -> InputM ()
    addBytesToProcess :: ByteString -> InputM ()
    addBytesToProcess ByteString
    block = (ByteString -> Identity ByteString)
    -> InputState -> Identity InputState
    Lens' InputState ByteString
    unprocessedBytes ((ByteString -> Identity ByteString)
     -> InputState -> Identity InputState)
    -> ByteString -> InputM ()
    forall s (m :: * -> *) a.
    (MonadState s m, Monoid a) =>
    ASetter' s a -> a -> m ()
    <>= ByteString
    block

    emit :: Event -> InputM ()
    emit :: Event -> InputM ()
    emit Event
    event = do
        String -> InputM ()
    logMsg (String -> InputM ()) -> String -> InputM ()
    forall a b. (a -> b) -> a -> b
    $ String
    "parsed event: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Event -> String
    forall a. Show a => a -> String
    show Event
    event
        Getting (TChan InternalEvent) Input (TChan InternalEvent)
    -> StateT InputState (ReaderT Input IO) (TChan InternalEvent)
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting (TChan InternalEvent) Input (TChan InternalEvent)
    Lens' Input (TChan InternalEvent)
    eventChannel StateT InputState (ReaderT Input IO) (TChan InternalEvent)
    -> (TChan InternalEvent -> InputM ()) -> InputM ()
    forall a b.
    StateT InputState (ReaderT Input IO) a
    -> (a -> StateT InputState (ReaderT Input IO) b)
    -> StateT InputState (ReaderT Input IO) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO () -> InputM ()
    forall a. IO a -> StateT InputState (ReaderT Input IO) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> InputM ())
    -> (TChan InternalEvent -> IO ())
    -> TChan InternalEvent
    -> InputM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . STM () -> IO ()
    forall a. STM a -> IO a
    atomically (STM () -> IO ())
    -> (TChan InternalEvent -> STM ()) -> TChan InternalEvent -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (TChan InternalEvent -> InternalEvent -> STM ())
    -> InternalEvent -> TChan InternalEvent -> STM ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip TChan InternalEvent -> InternalEvent -> STM ()
    forall a. TChan a -> a -> STM ()
    writeTChan (Event -> InternalEvent
    InputEvent Event
    event)

    -- The timing requirements are assured by the VMIN and VTIME set for the
    -- device.
    --
    -- Precondition: Under the threaded runtime. Only current use is from a
    -- forkOS thread. That case satisfies precondition.
    readFromDevice :: InputM ByteString
    readFromDevice :: InputM ByteString
    readFromDevice = do
        Config
    newConfig <- Getting (IORef Config) Input (IORef Config)
    -> StateT InputState (ReaderT Input IO) (IORef Config)
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting (IORef Config) Input (IORef Config)
    Lens' Input (IORef Config)
    configRef StateT InputState (ReaderT Input IO) (IORef Config)
    -> (IORef Config -> StateT InputState (ReaderT Input IO) Config)
    -> StateT InputState (ReaderT Input IO) Config
    forall a b.
    StateT InputState (ReaderT Input IO) a
    -> (a -> StateT InputState (ReaderT Input IO) b)
    -> StateT InputState (ReaderT Input IO) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO Config -> StateT InputState (ReaderT Input IO) Config
    forall a. IO a -> StateT InputState (ReaderT Input IO) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Config -> StateT InputState (ReaderT Input IO) Config)
    -> (IORef Config -> IO Config)
    -> IORef Config
    -> StateT InputState (ReaderT Input IO) Config
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IORef Config -> IO Config
    forall a. IORef a -> IO a
    readIORef
        Config
    oldConfig <- Getting Config InputState Config
    -> StateT InputState (ReaderT Input IO) Config
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
    use Getting Config InputState Config
    Lens' InputState Config
    appliedConfig
        let Just Fd
    fd = Config -> Maybe Fd
    inputFd Config
    newConfig
        Bool -> InputM () -> InputM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Config
    newConfig Config -> Config -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Config
    oldConfig) (InputM () -> InputM ()) -> InputM () -> InputM ()
    forall a b. (a -> b) -> a -> b
    $ do
            String -> InputM ()
    logMsg (String -> InputM ()) -> String -> InputM ()
    forall a b. (a -> b) -> a -> b
    $ String
    "new config: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Config -> String
    forall a. Show a => a -> String
    show Config
    newConfig
            IO () -> InputM ()
    forall a. IO a -> StateT InputState (ReaderT Input IO) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> InputM ()) -> IO () -> InputM ()
    forall a b. (a -> b) -> a -> b
    $ Fd -> Config -> IO ()
    applyConfig Fd
    fd Config
    newConfig
            (Config -> Identity Config) -> InputState -> Identity InputState
    Lens' InputState Config
    appliedConfig ((Config -> Identity Config) -> InputState -> Identity InputState)
    -> Config -> InputM ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    ASetter s s a b -> b -> m ()
    .= Config
    newConfig
        Ptr Word8
    bufferPtr <- Getting (Ptr Word8) InputState (Ptr Word8)
    -> StateT InputState (ReaderT Input IO) (Ptr Word8)
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
    use (Getting (Ptr Word8) InputState (Ptr Word8)
     -> StateT InputState (ReaderT Input IO) (Ptr Word8))
    -> Getting (Ptr Word8) InputState (Ptr Word8)
    -> StateT InputState (ReaderT Input IO) (Ptr Word8)
    forall a b. (a -> b) -> a -> b
    $ (InputBuffer -> Const (Ptr Word8) InputBuffer)
    -> InputState -> Const (Ptr Word8) InputState
    Lens' InputState InputBuffer
    inputBuffer((InputBuffer -> Const (Ptr Word8) InputBuffer)
     -> InputState -> Const (Ptr Word8) InputState)
    -> ((Ptr Word8 -> Const (Ptr Word8) (Ptr Word8))
        -> InputBuffer -> Const (Ptr Word8) InputBuffer)
    -> Getting (Ptr Word8) InputState (Ptr Word8)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(Ptr Word8 -> Const (Ptr Word8) (Ptr Word8))
    -> InputBuffer -> Const (Ptr Word8) InputBuffer
    Lens' InputBuffer (Ptr Word8)
    ptr
        Int
    maxBytes  <- Getting Int InputState Int
    -> StateT InputState (ReaderT Input IO) Int
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
    use (Getting Int InputState Int
     -> StateT InputState (ReaderT Input IO) Int)
    -> Getting Int InputState Int
    -> StateT InputState (ReaderT Input IO) Int
    forall a b. (a -> b) -> a -> b
    $ (InputBuffer -> Const Int InputBuffer)
    -> InputState -> Const Int InputState
    Lens' InputState InputBuffer
    inputBuffer((InputBuffer -> Const Int InputBuffer)
     -> InputState -> Const Int InputState)
    -> ((Int -> Const Int Int) -> InputBuffer -> Const Int InputBuffer)
    -> Getting Int InputState Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(Int -> Const Int Int) -> InputBuffer -> Const Int InputBuffer
    Lens' InputBuffer Int
    size
        ByteString
    stringRep <- IO ByteString -> InputM ByteString
    forall a. IO a -> StateT InputState (ReaderT Input IO) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ByteString -> InputM ByteString)
    -> IO ByteString -> InputM ByteString
    forall a b. (a -> b) -> a -> b
    $ do
            -- The killThread used in shutdownInput will not interrupt the
            -- foreign call fdReadBuf uses this provides a location to be
            -- interrupted prior to the foreign call. If there is input on
            -- the FD then the fdReadBuf will return in a finite amount of
            -- time due to the vtime terminal setting.
            Fd -> IO ()
    threadWaitRead Fd
    fd
            ByteCount
    bytesRead <- Fd -> Ptr Word8 -> ByteCount -> IO ByteCount
    fdReadBuf Fd
    fd Ptr Word8
    bufferPtr (Int -> ByteCount
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    maxBytes)
            if ByteCount
    bytesRead ByteCount -> ByteCount -> Bool
    forall a. Ord a => a -> a -> Bool
    > ByteCount
    0
            then CStringLen -> IO ByteString
    BS.packCStringLen (Ptr Word8 -> Ptr CChar
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Word8
    bufferPtr, ByteCount -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ByteCount
    bytesRead)
            else ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    BS.empty
        Bool -> InputM () -> InputM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Bool
    BS.null ByteString
    stringRep) (InputM () -> InputM ()) -> InputM () -> InputM ()
    forall a b. (a -> b) -> a -> b
    $
            String -> InputM ()
    logMsg (String -> InputM ()) -> String -> InputM ()
    forall a b. (a -> b) -> a -> b
    $ String
    "input bytes: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show (ByteString -> String
    BS8.unpack ByteString
    stringRep)
        ByteString -> InputM ByteString
    forall a. a -> StateT InputState (ReaderT Input IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    stringRep

    applyConfig :: Fd -> Config -> IO ()
    applyConfig :: Fd -> Config -> IO ()
    applyConfig Fd
    fd (Config{ vmin :: Config -> Maybe Int
    vmin = Just Int
    theVmin, vtime :: Config -> Maybe Int
    vtime = Just Int
    theVtime })
        = Fd -> Int -> Int -> IO ()
    setTermTiming Fd
    fd Int
    theVmin (Int
    theVtime Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    100)
    applyConfig Fd
    _ Config
    _ = String -> IO ()
    forall a. String -> IO a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "(vty) applyConfig was not provided a complete configuration"

    parseEvent :: InputM Event
    parseEvent :: StateT InputState (ReaderT Input IO) Event
    parseEvent = do
        ClassifierState -> ByteString -> KClass
    c <- Getting
      (ClassifierState -> ByteString -> KClass)
      InputState
      (ClassifierState -> ByteString -> KClass)
    -> StateT
         InputState
         (ReaderT Input IO)
         (ClassifierState -> ByteString -> KClass)
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
    use Getting
      (ClassifierState -> ByteString -> KClass)
      InputState
      (ClassifierState -> ByteString -> KClass)
    Lens' InputState (ClassifierState -> ByteString -> KClass)
    classifier
        ClassifierState
    s <- Getting ClassifierState InputState ClassifierState
    -> StateT InputState (ReaderT Input IO) ClassifierState
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
    use Getting ClassifierState InputState ClassifierState
    Lens' InputState ClassifierState
    classifierState
        ByteString
    b <- Getting ByteString InputState ByteString -> InputM ByteString
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
    use Getting ByteString InputState ByteString
    Lens' InputState ByteString
    unprocessedBytes
        case ClassifierState -> ByteString -> KClass
    c ClassifierState
    s ByteString
    b of
            Valid Event
    e ByteString
    remaining -> do
                String -> InputM ()
    logMsg (String -> InputM ()) -> String -> InputM ()
    forall a b. (a -> b) -> a -> b
    $ String
    "valid parse: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Event -> String
    forall a. Show a => a -> String
    show Event
    e
                String -> InputM ()
    logMsg (String -> InputM ()) -> String -> InputM ()
    forall a b. (a -> b) -> a -> b
    $ String
    "remaining: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ByteString -> String
    forall a. Show a => a -> String
    show ByteString
    remaining
                (ClassifierState -> Identity ClassifierState)
    -> InputState -> Identity InputState
    Lens' InputState ClassifierState
    classifierState ((ClassifierState -> Identity ClassifierState)
     -> InputState -> Identity InputState)
    -> ClassifierState -> InputM ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    ASetter s s a b -> b -> m ()
    .= ClassifierState
    ClassifierStart
                (ByteString -> Identity ByteString)
    -> InputState -> Identity InputState
    Lens' InputState ByteString
    unprocessedBytes ((ByteString -> Identity ByteString)
     -> InputState -> Identity InputState)
    -> ByteString -> InputM ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    ASetter s s a b -> b -> m ()
    .= ByteString
    remaining
                Event -> StateT InputState (ReaderT Input IO) Event
    forall a. a -> StateT InputState (ReaderT Input IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Event
    e
            KClass
    _ -> StateT InputState (ReaderT Input IO) Event
    forall a. StateT InputState (ReaderT Input IO) a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero

    dropInvalid :: InputM ()
    dropInvalid :: InputM ()
    dropInvalid = do
        ClassifierState -> ByteString -> KClass
    c <- Getting
      (ClassifierState -> ByteString -> KClass)
      InputState
      (ClassifierState -> ByteString -> KClass)
    -> StateT
         InputState
         (ReaderT Input IO)
         (ClassifierState -> ByteString -> KClass)
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
    use Getting
      (ClassifierState -> ByteString -> KClass)
      InputState
      (ClassifierState -> ByteString -> KClass)
    Lens' InputState (ClassifierState -> ByteString -> KClass)
    classifier
        ClassifierState
    s <- Getting ClassifierState InputState ClassifierState
    -> StateT InputState (ReaderT Input IO) ClassifierState
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
    use Getting ClassifierState InputState ClassifierState
    Lens' InputState ClassifierState
    classifierState
        ByteString
    b <- Getting ByteString InputState ByteString -> InputM ByteString
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
    use Getting ByteString InputState ByteString
    Lens' InputState ByteString
    unprocessedBytes
        case ClassifierState -> ByteString -> KClass
    c ClassifierState
    s ByteString
    b of
            KClass
    Chunk -> do
                (ClassifierState -> Identity ClassifierState)
    -> InputState -> Identity InputState
    Lens' InputState ClassifierState
    classifierState ((ClassifierState -> Identity ClassifierState)
     -> InputState -> Identity InputState)
    -> ClassifierState -> InputM ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    ASetter s s a b -> b -> m ()
    .=
                    case ClassifierState
    s of
                      ClassifierState
    ClassifierStart -> ByteString -> [ByteString] -> ClassifierState
    ClassifierInChunk ByteString
    b []
                      ClassifierInChunk ByteString
    p [ByteString]
    bs -> ByteString -> [ByteString] -> ClassifierState
    ClassifierInChunk ByteString
    p (ByteString
    bByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :[ByteString]
    bs)
                (ByteString -> Identity ByteString)
    -> InputState -> Identity InputState
    Lens' InputState ByteString
    unprocessedBytes ((ByteString -> Identity ByteString)
     -> InputState -> Identity InputState)
    -> ByteString -> InputM ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    ASetter s s a b -> b -> m ()
    .= ByteString
    BS8.empty
            KClass
    Invalid -> do
                String -> InputM ()
    logMsg String
    "dropping input bytes"
                (ClassifierState -> Identity ClassifierState)
    -> InputState -> Identity InputState
    Lens' InputState ClassifierState
    classifierState ((ClassifierState -> Identity ClassifierState)
     -> InputState -> Identity InputState)
    -> ClassifierState -> InputM ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    ASetter s s a b -> b -> m ()
    .= ClassifierState
    ClassifierStart
                (ByteString -> Identity ByteString)
    -> InputState -> Identity InputState
    Lens' InputState ByteString
    unprocessedBytes ((ByteString -> Identity ByteString)
     -> InputState -> Identity InputState)
    -> ByteString -> InputM ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    ASetter s s a b -> b -> m ()
    .= ByteString
    BS8.empty
            KClass
    _ -> () -> InputM ()
    forall a. a -> StateT InputState (ReaderT Input IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    runInputProcessorLoop :: ClassifyMap -> Input -> IO ()
    runInputProcessorLoop :: ClassifyMap -> Input -> IO ()
    runInputProcessorLoop ClassifyMap
    classifyTable Input
    input = do
        let bufferSize :: a
    bufferSize = a
    1024
        Int -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
    allocaArray Int
    forall {a}. Num a => a
    bufferSize ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(Ptr Word8
    bufferPtr :: Ptr Word8) -> do
            InputState
    s0 <- ByteString
    -> ClassifierState
    -> Config
    -> InputBuffer
    -> (ClassifierState -> ByteString -> KClass)
    -> InputState
    InputState ByteString
    BS8.empty ClassifierState
    ClassifierStart
                    (Config
     -> InputBuffer
     -> (ClassifierState -> ByteString -> KClass)
     -> InputState)
    -> IO Config
    -> IO
         (InputBuffer
          -> (ClassifierState -> ByteString -> KClass) -> InputState)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IORef Config -> IO Config
    forall a. IORef a -> IO a
    readIORef (Input -> IORef Config
    _configRef Input
    input)
                    IO
      (InputBuffer
       -> (ClassifierState -> ByteString -> KClass) -> InputState)
    -> IO InputBuffer
    -> IO ((ClassifierState -> ByteString -> KClass) -> InputState)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> InputBuffer -> IO InputBuffer
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Ptr Word8 -> Int -> InputBuffer
    InputBuffer Ptr Word8
    bufferPtr Int
    forall {a}. Num a => a
    bufferSize)
                    IO ((ClassifierState -> ByteString -> KClass) -> InputState)
    -> IO (ClassifierState -> ByteString -> KClass) -> IO InputState
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (ClassifierState -> ByteString -> KClass)
    -> IO (ClassifierState -> ByteString -> KClass)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ClassifyMap -> ClassifierState -> ByteString -> KClass
    classify ClassifyMap
    classifyTable)
            ReaderT Input IO () -> Input -> IO ()
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT (InputM () -> InputState -> ReaderT Input IO ()
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    evalStateT InputM ()
    loopInputProcessor InputState
    s0) Input
    input

    logInitialInputState :: Input -> ClassifyMap -> IO()
    logInitialInputState :: Input -> ClassifyMap -> IO ()
    logInitialInputState Input
    input ClassifyMap
    classifyTable = case Input -> Maybe Handle
    _inputDebug Input
    input of
        Maybe Handle
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        Just Handle
    h  -> do
            Config{ vmin :: Config -> Maybe Int
    vmin = Just Int
    theVmin
                  , vtime :: Config -> Maybe Int
    vtime = Just Int
    theVtime
                  , termName :: Config -> Maybe String
    termName = Just String
    theTerm } <- IORef Config -> IO Config
    forall a. IORef a -> IO a
    readIORef (IORef Config -> IO Config) -> IORef Config -> IO Config
    forall a b. (a -> b) -> a -> b
    $ Input -> IORef Config
    _configRef Input
    input
            ()
    _ <- Handle -> String -> String -> IO ()
    forall r. HPrintfType r => Handle -> String -> r
    hPrintf Handle
    h String
    "initial (vmin,vtime): %s\n" ((Int, Int) -> String
    forall a. Show a => a -> String
    show (Int
    theVmin, Int
    theVtime))
            ClassifyMap -> ((String, Event) -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ ClassifyMap
    classifyTable (((String, Event) -> IO ()) -> IO ())
    -> ((String, Event) -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(String, Event)
    i -> case (String, Event)
    i of
                (String
    inBytes, EvKey Key
    k [Modifier]
    mods) -> Handle -> String -> String -> String -> String -> String -> IO ()
    forall r. HPrintfType r => Handle -> String -> r
    hPrintf Handle
    h String
    "map %s %s %s %s\n" (String -> String
    forall a. Show a => a -> String
    show String
    theTerm)
                                                                         (String -> String
    forall a. Show a => a -> String
    show String
    inBytes)
                                                                         (Key -> String
    forall a. Show a => a -> String
    show Key
    k)
                                                                         ([Modifier] -> String
    forall a. Show a => a -> String
    show [Modifier]
    mods)
                (String, Event)
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    initInput :: Config -> ClassifyMap -> IO Input
    initInput :: Config -> ClassifyMap -> IO Input
    initInput Config
    config ClassifyMap
    classifyTable = do
        let Just Fd
    fd = Config -> Maybe Fd
    inputFd Config
    config
        Fd -> FdOption -> Bool -> IO ()
    setFdOption Fd
    fd FdOption
    NonBlockingRead Bool
    False
        Fd -> Config -> IO ()
    applyConfig Fd
    fd Config
    config
        MVar ()
    stopSync <- IO (MVar ())
    forall a. IO (MVar a)
    newEmptyMVar
        Input
    input <- TChan InternalEvent
    -> IO () -> IO () -> IORef Config -> Maybe Handle -> Input
    Input (TChan InternalEvent
     -> IO () -> IO () -> IORef Config -> Maybe Handle -> Input)
    -> IO (TChan InternalEvent)
    -> IO (IO () -> IO () -> IORef Config -> Maybe Handle -> Input)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> STM (TChan InternalEvent) -> IO (TChan InternalEvent)
    forall a. STM a -> IO a
    atomically STM (TChan InternalEvent)
    forall a. STM (TChan a)
    newTChan
                       IO (IO () -> IO () -> IORef Config -> Maybe Handle -> Input)
    -> IO (IO ())
    -> IO (IO () -> IORef Config -> Maybe Handle -> Input)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> IO () -> IO (IO ())
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (() -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
                       IO (IO () -> IORef Config -> Maybe Handle -> Input)
    -> IO (IO ()) -> IO (IORef Config -> Maybe Handle -> Input)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> IO () -> IO (IO ())
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (() -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
                       IO (IORef Config -> Maybe Handle -> Input)
    -> IO (IORef Config) -> IO (Maybe Handle -> Input)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Config -> IO (IORef Config)
    forall a. a -> IO (IORef a)
    newIORef Config
    config
                       IO (Maybe Handle -> Input) -> IO (Maybe Handle) -> IO Input
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> IO (Maybe Handle)
    -> (String -> IO (Maybe Handle))
    -> Maybe String
    -> IO (Maybe Handle)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Maybe Handle -> IO (Maybe Handle)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Handle
    forall a. Maybe a
    Nothing)
                                 (\String
    f -> Handle -> Maybe Handle
    forall a. a -> Maybe a
    Just (Handle -> Maybe Handle) -> IO Handle -> IO (Maybe Handle)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IOMode -> IO Handle
    openFile String
    f IOMode
    AppendMode)
                                 (Config -> Maybe String
    debugLog Config
    config)
        Input -> ClassifyMap -> IO ()
    logInitialInputState Input
    input ClassifyMap
    classifyTable
        ThreadId
    inputThread <- IO () -> (Either SomeException () -> IO ()) -> IO ThreadId
    forall a. IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
    forkOSFinally (ClassifyMap -> Input -> IO ()
    runInputProcessorLoop ClassifyMap
    classifyTable Input
    input)
                                     (\Either SomeException ()
    _ -> MVar () -> () -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar ()
    stopSync ())
        let killAndWait :: IO ()
    killAndWait = do
              ThreadId -> IO ()
    killThread ThreadId
    inputThread
              MVar () -> IO ()
    forall a. MVar a -> IO a
    takeMVar MVar ()
    stopSync
        Input -> IO Input
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Input -> IO Input) -> Input -> IO Input
    forall a b. (a -> b) -> a -> b
    $ Input
    input { shutdownInput :: IO ()
    shutdownInput = IO ()
    killAndWait }

    foreign import ccall "vty_set_term_timing" setTermTiming :: Fd -> Int -> Int -> IO ()

    forkOSFinally :: IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
    forkOSFinally :: forall a. IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
    forkOSFinally IO a
    action Either SomeException a -> IO ()
    and_then =
      ((forall a. IO a -> IO a) -> IO ThreadId) -> IO ThreadId
    forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
    mask (((forall a. IO a -> IO a) -> IO ThreadId) -> IO ThreadId)
    -> ((forall a. IO a -> IO a) -> IO ThreadId) -> IO ThreadId
    forall a b. (a -> b) -> a -> b
    $ \forall a. IO a -> IO a
    restore -> IO () -> IO ThreadId
    forkOS (IO () -> IO ThreadId) -> IO () -> IO ThreadId
    forall a b. (a -> b) -> a -> b
    $ IO a -> IO (Either SomeException a)
    forall e a. Exception e => IO a -> IO (Either e a)
    try (IO a -> IO a
    forall a. IO a -> IO a
    restore IO a
    action) IO (Either SomeException a)
    -> (Either SomeException a -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Either SomeException a -> IO ()
    and_then

    (<>=) :: (MonadState s m, Monoid a) => ASetter' s a -> a -> m ()
    ASetter' s a
    l <>= :: forall s (m :: * -> *) a.
    (MonadState s m, Monoid a) =>
    ASetter' s a -> a -> m ()
    <>= a
    a = (s -> s) -> m ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (ASetter' s a
    l ASetter' s a -> a -> s -> s
    forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
    <>~ a
    a)

    (<>~) :: Monoid a => ASetter s t a a -> a -> s -> t
    ASetter s t a a
    l <>~ :: forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
    <>~ a
    n = ASetter s t a a -> (a -> a) -> s -> t
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
    over ASetter s t a a
    l (a -> a -> a
    forall a. Monoid a => a -> a -> a
    `mappend` a
    n)