{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ParallelListComp #-}
module Matterhorn.Draw.RichText
  ( renderRichText
  , renderText
  , renderText'
  , cursorSentinel
  , findVerbatimChunk
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick ( (<+>), Widget, hLimit, imageL
                       , render, Size(..), Widget(..)
                       )
import qualified Brick as B
import qualified Brick.Widgets.Border as B
import qualified Brick.Widgets.Table as B
import qualified Brick.Widgets.Skylighting as BS
import           Control.Monad.Reader
import qualified Data.Foldable as F
import qualified Data.Sequence as S
import           Data.Sequence ( ViewL(..)
                               , (<|)
                               , viewl
                               )
import qualified Data.Text as T
import qualified Graphics.Vty as V
import qualified Skylighting.Core as Sky

import           Matterhorn.Constants ( normalChannelSigil, userSigil, editMarking )
import           Matterhorn.Draw.RichText.Flatten
import           Matterhorn.Draw.RichText.Wrap
import           Matterhorn.Themes
import           Matterhorn.Types ( HighlightSet(..), emptyHSet, SemEq(..) )
import           Matterhorn.Types.RichText


-- Render markdown with username highlighting
renderRichText :: SemEq a
               => Text
               -- ^ The username of the currently-authenticated user.
               -> HighlightSet
               -- ^ A highlight set for highlighting channel and
               -- usernames.
               -> Maybe Int
               -- ^ An optional maximum width.
               -> Bool
               -- ^ Whether to do line wrapping.
               -> Maybe (Int -> Inline -> Maybe a)
               -- ^ An optional function to build resource names for
               -- clickable regions.
               -> Blocks
               -- ^ The content to render.
               -> Widget a
renderRichText :: Text
-> HighlightSet
-> Maybe Int
-> Bool
-> Maybe (Int -> Inline -> Maybe a)
-> Blocks
-> Widget a
renderRichText Text
curUser HighlightSet
hSet Maybe Int
w Bool
doWrap Maybe (Int -> Inline -> Maybe a)
nameGen (Blocks Seq Block
bs) =
    Reader (DrawCfg a) (Widget a) -> DrawCfg a -> Widget a
forall r a. Reader r a -> r -> a
runReader (do
              Seq (Widget a)
blocks <- (Block -> Reader (DrawCfg a) (Widget a))
-> Seq Block -> ReaderT (DrawCfg a) Identity (Seq (Widget a))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Block -> Reader (DrawCfg a) (Widget a)
forall a. SemEq a => Block -> M (Widget a) a
renderBlock (Seq Block -> Seq Block
addBlankLines Seq Block
bs)
              Widget a -> Reader (DrawCfg a) (Widget a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget a -> Reader (DrawCfg a) (Widget a))
-> Widget a -> Reader (DrawCfg a) (Widget a)
forall a b. (a -> b) -> a -> b
$ [Widget a] -> Widget a
forall n. [Widget n] -> Widget n
B.vBox ([Widget a] -> Widget a) -> [Widget a] -> Widget a
forall a b. (a -> b) -> a -> b
$ Seq (Widget a) -> [Widget a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Widget a)
blocks)
              (DrawCfg :: forall a.
Text
-> HighlightSet
-> Maybe Int
-> Bool
-> Maybe (Int -> Inline -> Maybe a)
-> DrawCfg a
DrawCfg { drawCurUser :: Text
drawCurUser = Text
curUser
                       , drawHighlightSet :: HighlightSet
drawHighlightSet = HighlightSet
hSet
                       , drawLineWidth :: Maybe Int
drawLineWidth = Maybe Int
w
                       , drawDoLineWrapping :: Bool
drawDoLineWrapping = Bool
doWrap
                       , drawNameGen :: Maybe (Int -> Inline -> Maybe a)
drawNameGen = Maybe (Int -> Inline -> Maybe a)
nameGen
                       })

-- Render text to markdown without username highlighting, permalink
-- detection, or clickable links
renderText :: SemEq a => Text -> Widget a
renderText :: Text -> Widget a
renderText Text
txt = Maybe TeamBaseURL
-> Text
-> HighlightSet
-> Maybe (Int -> Inline -> Maybe a)
-> Text
-> Widget a
forall a.
SemEq a =>
Maybe TeamBaseURL
-> Text
-> HighlightSet
-> Maybe (Int -> Inline -> Maybe a)
-> Text
-> Widget a
renderText' Maybe TeamBaseURL
forall a. Maybe a
Nothing Text
"" HighlightSet
emptyHSet Maybe (Int -> Inline -> Maybe a)
forall a. Maybe a
Nothing Text
txt

renderText' :: SemEq a
            => Maybe TeamBaseURL
            -- ^ An optional base URL against which to match post links.
            -> Text
            -- ^ The username of the currently-authenticated user.
            -> HighlightSet
            -- ^ A highlight set for highlighting channel and usernames.
            -> Maybe (Int -> Inline -> Maybe a)
            -- ^ An optional function to build resource names for
            -- clickable regions.
            -> Text
            -- ^ The text to parse and then render as rich text.
            -> Widget a
renderText' :: Maybe TeamBaseURL
-> Text
-> HighlightSet
-> Maybe (Int -> Inline -> Maybe a)
-> Text
-> Widget a
renderText' Maybe TeamBaseURL
baseUrl Text
curUser HighlightSet
hSet Maybe (Int -> Inline -> Maybe a)
nameGen Text
t =
    Text
-> HighlightSet
-> Maybe Int
-> Bool
-> Maybe (Int -> Inline -> Maybe a)
-> Blocks
-> Widget a
forall a.
SemEq a =>
Text
-> HighlightSet
-> Maybe Int
-> Bool
-> Maybe (Int -> Inline -> Maybe a)
-> Blocks
-> Widget a
renderRichText Text
curUser HighlightSet
hSet Maybe Int
forall a. Maybe a
Nothing Bool
True Maybe (Int -> Inline -> Maybe a)
nameGen (Blocks -> Widget a) -> Blocks -> Widget a
forall a b. (a -> b) -> a -> b
$
        Maybe TeamBaseURL -> Text -> Blocks
parseMarkdown Maybe TeamBaseURL
baseUrl Text
t

-- Add blank lines only between adjacent elements of the same type, to
-- save space
addBlankLines :: Seq Block -> Seq Block
addBlankLines :: Seq Block -> Seq Block
addBlankLines = ViewL Block -> Seq Block
go' (ViewL Block -> Seq Block)
-> (Seq Block -> ViewL Block) -> Seq Block -> Seq Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Block -> ViewL Block
forall a. Seq a -> ViewL a
viewl
  where go' :: ViewL Block -> Seq Block
go' ViewL Block
EmptyL = Seq Block
forall a. Seq a
S.empty
        go' (Block
x :< Seq Block
xs) = Block -> ViewL Block -> Seq Block
go Block
x (Seq Block -> ViewL Block
forall a. Seq a -> ViewL a
viewl Seq Block
xs)
        go :: Block -> ViewL Block -> Seq Block
go Block
a (Block
b :< Seq Block
rs)
            | Block -> Block -> Bool
sameBlockType Block
a Block
b = Block
a Block -> Seq Block -> Seq Block
forall a. a -> Seq a -> Seq a
<| Block
blank Block -> Seq Block -> Seq Block
forall a. a -> Seq a -> Seq a
<| Block -> ViewL Block -> Seq Block
go Block
b (Seq Block -> ViewL Block
forall a. Seq a -> ViewL a
viewl Seq Block
rs)
            | Bool
otherwise         = Block
a Block -> Seq Block -> Seq Block
forall a. a -> Seq a -> Seq a
<| Block -> ViewL Block -> Seq Block
go Block
b (Seq Block -> ViewL Block
forall a. Seq a -> ViewL a
viewl Seq Block
rs)
        go Block
x ViewL Block
EmptyL = Block -> Seq Block
forall a. a -> Seq a
S.singleton Block
x
        blank :: Block
blank = Inlines -> Block
Para (Seq Inline -> Inlines
Inlines (Seq Inline -> Inlines) -> Seq Inline -> Inlines
forall a b. (a -> b) -> a -> b
$ Inline -> Seq Inline
forall a. a -> Seq a
S.singleton Inline
ESpace)

vBox :: F.Foldable f => f (Widget a) -> Widget a
vBox :: f (Widget a) -> Widget a
vBox = [Widget a] -> Widget a
forall n. [Widget n] -> Widget n
B.vBox ([Widget a] -> Widget a)
-> (f (Widget a) -> [Widget a]) -> f (Widget a) -> Widget a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Widget a) -> [Widget a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

hBox :: F.Foldable f => f (Widget a) -> Widget a
hBox :: f (Widget a) -> Widget a
hBox = [Widget a] -> Widget a
forall n. [Widget n] -> Widget n
B.hBox ([Widget a] -> Widget a)
-> (f (Widget a) -> [Widget a]) -> f (Widget a) -> Widget a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Widget a) -> [Widget a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

header :: Int -> Widget a
header :: Int -> Widget a
header Int
n = Text -> Widget a
forall n. Text -> Widget n
B.txt (Int -> Text -> Text
T.replicate Int
n Text
"#")

maybeHLimit :: Maybe Int -> Widget a -> Widget a
maybeHLimit :: Maybe Int -> Widget a -> Widget a
maybeHLimit Maybe Int
Nothing Widget a
w = Widget a
w
maybeHLimit (Just Int
i) Widget a
w = Int -> Widget a -> Widget a
forall n. Int -> Widget n -> Widget n
hLimit Int
i Widget a
w

type M a b = Reader (DrawCfg b) a

data DrawCfg a =
    DrawCfg { DrawCfg a -> Text
drawCurUser :: Text
            , DrawCfg a -> HighlightSet
drawHighlightSet :: HighlightSet
            , DrawCfg a -> Maybe Int
drawLineWidth :: Maybe Int
            , DrawCfg a -> Bool
drawDoLineWrapping :: Bool
            , DrawCfg a -> Maybe (Int -> Inline -> Maybe a)
drawNameGen :: Maybe (Int -> Inline -> Maybe a)
            }

renderBlock :: SemEq a => Block -> M (Widget a) a
renderBlock :: Block -> M (Widget a) a
renderBlock (Table [ColAlignment]
aligns [Inlines]
headings [[Inlines]]
body) = do
    [Widget a]
headingWs <- (Inlines -> M (Widget a) a)
-> [Inlines] -> ReaderT (DrawCfg a) Identity [Widget a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Inlines -> M (Widget a) a
forall a. SemEq a => Inlines -> M (Widget a) a
renderInlines [Inlines]
headings
    [[Widget a]]
bodyWs <- [[Inlines]]
-> ([Inlines] -> ReaderT (DrawCfg a) Identity [Widget a])
-> ReaderT (DrawCfg a) Identity [[Widget a]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [[Inlines]]
body (([Inlines] -> ReaderT (DrawCfg a) Identity [Widget a])
 -> ReaderT (DrawCfg a) Identity [[Widget a]])
-> ([Inlines] -> ReaderT (DrawCfg a) Identity [Widget a])
-> ReaderT (DrawCfg a) Identity [[Widget a]]
forall a b. (a -> b) -> a -> b
$ (Inlines -> M (Widget a) a)
-> [Inlines] -> ReaderT (DrawCfg a) Identity [Widget a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Inlines -> M (Widget a) a
forall a. SemEq a => Inlines -> M (Widget a) a
renderInlines
    let t :: Table a
t = [[Widget a]] -> Table a
forall n. [[Widget n]] -> Table n
B.table ([Widget a]
headingWs [Widget a] -> [[Widget a]] -> [[Widget a]]
forall a. a -> [a] -> [a]
: [[Widget a]]
bodyWs)
        alignPairs :: [(Int, ColAlignment)]
alignPairs = [Int] -> [ColAlignment] -> [(Int, ColAlignment)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [ColAlignment]
aligns
        align :: (Int, ColAlignment) -> Table n -> Table n
align (Int
_, ColAlignment
LeftAlignedCol) = Table n -> Table n
forall a. a -> a
id
        align (Int
_, ColAlignment
DefaultAlignedCol) = Table n -> Table n
forall a. a -> a
id
        align (Int
i, ColAlignment
RightAlignedCol) = Int -> Table n -> Table n
forall n. Int -> Table n -> Table n
B.alignRight Int
i
        align (Int
i, ColAlignment
CenterAlignedCol) = Int -> Table n -> Table n
forall n. Int -> Table n -> Table n
B.alignCenter Int
i
        applyAlignment :: Table n -> Table n
applyAlignment = ((Table n -> Table n)
 -> (Table n -> Table n) -> Table n -> Table n)
-> (Table n -> Table n)
-> [Table n -> Table n]
-> Table n
-> Table n
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Table n -> Table n) -> (Table n -> Table n) -> Table n -> Table n
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Table n -> Table n
forall a. a -> a
id ((Int, ColAlignment) -> Table n -> Table n
forall n. (Int, ColAlignment) -> Table n -> Table n
align ((Int, ColAlignment) -> Table n -> Table n)
-> [(Int, ColAlignment)] -> [Table n -> Table n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, ColAlignment)]
alignPairs)
    Widget a -> M (Widget a) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget a -> M (Widget a) a) -> Widget a -> M (Widget a) a
forall a b. (a -> b) -> a -> b
$ Table a -> Widget a
forall n. Table n -> Widget n
B.renderTable (Table a -> Widget a) -> Table a -> Widget a
forall a b. (a -> b) -> a -> b
$ Table a -> Table a
forall n. Table n -> Table n
applyAlignment Table a
t
renderBlock (Para Inlines
is) =
    Inlines -> M (Widget a) a
forall a. SemEq a => Inlines -> M (Widget a) a
renderInlines Inlines
is
renderBlock (Header Int
n Inlines
is) = do
    Widget a
headerTxt <- (DrawCfg a -> DrawCfg a) -> M (Widget a) a -> M (Widget a) a
forall r' r a. (r' -> r) -> Reader r a -> Reader r' a
withReader (\DrawCfg a
c -> DrawCfg a
c { drawLineWidth :: Maybe Int
drawLineWidth = Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1 (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DrawCfg a -> Maybe Int
forall a. DrawCfg a -> Maybe Int
drawLineWidth DrawCfg a
c }) (M (Widget a) a -> M (Widget a) a)
-> M (Widget a) a -> M (Widget a) a
forall a b. (a -> b) -> a -> b
$
                 Inlines -> M (Widget a) a
forall a. SemEq a => Inlines -> M (Widget a) a
renderInlines Inlines
is
    Widget a -> M (Widget a) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget a -> M (Widget a) a) -> Widget a -> M (Widget a) a
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget a -> Widget a
forall n. AttrName -> Widget n -> Widget n
B.withDefAttr AttrName
clientHeaderAttr (Widget a -> Widget a) -> Widget a -> Widget a
forall a b. (a -> b) -> a -> b
$
        [Widget a] -> Widget a
forall (f :: * -> *) a. Foldable f => f (Widget a) -> Widget a
hBox [ Padding -> Widget a -> Widget a
forall n. Padding -> Widget n -> Widget n
B.padRight (Int -> Padding
B.Pad Int
1) (Widget a -> Widget a) -> Widget a -> Widget a
forall a b. (a -> b) -> a -> b
$ Int -> Widget a
forall a. Int -> Widget a
header Int
n
             , Widget a
headerTxt
             ]
renderBlock (Blockquote Blocks
bs) = do
    Maybe Int
w <- (DrawCfg a -> Maybe Int)
-> ReaderT (DrawCfg a) Identity (Maybe Int)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DrawCfg a -> Maybe Int
forall a. DrawCfg a -> Maybe Int
drawLineWidth
    Seq (Widget a)
bws <- (Block -> M (Widget a) a)
-> Seq Block -> ReaderT (DrawCfg a) Identity (Seq (Widget a))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Block -> M (Widget a) a
forall a. SemEq a => Block -> M (Widget a) a
renderBlock (Blocks -> Seq Block
unBlocks Blocks
bs)
    Widget a -> M (Widget a) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget a -> M (Widget a) a) -> Widget a -> M (Widget a) a
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Widget a -> Widget a
forall a. Maybe Int -> Widget a -> Widget a
maybeHLimit Maybe Int
w (Widget a -> Widget a) -> Widget a -> Widget a
forall a b. (a -> b) -> a -> b
$ Widget a -> Widget a
forall n. Widget n -> Widget n
addQuoting (Widget a -> Widget a) -> Widget a -> Widget a
forall a b. (a -> b) -> a -> b
$ Seq (Widget a) -> Widget a
forall (f :: * -> *) a. Foldable f => f (Widget a) -> Widget a
vBox Seq (Widget a)
bws
renderBlock (List ListType
ty ListSpacing
spacing Seq Blocks
bs) = do
    Maybe Int
w <- (DrawCfg a -> Maybe Int)
-> ReaderT (DrawCfg a) Identity (Maybe Int)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DrawCfg a -> Maybe Int
forall a. DrawCfg a -> Maybe Int
drawLineWidth
    Widget a
lst <- ListType -> ListSpacing -> Seq Blocks -> M (Widget a) a
forall a.
SemEq a =>
ListType -> ListSpacing -> Seq Blocks -> M (Widget a) a
renderList ListType
ty ListSpacing
spacing Seq Blocks
bs
    Widget a -> M (Widget a) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget a -> M (Widget a) a) -> Widget a -> M (Widget a) a
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Widget a -> Widget a
forall a. Maybe Int -> Widget a -> Widget a
maybeHLimit Maybe Int
w Widget a
lst
renderBlock (CodeBlock CodeBlockInfo
ci Text
tx) = do
    HighlightSet
hSet <- (DrawCfg a -> HighlightSet)
-> ReaderT (DrawCfg a) Identity HighlightSet
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DrawCfg a -> HighlightSet
forall a. DrawCfg a -> HighlightSet
drawHighlightSet

    let f :: Text -> M (Widget a) b
f = (Text -> M (Widget a) b)
-> (Syntax -> Text -> M (Widget a) b)
-> Maybe Syntax
-> Text
-> M (Widget a) b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> M (Widget a) b
forall a b. Text -> M (Widget a) b
renderRawCodeBlock
                  (SyntaxMap -> Syntax -> Text -> M (Widget a) b
forall a b. SyntaxMap -> Syntax -> Text -> M (Widget a) b
renderCodeBlock (HighlightSet -> SyntaxMap
hSyntaxMap HighlightSet
hSet))
                  Maybe Syntax
mSyntax
        mSyntax :: Maybe Syntax
mSyntax = do
            Text
lang <- CodeBlockInfo -> Maybe Text
codeBlockLanguage CodeBlockInfo
ci
            Text -> SyntaxMap -> Maybe Syntax
Sky.lookupSyntax Text
lang (HighlightSet -> SyntaxMap
hSyntaxMap HighlightSet
hSet)
    Text -> M (Widget a) a
forall a b. Text -> M (Widget a) b
f Text
tx
renderBlock (HTMLBlock Text
t) = do
    Maybe Int
w <- (DrawCfg a -> Maybe Int)
-> ReaderT (DrawCfg a) Identity (Maybe Int)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DrawCfg a -> Maybe Int
forall a. DrawCfg a -> Maybe Int
drawLineWidth
    Widget a -> M (Widget a) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget a -> M (Widget a) a) -> Widget a -> M (Widget a) a
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Widget a -> Widget a
forall a. Maybe Int -> Widget a -> Widget a
maybeHLimit Maybe Int
w (Widget a -> Widget a) -> Widget a -> Widget a
forall a b. (a -> b) -> a -> b
$ Text -> Widget a
forall n. Text -> Widget n
textWithCursor Text
t
renderBlock (Block
HRule) = do
    Maybe Int
w <- (DrawCfg a -> Maybe Int)
-> ReaderT (DrawCfg a) Identity (Maybe Int)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DrawCfg a -> Maybe Int
forall a. DrawCfg a -> Maybe Int
drawLineWidth
    Widget a -> M (Widget a) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget a -> M (Widget a) a) -> Widget a -> M (Widget a) a
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Widget a -> Widget a
forall a. Maybe Int -> Widget a -> Widget a
maybeHLimit Maybe Int
w (Widget a -> Widget a) -> Widget a -> Widget a
forall a b. (a -> b) -> a -> b
$ Int -> Widget a -> Widget a
forall n. Int -> Widget n -> Widget n
B.vLimit Int
1 (Char -> Widget a
forall n. Char -> Widget n
B.fill Char
'*')

quoteChar :: Char
quoteChar :: Char
quoteChar = Char
'>'

addQuoting :: B.Widget n -> B.Widget n
addQuoting :: Widget n -> Widget n
addQuoting Widget n
w =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
B.Widget Size
B.Fixed (Widget n -> Size
forall n. Widget n -> Size
B.vSize Widget n
w) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
        Context
ctx <- RenderM n Context
forall n. RenderM n Context
B.getContext
        Result n
childResult <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
B.render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
B.hLimit (Context
ctxContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
B.availWidthL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Widget n
w

        let quoteBorder :: Widget n
quoteBorder = Image -> Widget n
forall n. Image -> Widget n
B.raw (Image -> Widget n) -> Image -> Widget n
forall a b. (a -> b) -> a -> b
$ Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
V.charFill (Context
ctxContext -> Getting Attr Context Attr -> Attr
forall s a. s -> Getting a s a -> a
^.Getting Attr Context Attr
forall r. Getting r Context Attr
B.attrL) Char
quoteChar Int
1 Int
height
            height :: Int
height = Image -> Int
V.imageHeight (Image -> Int) -> Image -> Int
forall a b. (a -> b) -> a -> b
$ Result n
childResultResult n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n. Lens' (Result n) Image
B.imageL

        Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
B.render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
B.hBox [ Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
B.padRight (Int -> Padding
B.Pad Int
1) Widget n
forall n. Widget n
quoteBorder
                          , Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
B.Widget Size
B.Fixed Size
B.Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
childResult
                          ]

renderCodeBlock :: Sky.SyntaxMap -> Sky.Syntax -> Text -> M (Widget a) b
renderCodeBlock :: SyntaxMap -> Syntax -> Text -> M (Widget a) b
renderCodeBlock SyntaxMap
syntaxMap Syntax
syntax Text
tx = do
    let result :: Either String [SourceLine]
result = TokenizerConfig -> Syntax -> Text -> Either String [SourceLine]
Sky.tokenize TokenizerConfig
cfg Syntax
syntax Text
tx
        cfg :: TokenizerConfig
cfg = SyntaxMap -> Bool -> TokenizerConfig
Sky.TokenizerConfig SyntaxMap
syntaxMap Bool
False
    case Either String [SourceLine]
result of
        Left String
_ -> Text -> M (Widget a) b
forall a b. Text -> M (Widget a) b
renderRawCodeBlock Text
tx
        Right [SourceLine]
tokLines -> do
            let padding :: Widget n
padding = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
B.padLeftRight Int
1 (Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
B.vLimit ([SourceLine] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SourceLine]
tokLines) Widget n
forall n. Widget n
B.vBorder)
            Widget a -> M (Widget a) b
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget a -> M (Widget a) b) -> Widget a -> M (Widget a) b
forall a b. (a -> b) -> a -> b
$ (Text -> Widget a
forall n. Text -> Widget n
B.txt (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$ Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Syntax -> Text
Sky.sName Syntax
syntax Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]") Widget a -> Widget a -> Widget a
forall n. Widget n -> Widget n -> Widget n
B.<=>
                     (Widget a
forall n. Widget n
padding Widget a -> Widget a -> Widget a
forall n. Widget n -> Widget n -> Widget n
<+> (Text -> Widget a) -> [SourceLine] -> Widget a
forall n. (Text -> Widget n) -> [SourceLine] -> Widget n
BS.renderRawSource Text -> Widget a
forall n. Text -> Widget n
textWithCursor [SourceLine]
tokLines)

renderRawCodeBlock :: Text -> M (Widget a) b
renderRawCodeBlock :: Text -> M (Widget a) b
renderRawCodeBlock Text
tx = do
    Bool
doWrap <- (DrawCfg b -> Bool) -> ReaderT (DrawCfg b) Identity Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DrawCfg b -> Bool
forall a. DrawCfg a -> Bool
drawDoLineWrapping

    let hPolicy :: Size
hPolicy = if Bool
doWrap then Size
Greedy else Size
Fixed
    Widget a -> M (Widget a) b
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget a -> M (Widget a) b) -> Widget a -> M (Widget a) b
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget a -> Widget a
forall n. AttrName -> Widget n -> Widget n
B.withDefAttr AttrName
codeAttr (Widget a -> Widget a) -> Widget a -> Widget a
forall a b. (a -> b) -> a -> b
$
        Size -> Size -> RenderM a (Result a) -> Widget a
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
hPolicy Size
Fixed (RenderM a (Result a) -> Widget a)
-> RenderM a (Result a) -> Widget a
forall a b. (a -> b) -> a -> b
$ do
            Context
c <- RenderM a Context
forall n. RenderM n Context
B.getContext
            let theLines :: [Text]
theLines = Text -> Text
forall p. (Eq p, IsString p) => p -> p
expandEmpty (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
T.lines Text
tx
                expandEmpty :: p -> p
expandEmpty p
"" = p
" "
                expandEmpty p
s  = p
s
                wrapFunc :: Text -> Widget a
wrapFunc = if Bool
doWrap then Text -> Widget a
forall n. Text -> Widget n
wrappedTextWithCursor
                                     else Text -> Widget a
forall n. Text -> Widget n
textWithCursor
            Result a
renderedText <- Widget a -> RenderM a (Result a)
forall n. Widget n -> RenderM n (Result n)
render (Int -> Widget a -> Widget a
forall n. Int -> Widget n -> Widget n
B.hLimit (Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
B.availWidthL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) (Widget a -> Widget a) -> Widget a -> Widget a
forall a b. (a -> b) -> a -> b
$ [Widget a] -> Widget a
forall n. [Widget n] -> Widget n
B.vBox ([Widget a] -> Widget a) -> [Widget a] -> Widget a
forall a b. (a -> b) -> a -> b
$
                                    Text -> Widget a
forall n. Text -> Widget n
wrapFunc (Text -> Widget a) -> [Text] -> [Widget a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
theLines)

            let textHeight :: Int
textHeight = Image -> Int
V.imageHeight (Image -> Int) -> Image -> Int
forall a b. (a -> b) -> a -> b
$ Result a
renderedTextResult a -> Getting Image (Result a) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result a) Image
forall n. Lens' (Result n) Image
imageL
                padding :: Widget n
padding = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
B.padLeftRight Int
1 (Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
B.vLimit Int
textHeight Widget n
forall n. Widget n
B.vBorder)

            Widget a -> RenderM a (Result a)
forall n. Widget n -> RenderM n (Result n)
render (Widget a -> RenderM a (Result a))
-> Widget a -> RenderM a (Result a)
forall a b. (a -> b) -> a -> b
$ Widget a
forall n. Widget n
padding Widget a -> Widget a -> Widget a
forall n. Widget n -> Widget n -> Widget n
<+> (Size -> Size -> RenderM a (Result a) -> Widget a
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM a (Result a) -> Widget a)
-> RenderM a (Result a) -> Widget a
forall a b. (a -> b) -> a -> b
$ Result a -> RenderM a (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return Result a
renderedText)

renderInlines :: SemEq a => Inlines -> M (Widget a) a
renderInlines :: Inlines -> M (Widget a) a
renderInlines Inlines
es = do
    Maybe Int
w <- (DrawCfg a -> Maybe Int)
-> ReaderT (DrawCfg a) Identity (Maybe Int)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DrawCfg a -> Maybe Int
forall a. DrawCfg a -> Maybe Int
drawLineWidth
    HighlightSet
hSet <- (DrawCfg a -> HighlightSet)
-> ReaderT (DrawCfg a) Identity HighlightSet
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DrawCfg a -> HighlightSet
forall a. DrawCfg a -> HighlightSet
drawHighlightSet
    Text
curUser <- (DrawCfg a -> Text) -> ReaderT (DrawCfg a) Identity Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DrawCfg a -> Text
forall a. DrawCfg a -> Text
drawCurUser
    Maybe (Int -> Inline -> Maybe a)
nameGen <- (DrawCfg a -> Maybe (Int -> Inline -> Maybe a))
-> ReaderT (DrawCfg a) Identity (Maybe (Int -> Inline -> Maybe a))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DrawCfg a -> Maybe (Int -> Inline -> Maybe a)
forall a. DrawCfg a -> Maybe (Int -> Inline -> Maybe a)
drawNameGen

    Widget a -> M (Widget a) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget a -> M (Widget a) a) -> Widget a -> M (Widget a) a
forall a b. (a -> b) -> a -> b
$ Size -> Size -> RenderM a (Result a) -> Widget a
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
B.Widget Size
B.Fixed Size
B.Fixed (RenderM a (Result a) -> Widget a)
-> RenderM a (Result a) -> Widget a
forall a b. (a -> b) -> a -> b
$ do
        Context
ctx <- RenderM a Context
forall n. RenderM n Context
B.getContext
        let width :: Int
width = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (Context
ctxContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
B.availWidthL) Maybe Int
w
            ws :: Seq (Widget a)
ws    = (WrappedLine a -> Widget a)
-> Seq (WrappedLine a) -> Seq (Widget a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> WrappedLine a -> Widget a
forall a. Show a => Text -> WrappedLine a -> Widget a
renderWrappedLine Text
curUser) (Seq (WrappedLine a) -> Seq (Widget a))
-> Seq (WrappedLine a) -> Seq (Widget a)
forall a b. (a -> b) -> a -> b
$
                    [Seq (WrappedLine a)] -> Seq (WrappedLine a)
forall a. Monoid a => [a] -> a
mconcat ([Seq (WrappedLine a)] -> Seq (WrappedLine a))
-> [Seq (WrappedLine a)] -> Seq (WrappedLine a)
forall a b. (a -> b) -> a -> b
$
                    (Int -> WrappedLine a -> Seq (WrappedLine a)
forall a.
Int -> Seq (FlattenedValue a) -> Seq (Seq (FlattenedValue a))
doLineWrapping Int
width (WrappedLine a -> Seq (WrappedLine a))
-> [WrappedLine a] -> [Seq (WrappedLine a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Seq (WrappedLine a) -> [WrappedLine a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq (WrappedLine a) -> [WrappedLine a])
-> Seq (WrappedLine a) -> [WrappedLine a]
forall a b. (a -> b) -> a -> b
$ HighlightSet
-> Maybe (Int -> Inline -> Maybe a)
-> Inlines
-> Seq (WrappedLine a)
forall a.
SemEq a =>
HighlightSet
-> Maybe (Int -> Inline -> Maybe a)
-> Inlines
-> Seq (Seq (FlattenedValue a))
flattenInlineSeq HighlightSet
hSet Maybe (Int -> Inline -> Maybe a)
nameGen Inlines
es))
        Widget a -> RenderM a (Result a)
forall n. Widget n -> RenderM n (Result n)
B.render (Seq (Widget a) -> Widget a
forall (f :: * -> *) a. Foldable f => f (Widget a) -> Widget a
vBox Seq (Widget a)
ws)

renderList :: SemEq a => ListType -> ListSpacing -> Seq Blocks -> M (Widget a) a
renderList :: ListType -> ListSpacing -> Seq Blocks -> M (Widget a) a
renderList ListType
ty ListSpacing
_spacing Seq Blocks
bs = do
    let is :: [Text]
is = case ListType
ty of
          BulletList Char
_ -> Text -> [Text]
forall a. a -> [a]
repeat (Text
"• ")
          OrderedList Int
s EnumeratorType
_ DelimiterType
Period ->
            [ String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (Int
n :: Int)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". " | Int
n <- [Int
s..] ]
          OrderedList Int
s EnumeratorType
_ DelimiterType
OneParen ->
            [ String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (Int
n :: Int)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") " | Int
n <- [Int
s..] ]
          OrderedList Int
s EnumeratorType
_ DelimiterType
TwoParens ->
            [ String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (Int
n :: Int)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")) " | Int
n <- [Int
s..] ]

    [Widget a]
results <- [(Text, Seq Block)]
-> ((Text, Seq Block) -> M (Widget a) a)
-> ReaderT (DrawCfg a) Identity [Widget a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Text] -> [Seq Block] -> [(Text, Seq Block)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
is ([Seq Block] -> [(Text, Seq Block)])
-> [Seq Block] -> [(Text, Seq Block)]
forall a b. (a -> b) -> a -> b
$ Blocks -> Seq Block
unBlocks (Blocks -> Seq Block) -> [Blocks] -> [Seq Block]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Seq Blocks -> [Blocks]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq Blocks
bs)) (((Text, Seq Block) -> M (Widget a) a)
 -> ReaderT (DrawCfg a) Identity [Widget a])
-> ((Text, Seq Block) -> M (Widget a) a)
-> ReaderT (DrawCfg a) Identity [Widget a]
forall a b. (a -> b) -> a -> b
$ \(Text
i, Seq Block
b) -> do
        Seq (Widget a)
blocks <- (Block -> M (Widget a) a)
-> Seq Block -> ReaderT (DrawCfg a) Identity (Seq (Widget a))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Block -> M (Widget a) a
forall a. SemEq a => Block -> M (Widget a) a
renderBlock Seq Block
b
        Widget a -> M (Widget a) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget a -> M (Widget a) a) -> Widget a -> M (Widget a) a
forall a b. (a -> b) -> a -> b
$ Text -> Widget a
forall n. Text -> Widget n
B.txt Text
i Widget a -> Widget a -> Widget a
forall n. Widget n -> Widget n -> Widget n
<+> Seq (Widget a) -> Widget a
forall (f :: * -> *) a. Foldable f => f (Widget a) -> Widget a
vBox Seq (Widget a)
blocks

    Widget a -> M (Widget a) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget a -> M (Widget a) a) -> Widget a -> M (Widget a) a
forall a b. (a -> b) -> a -> b
$ [Widget a] -> Widget a
forall (f :: * -> *) a. Foldable f => f (Widget a) -> Widget a
vBox [Widget a]
results

renderWrappedLine :: Show a => Text -> WrappedLine a -> Widget a
renderWrappedLine :: Text -> WrappedLine a -> Widget a
renderWrappedLine Text
curUser WrappedLine a
l = [Widget a] -> Widget a
forall (f :: * -> *) a. Foldable f => f (Widget a) -> Widget a
hBox ([Widget a] -> Widget a) -> [Widget a] -> Widget a
forall a b. (a -> b) -> a -> b
$ Seq (Widget a) -> [Widget a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq (Widget a) -> [Widget a]) -> Seq (Widget a) -> [Widget a]
forall a b. (a -> b) -> a -> b
$ Text -> FlattenedValue a -> Widget a
forall a. Show a => Text -> FlattenedValue a -> Widget a
renderFlattenedValue Text
curUser (FlattenedValue a -> Widget a) -> WrappedLine a -> Seq (Widget a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WrappedLine a
l

renderFlattenedValue :: Show a => Text -> FlattenedValue a -> Widget a
renderFlattenedValue :: Text -> FlattenedValue a -> Widget a
renderFlattenedValue Text
curUser (NonBreaking Seq (Seq (FlattenedValue a))
rs) =
    let renderLine :: Seq (FlattenedValue a) -> Widget a
renderLine = [Widget a] -> Widget a
forall (f :: * -> *) a. Foldable f => f (Widget a) -> Widget a
hBox ([Widget a] -> Widget a)
-> (Seq (FlattenedValue a) -> [Widget a])
-> Seq (FlattenedValue a)
-> Widget a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (Widget a) -> [Widget a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq (Widget a) -> [Widget a])
-> (Seq (FlattenedValue a) -> Seq (Widget a))
-> Seq (FlattenedValue a)
-> [Widget a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FlattenedValue a -> Widget a)
-> Seq (FlattenedValue a) -> Seq (Widget a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> FlattenedValue a -> Widget a
forall a. Show a => Text -> FlattenedValue a -> Widget a
renderFlattenedValue Text
curUser)
    in [Widget a] -> Widget a
forall (f :: * -> *) a. Foldable f => f (Widget a) -> Widget a
vBox ([Widget a] -> [Widget a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList ([Widget a] -> [Widget a]) -> [Widget a] -> [Widget a]
forall a b. (a -> b) -> a -> b
$ Seq (FlattenedValue a) -> Widget a
renderLine (Seq (FlattenedValue a) -> Widget a)
-> [Seq (FlattenedValue a)] -> [Widget a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (Seq (FlattenedValue a)) -> [Seq (FlattenedValue a)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq (Seq (FlattenedValue a))
rs)
renderFlattenedValue Text
curUser (SingleInline FlattenedInline a
fi) = Widget a -> Widget a
addClickable (Widget a -> Widget a) -> Widget a -> Widget a
forall a b. (a -> b) -> a -> b
$ Widget a -> Widget a
forall n. Widget n -> Widget n
addHyperlink (Widget a -> Widget a) -> Widget a -> Widget a
forall a b. (a -> b) -> a -> b
$ Widget a -> Widget a
forall n. Widget n -> Widget n
addStyles Widget a
forall n. Widget n
widget
    where
        val :: FlattenedContent
val = FlattenedInline a -> FlattenedContent
forall a. FlattenedInline a -> FlattenedContent
fiValue FlattenedInline a
fi
        mUrl :: Maybe URL
mUrl = FlattenedInline a -> Maybe URL
forall a. FlattenedInline a -> Maybe URL
fiURL FlattenedInline a
fi
        mName :: Maybe a
mName = FlattenedInline a -> Maybe a
forall a. FlattenedInline a -> Maybe a
fiName FlattenedInline a
fi
        styles :: [InlineStyle]
styles = FlattenedInline a -> [InlineStyle]
forall a. FlattenedInline a -> [InlineStyle]
fiStyles FlattenedInline a
fi

        addStyles :: Widget n -> Widget n
addStyles Widget n
w = (InlineStyle -> Widget n -> Widget n)
-> Widget n -> [InlineStyle] -> Widget n
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr InlineStyle -> Widget n -> Widget n
forall n. InlineStyle -> Widget n -> Widget n
addStyle Widget n
w [InlineStyle]
styles
        addStyle :: InlineStyle -> Widget n -> Widget n
addStyle InlineStyle
s =
            AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
B.withDefAttr (AttrName -> Widget n -> Widget n)
-> AttrName -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ case InlineStyle
s of
                InlineStyle
Strong        -> AttrName
clientStrongAttr
                InlineStyle
Code          -> AttrName
codeAttr
                InlineStyle
Permalink     -> AttrName
permalinkAttr
                InlineStyle
Strikethrough -> AttrName
strikeThroughAttr
                InlineStyle
Emph          -> AttrName
clientEmphAttr

        addHyperlink :: Widget n -> Widget n
addHyperlink = case Maybe URL
mUrl of
            Maybe URL
Nothing -> Widget n -> Widget n
forall a. a -> a
id
            Just URL
u -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
B.withDefAttr AttrName
urlAttr (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget n -> Widget n
forall n. Text -> Widget n -> Widget n
B.hyperlink (URL -> Text
unURL URL
u)

        addClickable :: Widget a -> Widget a
addClickable Widget a
w = case Maybe a
mName of
            Maybe a
Nothing -> Widget a -> Widget a
forall a. a -> a
id Widget a
w
            Just a
nm -> a -> Widget a -> Widget a
forall n. n -> Widget n -> Widget n
B.clickable a
nm Widget a
w

        widget :: Widget n
widget = case FlattenedContent
val of
            FlattenedContent
FSpace               -> Text -> Widget n
forall n. Text -> Widget n
B.txt Text
" "
            FUser Text
u              -> Text -> Text -> Text -> Widget n
forall a. Text -> Text -> Text -> Widget a
colorUsername Text
curUser Text
u (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Text
userSigil Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
u
            FChannel Text
c           -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
B.withDefAttr AttrName
channelNameAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                                    Text -> Widget n
forall n. Text -> Widget n
B.txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Text
normalChannelSigil Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c
            FEmoji Text
em            -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
B.withDefAttr AttrName
emojiAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                                    Text -> Widget n
forall n. Text -> Widget n
B.txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
em Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
            FText Text
t              -> if Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Text
T.singleton (Char
cursorSentinel)
                                    then Widget n -> Widget n
forall n. Widget n -> Widget n
B.visible (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
B.txt Text
" "
                                    else Text -> Widget n
forall n. Text -> Widget n
textWithCursor Text
t
            FEditSentinel Bool
recent -> let attr :: AttrName
attr = if Bool
recent
                                               then AttrName
editedRecentlyMarkingAttr
                                               else AttrName
editedMarkingAttr
                                    in AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
B.withDefAttr AttrName
attr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
B.txt Text
editMarking

textWithCursor :: Text -> Widget a
textWithCursor :: Text -> Widget a
textWithCursor Text
t
    | (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
cursorSentinel) Text
t = Widget a -> Widget a
forall n. Widget n -> Widget n
B.visible (Widget a -> Widget a) -> Widget a -> Widget a
forall a b. (a -> b) -> a -> b
$ Text -> Widget a
forall n. Text -> Widget n
B.txt (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$ Text -> Text
removeCursor Text
t
    | Bool
otherwise = Text -> Widget a
forall n. Text -> Widget n
B.txt Text
t

wrappedTextWithCursor :: Text -> Widget a
wrappedTextWithCursor :: Text -> Widget a
wrappedTextWithCursor Text
t
    | (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
cursorSentinel) Text
t = Widget a -> Widget a
forall n. Widget n -> Widget n
B.visible (Widget a -> Widget a) -> Widget a -> Widget a
forall a b. (a -> b) -> a -> b
$ Text -> Widget a
forall n. Text -> Widget n
B.txtWrap (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$ Text -> Text
removeCursor Text
t
    | Bool
otherwise = Text -> Widget a
forall n. Text -> Widget n
B.txtWrap Text
t

removeCursor :: Text -> Text
removeCursor :: Text -> Text
removeCursor = (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
cursorSentinel)

-- Cursor sentinel for tracking the user's cursor position in previews.
cursorSentinel :: Char
cursorSentinel :: Char
cursorSentinel = Char
'‸'