    -- | The inline module provides a limited interface to changing the
    -- style of terminal output. The intention is for this interface to be
    -- used inline with other output systems.
    --
    -- The changes specified by the InlineM monad are applied to the
    -- terminal's display attributes. These display attributes affect the
    -- display of all following text output to the terminal file descriptor.
    --
    -- For example, in an IO monad the following code will print the text
    -- \"Not styled. \" Followed by the text \" Styled! \" drawn over a red
    -- background and underlined.
    --
    -- @
    --      putStr \"Not styled. \"
    --      putAttrChange_ $ do
    --          backColor red
    --          applyStyle underline
    --      putStr \" Styled! \"
    --      putAttrChange_ $ defaultAll
    --      putStrLn \"Not styled.\"
    -- @
    --
    -- 'putAttrChange' emits the control codes to the terminal device
    -- attached to 'Handle'. This is a duplicate of the 'stdout' handle when
    -- the 'terminalHandle' was (first) acquired. If 'stdout' has since been
    -- changed then 'putStr', 'putStrLn', 'print' etc. will output to a
    -- different 'Handle' than 'putAttrChange'.
    --
    -- Copyright 2009-2010 Corey O'Connor
    module Graphics.Vty.Inline
      ( module Graphics.Vty.Inline
      , withVty
      )
    where

    import Graphics.Vty
    import Graphics.Vty.DisplayAttributes
    import Graphics.Vty.Inline.Unsafe

    import Blaze.ByteString.Builder (writeToByteString)

    import Control.Monad.State.Strict

    import Data.Bits ( (.&.), complement )
    import Data.IORef

    import System.IO

    type InlineM v = State InlineState v

    data InlineState =
        InlineState { InlineState -> Attr
    inlineAttr :: Attr
                    , InlineState -> Bool
    inlineUrlsEnabled :: Bool
                    }

    -- | Set the background color to the provided 'Color'.
    backColor :: Color -> InlineM ()
    backColor :: Color -> InlineM ()
    backColor Color
    c = (InlineState -> InlineState) -> InlineM ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((InlineState -> InlineState) -> InlineM ())
    -> (InlineState -> InlineState) -> InlineM ()
    forall a b. (a -> b) -> a -> b
    $ \InlineState
    s ->
        InlineState
    s { inlineAttr :: Attr
    inlineAttr = InlineState -> Attr
    inlineAttr InlineState
    s Attr -> Color -> Attr
    `withBackColor` Color
    c
          }

    -- | Set the foreground color to the provided 'Color'.
    foreColor :: Color -> InlineM ()
    foreColor :: Color -> InlineM ()
    foreColor Color
    c = (InlineState -> InlineState) -> InlineM ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((InlineState -> InlineState) -> InlineM ())
    -> (InlineState -> InlineState) -> InlineM ()
    forall a b. (a -> b) -> a -> b
    $ \InlineState
    s ->
        InlineState
    s { inlineAttr :: Attr
    inlineAttr = InlineState -> Attr
    inlineAttr InlineState
    s Attr -> Color -> Attr
    `withForeColor` Color
    c
          }

    -- | Attempt to change the 'Style' of the following text..
    --
    -- If the terminal does not support the style change then no error is
    -- produced. The style can still be removed.
    applyStyle :: Style -> InlineM ()
    applyStyle :: Style -> InlineM ()
    applyStyle Style
    st = (InlineState -> InlineState) -> InlineM ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((InlineState -> InlineState) -> InlineM ())
    -> (InlineState -> InlineState) -> InlineM ()
    forall a b. (a -> b) -> a -> b
    $ \InlineState
    s ->
        InlineState
    s { inlineAttr :: Attr
    inlineAttr = InlineState -> Attr
    inlineAttr InlineState
    s Attr -> Style -> Attr
    `withStyle` Style
    st
          }

    -- | Attempt to remove the specified 'Style' from the display of the
    -- following text.
    --
    -- This will fail if 'applyStyle' for the given style has not been
    -- previously called.
    removeStyle :: Style -> InlineM ()
    removeStyle :: Style -> InlineM ()
    removeStyle Style
    sMask = (InlineState -> InlineState) -> InlineM ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((InlineState -> InlineState) -> InlineM ())
    -> (InlineState -> InlineState) -> InlineM ()
    forall a b. (a -> b) -> a -> b
    $ \InlineState
    s ->
        InlineState
    s { inlineAttr :: Attr
    inlineAttr =
              let style' :: Style
    style' = case Attr -> MaybeDefault Style
    attrStyle (InlineState -> Attr
    inlineAttr InlineState
    s) of
                    MaybeDefault Style
    Default -> [Char] -> Style
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."
                    MaybeDefault Style
    KeepCurrent -> [Char] -> Style
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."
                    SetTo Style
    st -> Style
    st Style -> Style -> Style
    forall a. Bits a => a -> a -> a
    .&. Style -> Style
    forall a. Bits a => a -> a
    complement Style
    sMask
              in (InlineState -> Attr
    inlineAttr InlineState
    s) { attrStyle :: MaybeDefault Style
    attrStyle = Style -> MaybeDefault Style
    forall v. v -> MaybeDefault v
    SetTo Style
    style' }
          }

    -- | Reset the display attributes.
    defaultAll :: InlineM ()
    defaultAll :: InlineM ()
    defaultAll = (InlineState -> InlineState) -> InlineM ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((InlineState -> InlineState) -> InlineM ())
    -> (InlineState -> InlineState) -> InlineM ()
    forall a b. (a -> b) -> a -> b
    $ \InlineState
    s -> InlineState
    s { inlineAttr :: Attr
    inlineAttr = Attr
    defAttr }

    -- | Apply the provided display attribute changes to the given terminal
    -- output device.
    --
    -- This does not flush the terminal.
    putAttrChange :: ( Applicative m, MonadIO m ) => Output -> InlineM () -> m ()
    putAttrChange :: forall (m :: * -> *).
    (Applicative m, MonadIO m) =>
    Output -> InlineM () -> m ()
    putAttrChange Output
    out InlineM ()
    c = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
        DisplayRegion
    bounds <- Output -> IO DisplayRegion
    displayBounds Output
    out
        DisplayContext
    dc <- Output -> DisplayRegion -> IO DisplayContext
    displayContext Output
    out DisplayRegion
    bounds
        Maybe FixedAttr
    mfattr <- AssumedState -> Maybe FixedAttr
    prevFattr (AssumedState -> Maybe FixedAttr)
    -> IO AssumedState -> IO (Maybe FixedAttr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IORef AssumedState -> IO AssumedState
    forall a. IORef a -> IO a
    readIORef (Output -> IORef AssumedState
    assumedStateRef Output
    out)
        FixedAttr
    fattr <- case Maybe FixedAttr
    mfattr of
                    Maybe FixedAttr
    Nothing -> do
                        IO () -> IO ()
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Output -> ByteString -> IO ()
    outputByteBuffer Output
    out (ByteString -> IO ()) -> ByteString -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Write -> ByteString
    writeToByteString (Write -> ByteString) -> Write -> ByteString
    forall a b. (a -> b) -> a -> b
    $ DisplayContext -> Bool -> Write
    writeDefaultAttr DisplayContext
    dc Bool
    False
                        FixedAttr -> IO FixedAttr
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FixedAttr -> IO FixedAttr) -> FixedAttr -> IO FixedAttr
    forall a b. (a -> b) -> a -> b
    $ Style -> Maybe Color -> Maybe Color -> Maybe Text -> FixedAttr
    FixedAttr Style
    defaultStyleMask Maybe Color
    forall a. Maybe a
    Nothing Maybe Color
    forall a. Maybe a
    Nothing Maybe Text
    forall a. Maybe a
    Nothing
                    Just FixedAttr
    v -> FixedAttr -> IO FixedAttr
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return FixedAttr
    v
        let InlineState Attr
    attr Bool
    urlsEnabled = InlineM () -> InlineState -> InlineState
    forall s a. State s a -> s -> s
    execState InlineM ()
    c (Attr -> Bool -> InlineState
    InlineState Attr
    currentAttr Bool
    False)
            attr' :: Attr
    attr' = Output -> Attr -> Attr
    limitAttrForDisplay Output
    out Attr
    attr
            fattr' :: FixedAttr
    fattr' = FixedAttr -> Attr -> FixedAttr
    fixDisplayAttr FixedAttr
    fattr Attr
    attr'
            diffs :: DisplayAttrDiff
    diffs = FixedAttr -> FixedAttr -> DisplayAttrDiff
    displayAttrDiffs FixedAttr
    fattr FixedAttr
    fattr'
        Output -> ByteString -> IO ()
    outputByteBuffer Output
    out (ByteString -> IO ()) -> ByteString -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Write -> ByteString
    writeToByteString (Write -> ByteString) -> Write -> ByteString
    forall a b. (a -> b) -> a -> b
    $ DisplayContext
    -> Bool -> FixedAttr -> Attr -> DisplayAttrDiff -> Write
    writeSetAttr DisplayContext
    dc Bool
    urlsEnabled FixedAttr
    fattr Attr
    attr' DisplayAttrDiff
    diffs
        IORef AssumedState -> (AssumedState -> AssumedState) -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef (Output -> IORef AssumedState
    assumedStateRef Output
    out) ((AssumedState -> AssumedState) -> IO ())
    -> (AssumedState -> AssumedState) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \AssumedState
    s -> AssumedState
    s { prevFattr :: Maybe FixedAttr
    prevFattr = FixedAttr -> Maybe FixedAttr
    forall a. a -> Maybe a
    Just FixedAttr
    fattr' }
        DisplayContext -> IO ()
    inlineHack DisplayContext
    dc

    -- | Apply the provided display attributes changes to the terminal
    -- output device.
    --
    -- This will flush the terminal output.
    putAttrChange_ :: ( Applicative m, MonadIO m ) => InlineM () -> m ()
    putAttrChange_ :: forall (m :: * -> *).
    (Applicative m, MonadIO m) =>
    InlineM () -> m ()
    putAttrChange_ InlineM ()
    c = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ (Output -> IO ()) -> IO ()
    forall b. (Output -> IO b) -> IO b
    withOutput ((Output -> IO ()) -> IO ()) -> (Output -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Output
    out -> do
        Handle -> IO ()
    hFlush Handle
    stdout
        Output -> InlineM () -> IO ()
    forall (m :: * -> *).
    (Applicative m, MonadIO m) =>
    Output -> InlineM () -> m ()
    putAttrChange Output
    out InlineM ()
    c
        Handle -> IO ()
    hFlush Handle
    stdout