TextFormat.hs

{-# 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 [] = []