    {-# LANGUAGE RecordWildCards #-}
    {-# OPTIONS_HADDOCK hide #-}
    {-# LANGUAGE NoMonomorphismRestriction #-}
    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE CPP #-}
    -- | 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 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 Data.Char
    import Data.IORef
    import Data.Word (Word8)

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

    import System.IO
    import System.Posix.IO (fdReadBuf, setFdOption, FdOption(..))
    import System.Posix.Terminal
    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 Event
    _eventChannel  :: TChan Event
          -- | Shuts down the input processing. This should return the
          -- terminal input state to before he input initialized.
        , Input -> IO ()
    shutdownInput :: 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 -> String
    _unprocessedBytes :: String
        , InputState -> Config
    _appliedConfig :: Config
        , InputState -> InputBuffer
    _inputBuffer :: InputBuffer
        , InputState -> String -> KClass
    _classifier :: String -> KClass
        }

    makeLenses ''InputState

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

    logMsg :: String -> InputM ()
    logMsg :: String -> InputM ()
    logMsg msg :: 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
            Nothing -> () -> InputM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            Just h :: Handle
    h -> IO () -> InputM ()
    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 (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 String
    readFromDevice InputM String -> (String -> InputM ()) -> InputM ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> InputM ()
    addBytesToProcess
        [Event]
    validEvents <- StateT InputState (ReaderT Input IO) Event
    -> StateT InputState (ReaderT Input IO) [Event]
    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 :: String -> InputM ()
    addBytesToProcess :: String -> InputM ()
    addBytesToProcess block :: String
    block = (String -> Identity String) -> InputState -> Identity InputState
    Lens' InputState String
    unprocessedBytes ((String -> Identity String) -> InputState -> Identity InputState)
    -> String -> InputM ()
    forall s (m :: * -> *) a.
    (MonadState s m, Monoid a) =>
    ASetter' s a -> a -> m ()
    <>= String
    block

    emit :: Event -> InputM ()
    emit :: Event -> InputM ()
    emit event :: Event
    event = do
        String -> InputM ()
    logMsg (String -> InputM ()) -> String -> InputM ()
    forall a b. (a -> b) -> a -> b
    $ "parsed event: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Event -> String
    forall a. Show a => a -> String
    show Event
    event
        Getting (TChan Event) Input (TChan Event)
    -> StateT InputState (ReaderT Input IO) (TChan Event)
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting (TChan Event) Input (TChan Event)
    Lens' Input (TChan Event)
    eventChannel StateT InputState (ReaderT Input IO) (TChan Event)
    -> (TChan Event -> InputM ()) -> InputM ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO () -> InputM ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> InputM ())
    -> (TChan Event -> IO ()) -> TChan Event -> InputM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . STM () -> IO ()
    forall a. STM a -> IO a
    atomically (STM () -> IO ())
    -> (TChan Event -> STM ()) -> TChan Event -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (TChan Event -> Event -> STM ()) -> Event -> TChan Event -> STM ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip TChan Event -> Event -> STM ()
    forall a. TChan a -> a -> STM ()
    writeTChan 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 String
    readFromDevice :: InputM String
    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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO Config -> StateT InputState (ReaderT Input IO) Config
    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
    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
    $ "new config: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Config -> String
    forall a. Show a => a -> String
    show Config
    newConfig
            IO () -> InputM ()
    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
        String
    stringRep <- IO String -> InputM String
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO String -> InputM String) -> IO String -> InputM String
    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
    > 0
            then ([Word8] -> String) -> IO [Word8] -> IO String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Word8 -> Char) -> [Word8] -> String
    forall a b. (a -> b) -> [a] -> [b]
    map ((Word8 -> Char) -> [Word8] -> String)
    -> (Word8 -> Char) -> [Word8] -> String
    forall a b. (a -> b) -> a -> b
    $ Int -> Char
    chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral) (IO [Word8] -> IO String) -> IO [Word8] -> IO String
    forall a b. (a -> b) -> a -> b
    $ Int -> Ptr Word8 -> IO [Word8]
    forall a. Storable a => Int -> Ptr a -> IO [a]
    peekArray (ByteCount -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ByteCount
    bytesRead) Ptr Word8
    bufferPtr
            else String -> IO String
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        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
    $ String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    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
    $ "input bytes: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    stringRep
        String -> InputM String
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    stringRep

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

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

    dropInvalid :: InputM ()
    dropInvalid :: InputM ()
    dropInvalid = do
        String -> KClass
    c <- Getting (String -> KClass) InputState (String -> KClass)
    -> StateT InputState (ReaderT Input IO) (String -> KClass)
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
    use Getting (String -> KClass) InputState (String -> KClass)
    Lens' InputState (String -> KClass)
    classifier
        String
    b <- Getting String InputState String -> InputM String
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
    use Getting String InputState String
    Lens' InputState String
    unprocessedBytes
        Bool -> InputM () -> InputM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (String -> KClass
    c String
    b KClass -> KClass -> Bool
    forall a. Eq a => a -> a -> Bool
    == KClass
    Invalid) (InputM () -> InputM ()) -> InputM () -> InputM ()
    forall a b. (a -> b) -> a -> b
    $ do
            String -> InputM ()
    logMsg "dropping input bytes"
            (String -> Identity String) -> InputState -> Identity InputState
    Lens' InputState String
    unprocessedBytes ((String -> Identity String) -> InputState -> Identity InputState)
    -> String -> InputM ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    ASetter s s a b -> b -> m ()
    .= []

    runInputProcessorLoop :: ClassifyMap -> Input -> IO ()
    runInputProcessorLoop :: ClassifyMap -> Input -> IO ()
    runInputProcessorLoop classifyTable :: ClassifyMap
    classifyTable input :: Input
    input = do
        let bufferSize :: p
    bufferSize = 1024
        Int -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
    allocaArray Int
    forall p. Num p => p
    bufferSize ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(Ptr Word8
    bufferPtr :: Ptr Word8) -> do
            InputState
    s0 <- String -> Config -> InputBuffer -> (String -> KClass) -> InputState
    InputState [] (Config -> InputBuffer -> (String -> KClass) -> InputState)
    -> IO Config
    -> IO (InputBuffer -> (String -> 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 -> (String -> KClass) -> InputState)
    -> IO InputBuffer -> IO ((String -> KClass) -> InputState)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> InputBuffer -> IO InputBuffer
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Ptr Word8 -> Int -> InputBuffer
    InputBuffer Ptr Word8
    bufferPtr Int
    forall p. Num p => p
    bufferSize)
                                IO ((String -> KClass) -> InputState)
    -> IO (String -> KClass) -> IO InputState
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (String -> KClass) -> IO (String -> KClass)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ClassifyMap -> String -> 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

    attributeControl :: Fd -> IO (IO (), IO ())
    attributeControl :: Fd -> IO (IO (), IO ())
    attributeControl fd :: Fd
    fd = do
        TerminalAttributes
    original <- Fd -> IO TerminalAttributes
    getTerminalAttributes Fd
    fd
        let vtyMode :: TerminalAttributes
    vtyMode = (TerminalAttributes -> TerminalMode -> TerminalAttributes)
    -> TerminalAttributes -> [TerminalMode] -> TerminalAttributes
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl TerminalAttributes -> TerminalMode -> TerminalAttributes
    withoutMode TerminalAttributes
    original [ TerminalMode
    StartStopOutput, TerminalMode
    KeyboardInterrupts
                                                 , TerminalMode
    EnableEcho, TerminalMode
    ProcessInput, TerminalMode
    ExtendedFunctions
                                                 ]
        let setAttrs :: IO ()
    setAttrs = Fd -> TerminalAttributes -> TerminalState -> IO ()
    setTerminalAttributes Fd
    fd TerminalAttributes
    vtyMode TerminalState
    Immediately
            unsetAttrs :: IO ()
    unsetAttrs = Fd -> TerminalAttributes -> TerminalState -> IO ()
    setTerminalAttributes Fd
    fd TerminalAttributes
    original TerminalState
    Immediately
        (IO (), IO ()) -> IO (IO (), IO ())
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IO ()
    setAttrs,IO ()
    unsetAttrs)

    logInitialInputState :: Input -> ClassifyMap -> IO()
    logInitialInputState :: Input -> ClassifyMap -> IO ()
    logInitialInputState input :: Input
    input classifyTable :: ClassifyMap
    classifyTable = case Input -> Maybe Handle
    _inputDebug Input
    input of
        Nothing -> () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        Just h :: Handle
    h  -> do
            Config{ vmin :: Config -> Maybe Int
    vmin = Just theVmin :: Int
    theVmin
                  , vtime :: Config -> Maybe Int
    vtime = Just theVtime :: Int
    theVtime
                  , termName :: Config -> Maybe String
    termName = Just theTerm :: 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 "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
    $ \i :: (String, Event)
    i -> case (String, Event)
    i of
                (inBytes :: String
    inBytes, EvKey k :: Key
    k mods :: [Modifier]
    mods) -> Handle -> String -> String -> String -> String -> String -> IO ()
    forall r. HPrintfType r => Handle -> String -> r
    hPrintf Handle
    h "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)
                _ -> () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    initInput :: Config -> ClassifyMap -> IO Input
    initInput :: Config -> ClassifyMap -> IO Input
    initInput config :: Config
    config classifyTable :: ClassifyMap
    classifyTable = do
        let Just fd :: 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 Event -> IO () -> IORef Config -> Maybe Handle -> Input
    Input (TChan Event -> IO () -> IORef Config -> Maybe Handle -> Input)
    -> IO (TChan Event)
    -> IO (IO () -> IORef Config -> Maybe Handle -> Input)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> STM (TChan Event) -> IO (TChan Event)
    forall a. STM a -> IO a
    atomically STM (TChan Event)
    forall a. STM (TChan a)
    newTChan
                       IO (IO () -> IORef Config -> Maybe Handle -> Input)
    -> IO (IO ()) -> IO (IORef Config -> Maybe Handle -> Input)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> IO () -> IO (IO ())
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (() -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
                       IO (IORef Config -> Maybe Handle -> Input)
    -> IO (IORef Config) -> IO (Maybe Handle -> Input)
    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 (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 (m :: * -> *) a. Monad m => a -> m a
    return Maybe Handle
    forall a. Maybe a
    Nothing)
                                 (\f :: 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)
                                     (\_ -> 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 (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 :: IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
    forkOSFinally action :: IO a
    action and_then :: 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
    $ \restore :: 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 (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 ()
    l :: ASetter' s a
    l <>= :: ASetter' s a -> a -> m ()
    <>= a :: 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
    l :: ASetter s t a a
    l <>~ :: ASetter s t a a -> a -> s -> t
    <>~ n :: 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)