1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
{-# LANGUAGE OverloadedStrings #-}
module Erebos.TextFormat (
FormattedText,
plainText,
TextStyle,
withStyle, noStyle,
Color(..),
setForegroundColor, setBackgroundColor,
endWithNewline,
renderPlainText,
formattedTextLength,
formattedTextHeight,
) where
import Data.Text (Text)
import Data.Text qualified as T
import Erebos.TextFormat.Types
plainText :: Text -> FormattedText
plainText = PlainText
withStyle :: TextStyle -> FormattedText -> FormattedText
withStyle = FormattedText
noStyle :: TextStyle
noStyle = CustomTextColor Nothing Nothing
setForegroundColor :: Color -> TextStyle -> TextStyle
setForegroundColor color (CustomTextColor _ bg) = CustomTextColor (Just color) bg
setBackgroundColor :: Color -> TextStyle -> TextStyle
setBackgroundColor color (CustomTextColor fg _) = CustomTextColor fg (Just color)
endWithNewline :: FormattedText -> FormattedText
endWithNewline = EndWithNewline
renderPlainText :: FormattedText -> Text
renderPlainText = \case
PlainText text -> text
ConcatenatedText ftexts -> mconcat $ map renderPlainText ftexts
FormattedText _ ftext -> renderPlainText ftext
EndWithNewline ftext -> let res = renderPlainText ftext
in case T.unsnoc res of
Just ( _, '\n') -> res
_ -> res <> "\n"
formattedTextLength :: FormattedText -> Int
formattedTextLength = \case
PlainText text -> T.length text
ConcatenatedText ftexts -> sum $ map formattedTextLength ftexts
FormattedText _ ftext -> formattedTextLength ftext
EndWithNewline ftext -> formattedTextLength ftext
formattedTextHeight :: FormattedText -> Int
formattedTextHeight = countLines . collectParts
where
collectParts = \case
PlainText text -> [ text ]
ConcatenatedText ftexts -> concatMap collectParts ftexts
FormattedText _ ftext -> collectParts ftext
EndWithNewline ftext -> collectParts ftext
countLines (t : ts)
| T.null t = countLines ts
| otherwise = 1 + countLines (dropLine (t : ts))
countLines [] = 0
dropLine (t : ts)
| Just ( '\n', t' ) <- T.uncons (T.dropWhile (/= '\n') t) = t' : ts
| otherwise = dropLine ts
dropLine [] = []
|