    {-# LANGUAGE CPP #-}

    -- | 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
      , 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.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 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 appConfig :: 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 c :: Config
    c = do
        let doLog :: [Char] -> IO ()
    doLog s :: [Char]
    s = case Config -> Maybe [Char]
    debugLog Config
    c of
                Nothing -> () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                Just path :: [Char]
    path -> [Char] -> [Char] -> IO ()
    appendFile [Char]
    path ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "installWidthTable: " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    s [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> "\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 [Char]
    mTerm <- IO (Maybe [Char])
    currentTerminalName
            case Maybe [Char]
    mTerm of
                Nothing ->
                    [Char] -> IO ()
    doLog "No current terminal name available"
                Just currentTerm :: [Char]
    currentTerm ->
                    case [Char] -> [([Char], [Char])] -> Maybe [Char]
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup [Char]
    currentTerm (Config -> [([Char], [Char])]
    termWidthMaps Config
    c) of
                        Nothing ->
                            [Char] -> IO ()
    doLog "Current terminal not found in custom character width mapping list"
                        Just path :: [Char]
    path -> do
                            Either SomeException (Either [Char] UnicodeWidthTable)
    tableResult <- IO (Either [Char] UnicodeWidthTable)
    -> IO (Either SomeException (Either [Char] UnicodeWidthTable))
    forall e a. Exception e => IO a -> IO (Either e a)
    E.try (IO (Either [Char] UnicodeWidthTable)
     -> IO (Either SomeException (Either [Char] UnicodeWidthTable)))
    -> IO (Either [Char] UnicodeWidthTable)
    -> IO (Either SomeException (Either [Char] UnicodeWidthTable))
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO (Either [Char] UnicodeWidthTable)
    readUnicodeWidthTable [Char]
    path
                            case Either SomeException (Either [Char] UnicodeWidthTable)
    tableResult of
                                Left (SomeException
    e::E.SomeException) ->
                                    [Char] -> IO ()
    doLog ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "Error reading custom character width table " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <>
                                            "at " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    path [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> ": " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> SomeException -> [Char]
    forall a. Show a => a -> [Char]
    show SomeException
    e
                                Right (Left msg :: [Char]
    msg) ->
                                    [Char] -> IO ()
    doLog ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "Error reading custom character width table " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <>
                                            "at " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    path [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> ": " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    msg
                                Right (Right table :: 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) ->
                                            [Char] -> IO ()
    doLog ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "Error installing unicode table (" [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <>
                                                    [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    path [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> ": " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> SomeException -> [Char]
    forall a. Show a => a -> [Char]
    show SomeException
    e
                                        Right () ->
                                            [Char] -> IO ()
    doLog ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "Successfully installed Unicode width table " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <>
                                                    " from " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    path

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

        TVar Bool
    shutdownVar <- STM (TVar Bool) -> IO (TVar Bool)
    forall a. STM a -> IO a
    atomically (STM (TVar Bool) -> IO (TVar Bool))
    -> STM (TVar Bool) -> IO (TVar Bool)
    forall a b. (a -> b) -> a -> b
    $ Bool -> STM (TVar Bool)
    forall a. a -> STM (TVar a)
    newTVar 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 = 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 -> STM Bool
    forall a. TVar a -> STM a
    readTVar 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 inPic :: 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
                    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 (m :: * -> *) a. Monad m => a -> m a
    return (DisplayRegion
    b, DisplayContext
    dc)
                    Just (lastBounds, 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 (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 (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 (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
            gkey :: IO Event
    gkey = do
                Event
    k <- STM Event -> IO Event
    forall a. STM a -> IO a
    atomically (STM Event -> IO Event) -> STM Event -> IO Event
    forall a b. (a -> b) -> a -> b
    $ TChan Event -> STM Event
    forall a. TChan a -> STM a
    readTChan (TChan Event -> STM Event) -> TChan Event -> STM Event
    forall a b. (a -> b) -> a -> b
    $ Input -> TChan Event
    _eventChannel Input
    input
                case Event
    k of
                    (EvResize _ _)  -> IO Event
    mkResize
                    _ -> Event -> IO Event
    forall (m :: * -> *) a. Monad m => a -> m a
    return Event
    k
            gkey' :: IO (Maybe Event)
    gkey' = do
                Maybe Event
    k <- STM (Maybe Event) -> IO (Maybe Event)
    forall a. STM a -> IO a
    atomically (STM (Maybe Event) -> IO (Maybe Event))
    -> STM (Maybe Event) -> IO (Maybe Event)
    forall a b. (a -> b) -> a -> b
    $ TChan Event -> STM (Maybe Event)
    forall a. TChan a -> STM (Maybe a)
    tryReadTChan (TChan Event -> STM (Maybe Event))
    -> TChan Event -> STM (Maybe Event)
    forall a b. (a -> b) -> a -> b
    $ Input -> TChan Event
    _eventChannel Input
    input
                case Maybe Event
    k of
                    (Just (EvResize _ _))  -> 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
    <$> IO Event
    mkResize
                    _ -> Maybe Event -> IO (Maybe Event)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Event
    k

        Vty -> IO Vty
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Vty -> IO Vty) -> Vty -> IO Vty
    forall a b. (a -> b) -> a -> b
    $ Vty :: (Picture -> IO ())
    -> IO Event
    -> IO (Maybe Event)
    -> Input
    -> Output
    -> IO ()
    -> IO ()
    -> IO Bool
    -> Vty
    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
                     }