{-# 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, editMarking )
import Matterhorn.Draw.RichText.Flatten
import Matterhorn.Draw.RichText.Wrap
import Matterhorn.Themes
import Matterhorn.Types ( HighlightSet(..), emptyHSet, SemEq(..)
, addUserSigil, resultToWidget )
import Matterhorn.Types.RichText
renderRichText :: SemEq a
=> Text
-> HighlightSet
-> Maybe Int
-> Bool
-> Maybe Int
-> Maybe (Int -> Inline -> Maybe a)
-> Blocks
-> Widget a
renderRichText :: forall a.
SemEq a =>
Text
-> HighlightSet
-> Maybe Int
-> Bool
-> Maybe Int
-> Maybe (Int -> Inline -> Maybe a)
-> Blocks
-> Widget a
renderRichText Text
curUser HighlightSet
hSet Maybe Int
w Bool
doWrap Maybe Int
doVerbTrunc 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)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Seq a -> m (Seq b)
mapM Block -> Reader (DrawCfg a) (Widget a)
forall a. (Ord 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 a. a -> ReaderT (DrawCfg a) Identity 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 a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Widget a)
blocks)
(DrawCfg { drawCurUser :: Text
drawCurUser = Text
curUser
, drawHighlightSet :: HighlightSet
drawHighlightSet = HighlightSet
hSet
, drawLineWidth :: Maybe Int
drawLineWidth = Maybe Int
w
, drawDoLineWrapping :: Bool
drawDoLineWrapping = Bool
doWrap
, drawTruncateVerbatimBlocks :: Maybe Int
drawTruncateVerbatimBlocks = Maybe Int
doVerbTrunc
, drawNameGen :: Maybe (Int -> Inline -> Maybe a)
drawNameGen = Maybe (Int -> Inline -> Maybe a)
nameGen
})
renderText :: SemEq a => Text -> Widget a
renderText :: forall a. SemEq a => 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
-> Text
-> HighlightSet
-> Maybe (Int -> Inline -> Maybe a)
-> Text
-> Widget a
renderText' :: forall a.
SemEq a =>
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
-> Maybe (Int -> Inline -> Maybe a)
-> Blocks
-> Widget a
forall a.
SemEq a =>
Text
-> HighlightSet
-> Maybe Int
-> Bool
-> Maybe Int
-> Maybe (Int -> Inline -> Maybe a)
-> Blocks
-> Widget a
renderRichText Text
curUser HighlightSet
hSet Maybe Int
forall a. Maybe a
Nothing Bool
True Maybe Int
forall a. Maybe a
Nothing 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
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 :: forall (f :: * -> *) a. Foldable f => 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 a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
hBox :: F.Foldable f => f (Widget a) -> Widget a
hBox :: forall (f :: * -> *) a. Foldable f => 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 a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
header :: Int -> Widget a
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 :: forall a. 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 { forall a. DrawCfg a -> Text
drawCurUser :: Text
, forall a. DrawCfg a -> HighlightSet
drawHighlightSet :: HighlightSet
, forall a. DrawCfg a -> Maybe Int
drawLineWidth :: Maybe Int
, forall a. DrawCfg a -> Bool
drawDoLineWrapping :: Bool
, forall a. DrawCfg a -> Maybe Int
drawTruncateVerbatimBlocks :: Maybe Int
, forall a. DrawCfg a -> Maybe (Int -> Inline -> Maybe a)
drawNameGen :: Maybe (Int -> Inline -> Maybe a)
}
renderBlock :: (Ord a, SemEq a) => Block -> M (Widget a) a
renderBlock :: forall a. (Ord a, SemEq a) => 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Inlines -> M (Widget a) a
forall a. (Ord 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Inlines -> M (Widget a) a
forall a. (Ord 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 a b. (a -> b -> b) -> b -> [a] -> b
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 a. a -> ReaderT (DrawCfg a) Identity 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. (Ord 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 = subtract 1 <$> drawLineWidth 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. (Ord a, SemEq a) => Inlines -> M (Widget a) a
renderInlines Inlines
is
Widget a -> M (Widget a) a
forall a. a -> ReaderT (DrawCfg a) Identity 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)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Seq a -> m (Seq b)
mapM Block -> M (Widget a) a
forall a. (Ord a, SemEq a) => Block -> M (Widget a) a
renderBlock (Blocks -> Seq Block
unBlocks Blocks
bs)
Widget a -> M (Widget a) a
forall a. a -> ReaderT (DrawCfg a) Identity 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.
(Ord 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 a. a -> ReaderT (DrawCfg a) Identity 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)
Widget a
w <- Text -> M (Widget a) a
forall a b. Text -> M (Widget a) b
f Text
tx
Maybe Int
trunc <- (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
drawTruncateVerbatimBlocks
case Maybe Int
trunc of
Maybe Int
Nothing -> Widget a -> M (Widget a) a
forall a. a -> ReaderT (DrawCfg a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Widget a
w
Just Int
maxHeight -> Widget a -> M (Widget a) a
forall a. a -> ReaderT (DrawCfg a) Identity 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
$ Int -> Widget a -> Widget a
forall n. Int -> Widget n -> Widget n
maybeTruncVerbatim Int
maxHeight Widget a
w
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 a. a -> ReaderT (DrawCfg a) Identity 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 a. a -> ReaderT (DrawCfg a) Identity 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
'*')
maybeTruncVerbatim :: Int -> B.Widget n -> B.Widget n
maybeTruncVerbatim :: forall n. Int -> Widget n -> Widget n
maybeTruncVerbatim Int
maxHeight Widget n
w =
Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
B.hSize Widget n
w) (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
Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
w
let h :: Int
h = Image -> Int
V.imageHeight (Result n
resultResult n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
B.imageL)
if Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxHeight
then Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
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.vBox [ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
B.vLimit Int
maxHeight (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ 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 a. a -> ReaderT (Context n) (State (RenderState n)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result
, AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
B.withDefAttr AttrName
verbatimTruncateMessageAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
String -> Widget n
forall n. String -> Widget n
B.str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ String
"(Showing " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
maxHeight String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" of " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
h String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" lines)"
]
else Result n -> RenderM n (Result n)
forall a. a -> ReaderT (Context n) (State (RenderState n)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result
quoteChar :: Char
quoteChar :: Char
quoteChar = Char
'>'
addQuoting :: B.Widget n -> B.Widget n
addQuoting :: forall n. 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 n
ctx <- RenderM n (Context n)
forall n. RenderM n (Context n)
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 n
ctxContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
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 n
ctxContext n -> Getting Attr (Context n) Attr -> Attr
forall s a. s -> Getting a s a -> a
^.Getting Attr (Context n) Attr
forall r n. Getting r (Context n) 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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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 a. a -> ReaderT (Context n) (State (RenderState n)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
childResult
]
renderCodeBlock :: Sky.SyntaxMap -> Sky.Syntax -> Text -> M (Widget a) b
renderCodeBlock :: forall a b. 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 a. [a] -> 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 a. a -> ReaderT (DrawCfg b) Identity a
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 :: forall a b. 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 a. a -> ReaderT (DrawCfg b) Identity a
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 a
c <- RenderM a (Context a)
forall n. RenderM n (Context n)
B.getContext
let theLines :: [Text]
theLines = Text -> Text
forall {a}. (Eq a, IsString a) => a -> a
expandEmpty (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
T.lines Text
tx
expandEmpty :: a -> a
expandEmpty a
"" = a
" "
expandEmpty a
s = a
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 a
cContext a -> Getting Int (Context a) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context a) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
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 (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
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
<+> (Result a -> Widget a
forall n. Result n -> Widget n
resultToWidget Result a
renderedText)
renderInlines :: (Ord a, SemEq a) => Inlines -> M (Widget a) a
renderInlines :: forall a. (Ord a, SemEq a) => 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 a. a -> ReaderT (DrawCfg a) Identity 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 a
ctx <- RenderM a (Context a)
forall n. RenderM n (Context n)
B.getContext
let width :: Int
width = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (Context a
ctxContext a -> Getting Int (Context a) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context a) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
B.availWidthL) Maybe Int
w
ws :: Seq (Widget a)
ws = (WrappedLine a -> Widget a)
-> Seq (WrappedLine a) -> Seq (Widget a)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> WrappedLine a -> Widget a
forall a. (Ord 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 a. Seq a -> [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 :: (Ord a, SemEq a) => ListType -> ListSpacing -> Seq Blocks -> M (Widget a) a
renderList :: forall a.
(Ord a, SemEq a) =>
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 a. Seq a -> [a]
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)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Seq a -> m (Seq b)
mapM Block -> M (Widget a) a
forall a. (Ord a, SemEq a) => Block -> M (Widget a) a
renderBlock Seq Block
b
Widget a -> M (Widget a) a
forall a. a -> ReaderT (DrawCfg a) Identity 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 a. a -> ReaderT (DrawCfg a) Identity 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 :: (Ord a, Show a) => Text -> WrappedLine a -> Widget a
renderWrappedLine :: forall a. (Ord a, Show a) => 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 a. Seq a -> [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. (Ord 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 :: (Ord a, Show a) => Text -> FlattenedValue a -> Widget a
renderFlattenedValue :: forall a. (Ord a, Show a) => 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 a. Seq a -> [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 a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> FlattenedValue a -> Widget a
forall a. (Ord 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 a. [a] -> [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 a. Seq a -> [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 a b. (a -> b -> b) -> b -> [a] -> b
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
w
Just a
nm -> a -> Widget a -> Widget a
forall n. Ord 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 -> Text
addUserSigil 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 :: forall n. Text -> Widget n
textWithCursor Text
t
| Char
cursorSentinel Char -> Text -> Bool
`T.elem` 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 :: forall n. Text -> Widget n
wrappedTextWithCursor Text
t
| Char
cursorSentinel Char -> Text -> Bool
`T.elem` 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)
cursorSentinel :: Char
cursorSentinel :: Char
cursorSentinel = Char
'‸'