    -- Copyright Corey O'Connor
    {-# LANGUAGE GADTs #-}
    -- | A picture is translated into a sequences of state changes and
    -- character spans. The attribute is applied to all following spans,
    -- including spans of the next row. The nth element of the sequence
    -- represents the nth row (from top to bottom) of the picture to render.
    --
    -- A span op sequence will be defined for all rows and columns (and no
    -- more) of the region provided with the picture to 'spansForPic'.
    module Graphics.Vty.Span
      ( SpanOp(..)
      , columnsToCharOffset
      , spanOpHasWidth

      , SpanOps
      , spanOpsAffectedColumns
      , splitOpsAt
      , dropOps

      , DisplayOps
      , displayOpsRows
      , displayOpsColumns
      , affectedRegion
      )
    where

    import Graphics.Vty.Attributes (Attr)
    import Graphics.Vty.Image
    import Graphics.Vty.Image.Internal ( clipText )

    import qualified Data.Text.Lazy as TL
    import Data.Vector (Vector)
    import qualified Data.Vector as Vector

    -- | This represents an operation on the terminal: either an attribute
    -- change or the output of a text string.
    data SpanOp =
        -- | A span of UTF-8 text occupies a specific number of screen space
        -- columns. A single UTF character does not necessarily represent 1
        -- colunm. See Codec.Binary.UTF8.Width TextSpan [Attr] [output width
        -- in columns] [number of characters] [data]
          TextSpan
          { SpanOp -> Attr
    textSpanAttr :: !Attr
          , SpanOp -> Int
    textSpanOutputWidth :: !Int
          , SpanOp -> Int
    textSpanCharWidth :: !Int
          , SpanOp -> Text
    textSpanText :: TL.Text
          }
        -- | Skips the given number of columns.
        | Skip !Int
        -- | Marks the end of a row. Specifies how many columns are
        -- remaining. These columns will not be explicitly overwritten with
        -- the span ops. The terminal is require to assure the remaining
        -- columns are clear.
        | RowEnd !Int
        deriving SpanOp -> SpanOp -> Bool
    (SpanOp -> SpanOp -> Bool)
    -> (SpanOp -> SpanOp -> Bool) -> Eq SpanOp
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: SpanOp -> SpanOp -> Bool
    == :: SpanOp -> SpanOp -> Bool
    $c/= :: SpanOp -> SpanOp -> Bool
    /= :: SpanOp -> SpanOp -> Bool
    Eq

    -- | A vector of span operations executed in succession. This represents
    -- the operations required to render a row of the terminal. The
    -- operations in one row may affect subsequent rows. For example,
    -- setting the foreground color in one row will affect all subsequent
    -- rows until the foreground color is changed.
    type SpanOps = Vector SpanOp

    dropOps :: Int -> SpanOps -> SpanOps
    dropOps :: Int -> SpanOps -> SpanOps
    dropOps Int
    w = (SpanOps, SpanOps) -> SpanOps
    forall a b. (a, b) -> b
    snd ((SpanOps, SpanOps) -> SpanOps)
    -> (SpanOps -> (SpanOps, SpanOps)) -> SpanOps -> SpanOps
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> SpanOps -> (SpanOps, SpanOps)
    splitOpsAt Int
    w

    splitOpsAt :: Int -> SpanOps -> (SpanOps, SpanOps)
    splitOpsAt :: Int -> SpanOps -> (SpanOps, SpanOps)
    splitOpsAt = Int -> SpanOps -> (SpanOps, SpanOps)
    splitOpsAt'
        where
            splitOpsAt' :: Int -> SpanOps -> (SpanOps, SpanOps)
    splitOpsAt' Int
    0 SpanOps
    ops = (SpanOps
    forall a. Vector a
    Vector.empty, SpanOps
    ops)
            splitOpsAt' Int
    remainingColumns SpanOps
    ops = case SpanOps -> SpanOp
    forall a. Vector a -> a
    Vector.head SpanOps
    ops of
                t :: SpanOp
    t@(TextSpan {}) -> if Int
    remainingColumns Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= SpanOp -> Int
    textSpanOutputWidth SpanOp
    t
                    then let (SpanOps
    pre,SpanOps
    post) = Int -> SpanOps -> (SpanOps, SpanOps)
    splitOpsAt' (Int
    remainingColumns Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - SpanOp -> Int
    textSpanOutputWidth SpanOp
    t)
                                                      (SpanOps -> SpanOps
    forall a. Vector a -> Vector a
    Vector.tail SpanOps
    ops)
                         in (SpanOp -> SpanOps -> SpanOps
    forall a. a -> Vector a -> Vector a
    Vector.cons SpanOp
    t SpanOps
    pre, SpanOps
    post)
                    else let preTxt :: Text
    preTxt = Text -> Int -> Int -> Text
    clipText (SpanOp -> Text
    textSpanText SpanOp
    t) Int
    0 Int
    remainingColumns
                             preOp :: SpanOp
    preOp = TextSpan { textSpanAttr :: Attr
    textSpanAttr = SpanOp -> Attr
    textSpanAttr SpanOp
    t
                                               , textSpanOutputWidth :: Int
    textSpanOutputWidth = Int
    remainingColumns
                                               , textSpanCharWidth :: Int
    textSpanCharWidth = Int64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64 -> Int) -> Int64 -> Int
    forall a b. (a -> b) -> a -> b
    $! Text -> Int64
    TL.length Text
    preTxt
                                               , textSpanText :: Text
    textSpanText = Text
    preTxt
                                               }
                             postWidth :: Int
    postWidth = SpanOp -> Int
    textSpanOutputWidth SpanOp
    t Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    remainingColumns
                             postTxt :: Text
    postTxt = Text -> Int -> Int -> Text
    clipText (SpanOp -> Text
    textSpanText SpanOp
    t) Int
    remainingColumns Int
    postWidth
                             postOp :: SpanOp
    postOp = TextSpan { textSpanAttr :: Attr
    textSpanAttr = SpanOp -> Attr
    textSpanAttr SpanOp
    t
                                                , textSpanOutputWidth :: Int
    textSpanOutputWidth = Int
    postWidth
                                                , textSpanCharWidth :: Int
    textSpanCharWidth = Int64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64 -> Int) -> Int64 -> Int
    forall a b. (a -> b) -> a -> b
    $! Text -> Int64
    TL.length Text
    postTxt
                                                , textSpanText :: Text
    textSpanText = Text
    postTxt
                                                }
                         in ( SpanOp -> SpanOps
    forall a. a -> Vector a
    Vector.singleton SpanOp
    preOp
                            , SpanOp -> SpanOps -> SpanOps
    forall a. a -> Vector a -> Vector a
    Vector.cons SpanOp
    postOp (SpanOps -> SpanOps
    forall a. Vector a -> Vector a
    Vector.tail SpanOps
    ops)
                            )
                Skip Int
    w -> if Int
    remainingColumns Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    w
                    then let (SpanOps
    pre,SpanOps
    post) = Int -> SpanOps -> (SpanOps, SpanOps)
    splitOpsAt' (Int
    remainingColumns Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    w) (SpanOps -> SpanOps
    forall a. Vector a -> Vector a
    Vector.tail SpanOps
    ops)
                         in (SpanOp -> SpanOps -> SpanOps
    forall a. a -> Vector a -> Vector a
    Vector.cons (Int -> SpanOp
    Skip Int
    w) SpanOps
    pre, SpanOps
    post)
                    else ( SpanOp -> SpanOps
    forall a. a -> Vector a
    Vector.singleton (SpanOp -> SpanOps) -> SpanOp -> SpanOps
    forall a b. (a -> b) -> a -> b
    $ Int -> SpanOp
    Skip Int
    remainingColumns
                         , SpanOp -> SpanOps -> SpanOps
    forall a. a -> Vector a -> Vector a
    Vector.cons (Int -> SpanOp
    Skip (Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    remainingColumns)) (SpanOps -> SpanOps
    forall a. Vector a -> Vector a
    Vector.tail SpanOps
    ops)
                         )
                RowEnd Int
    _ -> [Char] -> (SpanOps, SpanOps)
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "cannot split ops containing a row end"

    -- | A vector of span operation vectors for display, one per row of the
    -- output region.
    type DisplayOps = Vector SpanOps

    instance Show SpanOp where
        show :: SpanOp -> [Char]
    show (TextSpan Attr
    attr Int
    ow Int
    cw Text
    _) = [Char]
    "TextSpan(" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Attr -> [Char]
    forall a. Show a => a -> [Char]
    show Attr
    attr [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")(" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    ow [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ", " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    cw [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")"
        show (Skip Int
    ow) = [Char]
    "Skip(" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    ow [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")"
        show (RowEnd Int
    ow) = [Char]
    "RowEnd(" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    ow [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")"

    -- | The number of columns the DisplayOps are defined for.
    --
    -- All spans are verified to define same number of columns.
    displayOpsColumns :: DisplayOps -> Int
    displayOpsColumns :: DisplayOps -> Int
    displayOpsColumns DisplayOps
    ops
        | DisplayOps -> Int
    forall a. Vector a -> Int
    Vector.length DisplayOps
    ops Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 = Int
    0
        | Bool
    otherwise              = SpanOps -> Int
    forall a. Vector a -> Int
    Vector.length (SpanOps -> Int) -> SpanOps -> Int
    forall a b. (a -> b) -> a -> b
    $ DisplayOps -> SpanOps
    forall a. Vector a -> a
    Vector.head DisplayOps
    ops

    -- | The number of rows the DisplayOps are defined for.
    displayOpsRows :: DisplayOps -> Int
    displayOpsRows :: DisplayOps -> Int
    displayOpsRows = DisplayOps -> Int
    forall a. Vector a -> Int
    Vector.length

    affectedRegion :: DisplayOps -> DisplayRegion
    affectedRegion :: DisplayOps -> DisplayRegion
    affectedRegion DisplayOps
    ops = (DisplayOps -> Int
    displayOpsColumns DisplayOps
    ops, DisplayOps -> Int
    displayOpsRows DisplayOps
    ops)

    -- | The number of columns a SpanOps affects.
    spanOpsAffectedColumns :: SpanOps -> Int
    spanOpsAffectedColumns :: SpanOps -> Int
    spanOpsAffectedColumns SpanOps
    inOps = (Int -> SpanOp -> Int) -> Int -> SpanOps -> Int
    forall a b. (a -> b -> a) -> a -> Vector b -> a
    Vector.foldl' Int -> SpanOp -> Int
    spanOpsAffectedColumns' Int
    0 SpanOps
    inOps
        where
            spanOpsAffectedColumns' :: Int -> SpanOp -> Int
    spanOpsAffectedColumns' Int
    t (TextSpan Attr
    _ Int
    w Int
    _ Text
    _ ) = Int
    t Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    w
            spanOpsAffectedColumns' Int
    t (Skip Int
    w) = Int
    t Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    w
            spanOpsAffectedColumns' Int
    t (RowEnd Int
    w) = Int
    t Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    w

    -- | The width of a single SpanOp in columns.
    spanOpHasWidth :: SpanOp -> Maybe (Int, Int)
    spanOpHasWidth :: SpanOp -> Maybe DisplayRegion
    spanOpHasWidth (TextSpan Attr
    _ Int
    ow Int
    cw Text
    _) = DisplayRegion -> Maybe DisplayRegion
    forall a. a -> Maybe a
    Just (Int
    cw, Int
    ow)
    spanOpHasWidth (Skip Int
    ow) = DisplayRegion -> Maybe DisplayRegion
    forall a. a -> Maybe a
    Just (Int
    ow,Int
    ow)
    spanOpHasWidth (RowEnd Int
    ow) = DisplayRegion -> Maybe DisplayRegion
    forall a. a -> Maybe a
    Just (Int
    ow,Int
    ow)

    -- | The number of columns to the character at the given position in the
    -- span op.
    columnsToCharOffset :: Int -> SpanOp -> Int
    columnsToCharOffset :: Int -> SpanOp -> Int
    columnsToCharOffset Int
    cx (TextSpan Attr
    _ Int
    _ Int
    _ Text
    utf8Str) =
        Text -> Int
    wctlwidth (Int64 -> Text -> Text
    TL.take (Int -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    cx) Text
    utf8Str)
    columnsToCharOffset Int
    cx (Skip Int
    _) = Int
    cx
    columnsToCharOffset Int
    cx (RowEnd Int
    _) = Int
    cx