    {-# LANGUAGE CPP #-}
    {-# LANGUAGE ScopedTypeVariables #-}

    -- | Vty provides interfaces for both terminal input and terminal
    -- output.
    --
    -- - Input to the terminal is provided to the Vty application as a
    --   sequence of 'Event's.
    --
    -- - Output is provided to Vty by the application in the form of a
    --   'Picture'. A 'Picture' is one or more layers of 'Image's.
    --   'Image' values can be built by the various constructors in
    --   "Graphics.Vty.Image". Output can be syled using 'Attr' (attribute)
    --   values in the "Graphics.Vty.Attributes" module.
    --
    -- Vty uses threads internally, so programs made with Vty need to be
    -- compiled with the threaded runtime using the GHC @-threaded@ option.
    --
    -- @
    --  import "Graphics.Vty"
    --
    --  main = do
    --      cfg <- 'standardIOConfig'
    --      vty <- 'mkVty' cfg
    --      let line0 = 'string' ('defAttr' ` 'withForeColor' ` 'green') \"first line\"
    --          line1 = 'string' ('defAttr' ` 'withBackColor' ` 'blue') \"second line\"
    --          img = line0 '<->' line1
    --          pic = 'picForImage' img
    --      'update' vty pic
    --      e <- 'nextEvent' vty
    --      'shutdown' vty
    --      'print' (\"Last event was: \" '++' 'show' e)
    -- @
    module Graphics.Vty
      ( Vty(..)
      , mkVty
      , setWindowTitle
      , Mode(..)
      , module Graphics.Vty.Config
      , module Graphics.Vty.Input
      , module Graphics.Vty.Output
      , module Graphics.Vty.Output.Interface
      , module Graphics.Vty.Picture
      , module Graphics.Vty.Image
      , module Graphics.Vty.Attributes
      )
    where

    import Graphics.Vty.Config
    import Graphics.Vty.Input
    import Graphics.Vty.Input.Events
    import Graphics.Vty.Output
    import Graphics.Vty.Output.Interface
    import Graphics.Vty.Picture
    import Graphics.Vty.Image
    import Graphics.Vty.Attributes
    import Graphics.Vty.UnicodeWidthTable.IO
    import Graphics.Vty.UnicodeWidthTable.Install

    import Data.Char (isPrint, showLitChar)
    import qualified Data.ByteString.Char8 as BS8

    import qualified Control.Exception as E
    import Control.Monad (when)
    import Control.Concurrent.STM

    import Data.IORef
    #if !(MIN_VERSION_base(4,11,0))
    import Data.Semigroup ((<>))
    #endif

    -- | A Vty value represents a handle to the Vty library that the
    -- application must create in order to use Vty.
    --
    -- The use of Vty typically follows this process:
    --
    --    1. Initialize vty with 'mkVty' (this takes control of the terminal).
    --
    --    2. Use 'update' to display a picture.
    --
    --    3. Use 'nextEvent' to get the next input event.
    --
    --    4. Depending on the event, go to 2 or 5.
    --
    --    5. Shutdown vty and restore the terminal state with 'shutdown'. At
    --    this point the 'Vty' handle cannot be used again.
    --
    -- Operations on Vty handles are not thread-safe.
    data Vty =
        Vty { Vty -> Picture -> IO ()
    update :: Picture -> IO ()
            -- ^ Outputs the given 'Picture'.
            , Vty -> IO Event
    nextEvent :: IO Event
            -- ^ Return the next 'Event' or block until one becomes
            -- available.
            , Vty -> IO (Maybe Event)
    nextEventNonblocking :: IO (Maybe Event)
            -- ^ Non-blocking version of 'nextEvent'.
            , Vty -> Input
    inputIface :: Input
            -- ^ The input interface. See 'Input'.
            , Vty -> Output
    outputIface :: Output
            -- ^ The output interface. See 'Output'.
            , Vty -> IO ()
    refresh :: IO ()
            -- ^ Refresh the display. If other programs output to the
            -- terminal and mess up the display then the application might
            -- want to force a refresh using this function.
            , Vty -> IO ()
    shutdown :: IO ()
            -- ^ Clean up after vty. A call to this function is necessary to
            -- cleanly restore the terminal state before application exit.
            -- The above methods will throw an exception if executed after
            -- this is executed. Idempotent.
            , Vty -> IO Bool
    isShutdown :: IO Bool
            }

    -- | Create a Vty handle. At most one handle should be created at a time
    -- for a given terminal device.
    --
    -- The specified configuration is added to the the configuration
    -- loaded by 'userConfig' with the 'userConfig' configuration taking
    -- precedence. See "Graphics.Vty.Config".
    --
    -- For most applications @mkVty defaultConfig@ is sufficient.
    mkVty :: Config -> IO Vty
    mkVty :: Config -> IO Vty
    mkVty Config
    appConfig = do
        Config
    config <- (Config -> Config -> Config
    forall a. Semigroup a => a -> a -> a
    <> Config
    appConfig) (Config -> Config) -> IO Config -> IO Config
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO Config
    userConfig

        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Config -> Maybe Bool
    allowCustomUnicodeWidthTables Config
    config Maybe Bool -> Maybe Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            Config -> IO ()
    installCustomWidthTable Config
    config

        Input
    input <- Config -> IO Input
    inputForConfig Config
    config
        Output
    out <- Config -> IO Output
    outputForConfig Config
    config
        Input -> Output -> IO Vty
    internalMkVty Input
    input Output
    out

    installCustomWidthTable :: Config -> IO ()
    installCustomWidthTable :: Config -> IO ()
    installCustomWidthTable Config
    c = do
        let doLog :: String -> IO ()
    doLog String
    s = case Config -> Maybe String
    debugLog Config
    c of
                Maybe String
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                Just String
    path -> String -> String -> IO ()
    appendFile String
    path (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "installWidthTable: " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    s String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    "\n"

        Bool
    customInstalled <- IO Bool
    isCustomTableReady
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not Bool
    customInstalled) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            Maybe String
    mTerm <- IO (Maybe String)
    currentTerminalName
            case Maybe String
    mTerm of
                Maybe String
    Nothing ->
                    String -> IO ()
    doLog String
    "No current terminal name available"
                Just String
    currentTerm ->
                    case String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    currentTerm (Config -> [(String, String)]
    termWidthMaps Config
    c) of
                        Maybe String
    Nothing ->
                            String -> IO ()
    doLog String
    "Current terminal not found in custom character width mapping list"
                        Just String
    path -> do
                            Either SomeException (Either String UnicodeWidthTable)
    tableResult <- IO (Either String UnicodeWidthTable)
    -> IO (Either SomeException (Either String UnicodeWidthTable))
    forall e a. Exception e => IO a -> IO (Either e a)
    E.try (IO (Either String UnicodeWidthTable)
     -> IO (Either SomeException (Either String UnicodeWidthTable)))
    -> IO (Either String UnicodeWidthTable)
    -> IO (Either SomeException (Either String UnicodeWidthTable))
    forall a b. (a -> b) -> a -> b
    $ String -> IO (Either String UnicodeWidthTable)
    readUnicodeWidthTable String
    path
                            case Either SomeException (Either String UnicodeWidthTable)
    tableResult of
                                Left (SomeException
    e::E.SomeException) ->
                                    String -> IO ()
    doLog (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Error reading custom character width table " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <>
                                            String
    "at " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String -> String
    forall a. Show a => a -> String
    show String
    path String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    ": " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> SomeException -> String
    forall a. Show a => a -> String
    show SomeException
    e
                                Right (Left String
    msg) ->
                                    String -> IO ()
    doLog (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Error reading custom character width table " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <>
                                            String
    "at " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String -> String
    forall a. Show a => a -> String
    show String
    path String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    ": " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    msg
                                Right (Right UnicodeWidthTable
    table) -> do
                                    Either SomeException ()
    installResult <- IO () -> IO (Either SomeException ())
    forall e a. Exception e => IO a -> IO (Either e a)
    E.try (IO () -> IO (Either SomeException ()))
    -> IO () -> IO (Either SomeException ())
    forall a b. (a -> b) -> a -> b
    $ UnicodeWidthTable -> IO ()
    installUnicodeWidthTable UnicodeWidthTable
    table
                                    case Either SomeException ()
    installResult of
                                        Left (SomeException
    e::E.SomeException) ->
                                            String -> IO ()
    doLog (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Error installing unicode table (" String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <>
                                                    String -> String
    forall a. Show a => a -> String
    show String
    path String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    ": " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> SomeException -> String
    forall a. Show a => a -> String
    show SomeException
    e
                                        Right () ->
                                            String -> IO ()
    doLog (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Successfully installed Unicode width table " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <>
                                                    String
    " from " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String -> String
    forall a. Show a => a -> String
    show String
    path

    internalMkVty :: Input -> Output -> IO Vty
    internalMkVty :: Input -> Output -> IO Vty
    internalMkVty Input
    input Output
    out = do
        Output -> IO ()
    reserveDisplay Output
    out

        TVar Bool
    shutdownVar <- Bool -> IO (TVar Bool)
    forall a. a -> IO (TVar a)
    newTVarIO Bool
    False
        let shutdownIo :: IO ()
    shutdownIo = do
                Bool
    alreadyShutdown <- STM Bool -> IO Bool
    forall a. STM a -> IO a
    atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ TVar Bool -> Bool -> STM Bool
    forall a. TVar a -> a -> STM a
    swapTVar TVar Bool
    shutdownVar Bool
    True
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not Bool
    alreadyShutdown) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                    Input -> IO ()
    shutdownInput Input
    input
                    Output -> IO ()
    releaseDisplay Output
    out
                    Output -> IO ()
    releaseTerminal Output
    out

        let shutdownStatus :: IO Bool
    shutdownStatus = TVar Bool -> IO Bool
    forall a. TVar a -> IO a
    readTVarIO TVar Bool
    shutdownVar

        IORef (Maybe Picture)
    lastPicRef <- Maybe Picture -> IO (IORef (Maybe Picture))
    forall a. a -> IO (IORef a)
    newIORef Maybe Picture
    forall a. Maybe a
    Nothing
        IORef (Maybe (DisplayRegion, DisplayContext))
    lastUpdateRef <- Maybe (DisplayRegion, DisplayContext)
    -> IO (IORef (Maybe (DisplayRegion, DisplayContext)))
    forall a. a -> IO (IORef a)
    newIORef Maybe (DisplayRegion, DisplayContext)
    forall a. Maybe a
    Nothing

        let innerUpdate :: Picture -> IO ()
    innerUpdate Picture
    inPic = do
                DisplayRegion
    b <- Output -> IO DisplayRegion
    displayBounds Output
    out
                Maybe (DisplayRegion, DisplayContext)
    mlastUpdate <- IORef (Maybe (DisplayRegion, DisplayContext))
    -> IO (Maybe (DisplayRegion, DisplayContext))
    forall a. IORef a -> IO a
    readIORef IORef (Maybe (DisplayRegion, DisplayContext))
    lastUpdateRef
                (DisplayRegion, DisplayContext)
    updateData <- case Maybe (DisplayRegion, DisplayContext)
    mlastUpdate of
                    Maybe (DisplayRegion, DisplayContext)
    Nothing -> do
                        DisplayContext
    dc <- Output -> DisplayRegion -> IO DisplayContext
    displayContext Output
    out DisplayRegion
    b
                        DisplayContext -> Picture -> IO ()
    outputPicture DisplayContext
    dc Picture
    inPic
                        (DisplayRegion, DisplayContext)
    -> IO (DisplayRegion, DisplayContext)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DisplayRegion
    b, DisplayContext
    dc)
                    Just (DisplayRegion
    lastBounds, DisplayContext
    lastContext) -> do
                        if DisplayRegion
    b DisplayRegion -> DisplayRegion -> Bool
    forall a. Eq a => a -> a -> Bool
    /= DisplayRegion
    lastBounds
                            then do
                                DisplayContext
    dc <- Output -> DisplayRegion -> IO DisplayContext
    displayContext Output
    out DisplayRegion
    b
                                DisplayContext -> Picture -> IO ()
    outputPicture DisplayContext
    dc Picture
    inPic
                                (DisplayRegion, DisplayContext)
    -> IO (DisplayRegion, DisplayContext)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DisplayRegion
    b, DisplayContext
    dc)
                            else do
                                DisplayContext -> Picture -> IO ()
    outputPicture DisplayContext
    lastContext Picture
    inPic
                                (DisplayRegion, DisplayContext)
    -> IO (DisplayRegion, DisplayContext)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DisplayRegion
    b, DisplayContext
    lastContext)
                IORef (Maybe (DisplayRegion, DisplayContext))
    -> Maybe (DisplayRegion, DisplayContext) -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (Maybe (DisplayRegion, DisplayContext))
    lastUpdateRef (Maybe (DisplayRegion, DisplayContext) -> IO ())
    -> Maybe (DisplayRegion, DisplayContext) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (DisplayRegion, DisplayContext)
    -> Maybe (DisplayRegion, DisplayContext)
    forall a. a -> Maybe a
    Just (DisplayRegion, DisplayContext)
    updateData
                IORef (Maybe Picture) -> Maybe Picture -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (Maybe Picture)
    lastPicRef (Maybe Picture -> IO ()) -> Maybe Picture -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Picture -> Maybe Picture
    forall a. a -> Maybe a
    Just Picture
    inPic

        let innerRefresh :: IO ()
    innerRefresh = do
                IORef (Maybe (DisplayRegion, DisplayContext))
    -> Maybe (DisplayRegion, DisplayContext) -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (Maybe (DisplayRegion, DisplayContext))
    lastUpdateRef Maybe (DisplayRegion, DisplayContext)
    forall a. Maybe a
    Nothing
                DisplayRegion
    bounds <- Output -> IO DisplayRegion
    displayBounds Output
    out
                DisplayContext
    dc <- Output -> DisplayRegion -> IO DisplayContext
    displayContext Output
    out DisplayRegion
    bounds
                IORef AssumedState -> AssumedState -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef (Output -> IORef AssumedState
    assumedStateRef (Output -> IORef AssumedState) -> Output -> IORef AssumedState
    forall a b. (a -> b) -> a -> b
    $ DisplayContext -> Output
    contextDevice DisplayContext
    dc) AssumedState
    initialAssumedState
                Maybe Picture
    mPic <- IORef (Maybe Picture) -> IO (Maybe Picture)
    forall a. IORef a -> IO a
    readIORef IORef (Maybe Picture)
    lastPicRef
                IO () -> (Picture -> IO ()) -> Maybe Picture -> IO ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (() -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) Picture -> IO ()
    innerUpdate Maybe Picture
    mPic

        let mkResize :: IO Event
    mkResize = (Int -> Int -> Event) -> DisplayRegion -> Event
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Int -> Int -> Event
    EvResize (DisplayRegion -> Event) -> IO DisplayRegion -> IO Event
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Output -> IO DisplayRegion
    displayBounds Output
    out

            translateInternalEvent :: InternalEvent -> IO Event
    translateInternalEvent InternalEvent
    ResumeAfterSignal = IO Event
    mkResize
            translateInternalEvent (InputEvent Event
    e)    = Event -> IO Event
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Event
    e

            gkey :: IO Event
    gkey = do
                InternalEvent
    e <- STM InternalEvent -> IO InternalEvent
    forall a. STM a -> IO a
    atomically (STM InternalEvent -> IO InternalEvent)
    -> STM InternalEvent -> IO InternalEvent
    forall a b. (a -> b) -> a -> b
    $ TChan InternalEvent -> STM InternalEvent
    forall a. TChan a -> STM a
    readTChan (TChan InternalEvent -> STM InternalEvent)
    -> TChan InternalEvent -> STM InternalEvent
    forall a b. (a -> b) -> a -> b
    $ Input -> TChan InternalEvent
    _eventChannel Input
    input
                InternalEvent -> IO Event
    translateInternalEvent InternalEvent
    e
            gkey' :: IO (Maybe Event)
    gkey' = do
                Maybe InternalEvent
    mEv <- STM (Maybe InternalEvent) -> IO (Maybe InternalEvent)
    forall a. STM a -> IO a
    atomically (STM (Maybe InternalEvent) -> IO (Maybe InternalEvent))
    -> STM (Maybe InternalEvent) -> IO (Maybe InternalEvent)
    forall a b. (a -> b) -> a -> b
    $ TChan InternalEvent -> STM (Maybe InternalEvent)
    forall a. TChan a -> STM (Maybe a)
    tryReadTChan (TChan InternalEvent -> STM (Maybe InternalEvent))
    -> TChan InternalEvent -> STM (Maybe InternalEvent)
    forall a b. (a -> b) -> a -> b
    $ Input -> TChan InternalEvent
    _eventChannel Input
    input
                case Maybe InternalEvent
    mEv of
                    Just InternalEvent
    e  -> Event -> Maybe Event
    forall a. a -> Maybe a
    Just (Event -> Maybe Event) -> IO Event -> IO (Maybe Event)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> InternalEvent -> IO Event
    translateInternalEvent InternalEvent
    e
                    Maybe InternalEvent
    Nothing -> Maybe Event -> IO (Maybe Event)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Event
    forall a. Maybe a
    Nothing

        Vty -> IO Vty
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Vty -> IO Vty) -> Vty -> IO Vty
    forall a b. (a -> b) -> a -> b
    $ Vty { update :: Picture -> IO ()
    update = Picture -> IO ()
    innerUpdate
                     , nextEvent :: IO Event
    nextEvent = IO Event
    gkey
                     , nextEventNonblocking :: IO (Maybe Event)
    nextEventNonblocking = IO (Maybe Event)
    gkey'
                     , inputIface :: Input
    inputIface = Input
    input
                     , outputIface :: Output
    outputIface = Output
    out
                     , refresh :: IO ()
    refresh = IO ()
    innerRefresh
                     , shutdown :: IO ()
    shutdown = IO ()
    shutdownIo
                     , isShutdown :: IO Bool
    isShutdown = IO Bool
    shutdownStatus
                     }

    -- | Set the terminal window title string.
    --
    -- This function emits an Xterm-compatible escape sequence that we
    -- anticipate will work for essentially all modern terminal emulators.
    -- Ideally we'd use a terminal capability for this, but there does not
    -- seem to exist a termcap for setting window titles. If you find that
    -- this function does not work for a given terminal emulator, please
    -- report the issue.
    --
    -- For details, see:
    --
    -- https://tldp.org/HOWTO/Xterm-Title-3.html
    setWindowTitle :: Vty -> String -> IO ()
    setWindowTitle :: Vty -> String -> IO ()
    setWindowTitle Vty
    vty String
    title = do
        let sanitize :: String -> String
            sanitize :: String -> String
    sanitize = (Char -> String) -> String -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Char -> String
    sanitizeChar
            sanitizeChar :: Char -> String
    sanitizeChar Char
    c | Bool -> Bool
    not (Char -> Bool
    isPrint Char
    c) = Char -> String -> String
    showLitChar Char
    c String
    ""
                           | Bool
    otherwise = [Char
    c]
        let buf :: ByteString
    buf = String -> ByteString
    BS8.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ String
    "\ESC]2;" String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String -> String
    sanitize String
    title String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    "\007"
        Output -> ByteString -> IO ()
    outputByteBuffer (Vty -> Output
    outputIface Vty
    vty) ByteString
    buf