-- | Utilities for printing ANSI formatted text.
module Vgrep.Ansi (
  -- * ANSI formatted text
    AnsiFormatted
  , Formatted ()
  -- ** Smart constructors
  , emptyFormatted
  , bare
  , format
  , cat
  -- ** Modifying text nodes
  , mapText
  , mapTextWithPos
  , takeFormatted
  , dropFormatted
  , padFormatted

  -- * Converting ANSI formatted text
  , renderAnsi
  , stripAnsi
  ) where

import           Data.Text    (Text)
import qualified Graphics.Vty as Vty

import Vgrep.Ansi.Type
import Vgrep.Ansi.Vty.Attributes


-- | Converts ANSI formatted text to an 'Vty.Image'. Nested formattings are
-- combined with 'combineStyles'. The given 'Vty.Attr' is used as style for the
-- root of the 'Formatted' tree.
--
-- >>> import Graphics.Vty.Image.Internal (Image (HorizText, attr))
-- >>> let HorizText { attr = attr } = renderAnsi Vty.defAttr (bare "Text")
-- >>> attr
-- Attr {attrStyle = Default, attrForeColor = Default, attrBackColor = Default, attrURL = Default}
--
renderAnsi :: Attr -> AnsiFormatted -> Vty.Image
renderAnsi :: Attr -> AnsiFormatted -> Image
renderAnsi Attr
attr = \case
    AnsiFormatted
Empty            -> Image
Vty.emptyImage
    Text Int
_ Text
t         -> Attr -> Text -> Image
Vty.text' Attr
attr Text
t
    Format Int
_ Attr
attr' AnsiFormatted
t -> Attr -> AnsiFormatted -> Image
renderAnsi (Attr -> Attr -> Attr
combineStyles Attr
attr Attr
attr') AnsiFormatted
t
    Cat Int
_ [AnsiFormatted]
ts         -> [Image] -> Image
Vty.horizCat ((AnsiFormatted -> Image) -> [AnsiFormatted] -> [Image]
forall a b. (a -> b) -> [a] -> [b]
map (Attr -> AnsiFormatted -> Image
renderAnsi Attr
attr) [AnsiFormatted]
ts)

-- | Strips away all formattings to plain 'Text'.
stripAnsi :: Formatted a -> Text
stripAnsi :: Formatted a -> Text
stripAnsi = \case
    Formatted a
Empty        -> Text
forall a. Monoid a => a
mempty
    Text Int
_ Text
t     -> Text
t
    Format Int
_ a
_ Formatted a
t -> Formatted a -> Text
forall a. Formatted a -> Text
stripAnsi Formatted a
t
    Cat Int
_ [Formatted a]
ts     -> (Formatted a -> Text) -> [Formatted a] -> Text
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Formatted a -> Text
forall a. Formatted a -> Text
stripAnsi [Formatted a]
ts