-- | This module provides an API for turning "markup" values into
-- widgets. This module uses the "Data.Text.Markup" interface in this
-- package to assign attributes to substrings in a text string; to
-- manipulate markup using (for example) syntax highlighters, see that
-- module.
module Brick.Markup
  ( Markup
  , markup
  , (@?)
  , GetAttr(..)
  )
where

import Lens.Micro ((.~), (&), (^.))
import Control.Monad (forM)
import qualified Data.Text as T
import Data.Text.Markup

import Graphics.Vty (Attr, vertCat, horizCat, text', defAttr)

import Brick.AttrMap
import Brick.Types

-- | A type class for types that provide access to an attribute in the
-- rendering monad.  You probably won't need to instance this.
class GetAttr a where
    -- | Where to get the attribute for this attribute metadata.
    getAttr :: a -> RenderM n Attr

instance GetAttr Attr where
    getAttr :: Attr -> RenderM n Attr
getAttr Attr
a = do
        Context
c <- RenderM n Context
forall n. RenderM n Context
getContext
        Attr -> RenderM n Attr
forall (m :: * -> *) a. Monad m => a -> m a
return (Attr -> RenderM n Attr) -> Attr -> RenderM n Attr
forall a b. (a -> b) -> a -> b
$ Attr -> AttrMap -> Attr
mergeWithDefault Attr
a (Context
cContext -> Getting AttrMap Context AttrMap -> AttrMap
forall s a. s -> Getting a s a -> a
^.Getting AttrMap Context AttrMap
Lens' Context AttrMap
ctxAttrMapL)

instance GetAttr AttrName where
    getAttr :: AttrName -> RenderM n Attr
getAttr = AttrName -> RenderM n Attr
forall n. AttrName -> RenderM n Attr
lookupAttrName

-- | Build a piece of markup from text with an assigned attribute name.
-- When the markup is rendered, the attribute name will be looked up in
-- the rendering context's 'AttrMap' to determine the attribute to use
-- for this piece of text.
(@?) :: T.Text -> AttrName -> Markup AttrName
@? :: Text -> AttrName -> Markup AttrName
(@?) = Text -> AttrName -> Markup AttrName
forall a. Text -> a -> Markup a
(@@)

-- | Build a widget from markup.
markup :: (Eq a, GetAttr a) => Markup a -> Widget n
markup :: Markup a -> Widget n
markup Markup a
m =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
      let markupLines :: [[(Text, a)]]
markupLines = Markup a -> [[(Text, a)]]
forall a. Eq a => Markup a -> [[(Text, a)]]
markupToList Markup a
m
          mkLine :: [(Text, a)] -> ReaderT Context (State (RenderState n)) Image
mkLine [(Text, a)]
pairs = do
              [Image]
is <- [(Text, a)]
-> ((Text, a) -> ReaderT Context (State (RenderState n)) Image)
-> ReaderT Context (State (RenderState n)) [Image]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Text, a)]
pairs (((Text, a) -> ReaderT Context (State (RenderState n)) Image)
 -> ReaderT Context (State (RenderState n)) [Image])
-> ((Text, a) -> ReaderT Context (State (RenderState n)) Image)
-> ReaderT Context (State (RenderState n)) [Image]
forall a b. (a -> b) -> a -> b
$ \(Text
t, a
aSrc) -> do
                  Attr
a <- a -> RenderM n Attr
forall a n. GetAttr a => a -> RenderM n Attr
getAttr a
aSrc
                  Image -> ReaderT Context (State (RenderState n)) Image
forall (m :: * -> *) a. Monad m => a -> m a
return (Image -> ReaderT Context (State (RenderState n)) Image)
-> Image -> ReaderT Context (State (RenderState n)) Image
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Image
text' Attr
a Text
t
              if [Image] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Image]
is
                 then do
                     Attr
def <- Attr -> RenderM n Attr
forall a n. GetAttr a => a -> RenderM n Attr
getAttr Attr
defAttr
                     Image -> ReaderT Context (State (RenderState n)) Image
forall (m :: * -> *) a. Monad m => a -> m a
return (Image -> ReaderT Context (State (RenderState n)) Image)
-> Image -> ReaderT Context (State (RenderState n)) Image
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Image
text' Attr
def (Text -> Image) -> Text -> Image
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
' '
                 else Image -> ReaderT Context (State (RenderState n)) Image
forall (m :: * -> *) a. Monad m => a -> m a
return (Image -> ReaderT Context (State (RenderState n)) Image)
-> Image -> ReaderT Context (State (RenderState n)) Image
forall a b. (a -> b) -> a -> b
$ [Image] -> Image
horizCat [Image]
is
      [Image]
lineImgs <- ([(Text, a)] -> ReaderT Context (State (RenderState n)) Image)
-> [[(Text, a)]] -> ReaderT Context (State (RenderState n)) [Image]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [(Text, a)] -> ReaderT Context (State (RenderState n)) Image
forall a n.
GetAttr a =>
[(Text, a)] -> ReaderT Context (State (RenderState n)) Image
mkLine [[(Text, a)]]
markupLines
      Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result n -> RenderM n (Result n))
-> Result n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Result n
forall n. Result n
emptyResult Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& (Image -> Identity Image) -> Result n -> Identity (Result n)
forall n. Lens' (Result n) Image
imageL ((Image -> Identity Image) -> Result n -> Identity (Result n))
-> Image -> Result n -> Result n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Image] -> Image
vertCat [Image]
lineImgs