1 files changed, 79 insertions, 0 deletions
diff --git a/src/Erebos/TextFormat.hs b/src/Erebos/TextFormat.hs
new file mode 100644
index 0000000..6674ebc
--- /dev/null
+++ b/src/Erebos/TextFormat.hs
@@ -0,0 +1,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 [] = []