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

    -- | Vty provides interfaces for both terminal input and terminal
    -- output.
    --
    -- - User input to the terminal is provided to the Vty application as a
    --   sequence of 'Event's.
    --
    -- - Output is provided to by the application to Vty 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.
    --
    -- - Each platform on which Vty is supported provides a package that
    --   provides Vty with access to the platform-specific terminal
    --   interface. For example, on Unix systems, the @vty-unix@ package
    --   must be used to initialize Vty with access to a Unix terminal.
    --
    -- As a small example, the following program demonstrates the use of Vty
    -- on a Unix system using the @vty-unix@ package:
    --
    -- > import Graphics.Vty
    -- > import Graphics.Vty.Platform.Unix (mkVty)
    -- >
    -- > main = do
    -- >     vty <- mkVty defaultConfig
    -- >     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)
    --
    -- Vty uses threads internally, so programs made with Vty must be
    -- compiled with the threaded runtime using the GHC @-threaded@ option.
    module Graphics.Vty
      ( Vty(..)
      , setWindowTitle
      , installCustomWidthTable
      , mkVtyFromPair
      , module Graphics.Vty.Config
      , module Graphics.Vty.Input
      , module Graphics.Vty.Input.Events
      , module Graphics.Vty.Output
      , 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.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 this library typically follows this process:
    --
    -- 1. Initialize Vty with the 'mkVty' implementation for your
    -- platform's Vty package (e.g. @vty-unix@), or, more generically, with
    -- 'mkVtyFromPair'. This takes control of (and sets up) 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 ()
            -- ^ Output the given 'Picture' to the terminal.
            , 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
            }

    -- | Attempt to load and install a custom character width table into
    -- this process.
    --
    -- This looks up the specified terminal name in the specified width
    -- table map and, if a map file path is found, the map is loaded and
    -- installed. This is exposed for Vty platform package implementors;
    -- application developers should never need to call this.
    installCustomWidthTable :: Maybe FilePath
                            -- ^ Optional path to a log file where log
                            -- messages should be written when attempting to
                            -- load a width table.
                            -> Maybe String
                            -- ^ Optional width table entry name (usually
                            -- the terminal name, e.g. value of @TERM@ on
                            -- Unix systems). If omitted, this function does
                            -- not attempt to load a table.
                            -> [(String, FilePath)]
                            -- ^ Mapping from width table entry names to
                            -- width table file paths. This is usually
                            -- obtained from 'configTermWidthMaps' of
                            -- 'VtyUserConfig'.
                            -> IO ()
    installCustomWidthTable :: Maybe String -> Maybe String -> [(String, String)] -> IO ()
    installCustomWidthTable Maybe String
    logPath Maybe String
    tblName [(String, String)]
    widthMaps = do
        let doLog :: String -> IO ()
    doLog String
    s = case Maybe String
    logPath 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"

        customInstalled <- IO Bool
    isCustomTableReady
        when (not customInstalled) $ do
            case tblName of
                Maybe String
    Nothing ->
                    String -> IO ()
    doLog String
    "No terminal name given in the configuration, skipping load"
                Just String
    name ->
                    case String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    name [(String, String)]
    widthMaps of
                        Maybe String
    Nothing ->
                            String -> IO ()
    doLog (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Width table " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String -> String
    forall a. Show a => a -> String
    show String
    name String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    " not found in custom character width mapping list"
                        Just String
    path -> do
                            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 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
                                    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 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

    -- | Build a 'Vty' handle from an input/output pair.
    --
    -- This is exposed for Vty platform package implementors; application
    -- developers should never need to call this, and should instead call
    -- @mkVty@ or equivalent from their platform package of choice.
    mkVtyFromPair :: Input -> Output -> IO Vty
    mkVtyFromPair :: Input -> Output -> IO Vty
    mkVtyFromPair Input
    input Output
    out = do
        Output -> IO ()
    reserveDisplay Output
    out

        shutdownVar <- Bool -> IO (TVar Bool)
    forall a. a -> IO (TVar a)
    newTVarIO Bool
    False
        let shutdownIo = do
                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
                when (not alreadyShutdown) $ do
                    shutdownInput input
                    releaseDisplay out
                    releaseTerminal out

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

        lastPicRef <- newIORef Nothing
        lastUpdateRef <- newIORef Nothing

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

            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
                bounds <- Output -> IO DisplayRegion
    displayBounds Output
    out
                dc <- displayContext out bounds
                writeIORef (assumedStateRef $ contextDevice dc) initialAssumedState
                mPic <- readIORef lastPicRef
                maybe (return ()) innerUpdate mPic

            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
    ResumeAfterInterrupt = 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 = do
                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
                translateInternalEvent e
            gkey' = do
                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 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

        return $ Vty { update = innerUpdate
                     , nextEvent = gkey
                     , nextEventNonblocking = gkey'
                     , inputIface = input
                     , outputIface = out
                     , refresh = innerRefresh
                     , shutdown = shutdownIo
                     , isShutdown = shutdownStatus
                     }

    -- | Set the terminal window title string.
    setWindowTitle :: Vty -> String -> IO ()
    setWindowTitle :: Vty -> String -> IO ()
    setWindowTitle Vty
    vty String
    title =
        Output -> String -> IO ()
    setOutputWindowTitle (Vty -> Output
    outputIface Vty
    vty) String
    title