diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2026-02-07 17:10:21 +0100 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2026-02-07 17:10:21 +0100 |
| commit | 722e30758b7a222a0e074bd17d8116001560c156 (patch) | |
| tree | 29779a5114865dc20a6b08f0d2ab22c7ffd666c6 /src/Erebos/TextFormat | |
| parent | 00fb858401afbac6a0b90ba0540a24939cabc5e2 (diff) | |
Terminal: use FormattedText in printLine
Diffstat (limited to 'src/Erebos/TextFormat')
| -rw-r--r-- | src/Erebos/TextFormat/Ansi.hs | 37 | ||||
| -rw-r--r-- | src/Erebos/TextFormat/Types.hs | 1 |
2 files changed, 30 insertions, 8 deletions
diff --git a/src/Erebos/TextFormat/Ansi.hs b/src/Erebos/TextFormat/Ansi.hs index c0ff978..faec0ad 100644 --- a/src/Erebos/TextFormat/Ansi.hs +++ b/src/Erebos/TextFormat/Ansi.hs @@ -8,6 +8,8 @@ module Erebos.TextFormat.Ansi ( ) where import Control.Applicative +import Control.Monad.State +import Control.Monad.Writer import Data.String import Data.Text (Text) @@ -20,19 +22,38 @@ newtype AnsiText = AnsiText { fromAnsiText :: Text } deriving (Eq, Ord, Semigroup, Monoid, IsString) +data RenderState = RenderState + { rsEndedWithNewline :: Bool + } + +initialRenderState :: RenderState +initialRenderState = RenderState + { rsEndedWithNewline = True + } + renderAnsiText :: FormattedText -> AnsiText -renderAnsiText = AnsiText . go ( Nothing, Nothing ) +renderAnsiText ft = AnsiText $ T.concat $ execWriter $ flip evalStateT initialRenderState $ go ( Nothing, Nothing ) ft where + go :: ( Maybe Color, Maybe Color ) -> FormattedText -> StateT RenderState (Writer [ Text ]) () go cur@( cfg, cbg ) = \case - PlainText text -> text - ConcatenatedText ftexts -> mconcat $ map (go cur) ftexts - FormattedText (CustomTextColor fg bg) ftext -> mconcat - [ ansiColor fg bg - , go ( fg <|> cfg, bg <|> cbg ) ftext - , ansiColor + PlainText text -> do + tell [ text ] + case T.unsnoc text of + Just ( _, c ) -> modify (\s -> s { rsEndedWithNewline = c == '\n' }) + Nothing -> return () + ConcatenatedText ftexts -> mconcat <$> mapM (go cur) ftexts + FormattedText (CustomTextColor fg bg) ftext -> do + tell [ ansiColor fg bg ] + go ( fg <|> cfg, bg <|> cbg ) ftext + tell [ ansiColor (if fg /= cfg then cfg <|> Just DefaultColor else Nothing) (if bg /= cbg then cbg <|> Just DefaultColor else Nothing) - ] + ] + EndWithNewline ftext -> do + go cur ftext + gets rsEndedWithNewline >>= \case + True -> return () + False -> tell [ "\n" ] >> modify (\s -> s { rsEndedWithNewline = True }) ansiColor :: Maybe Color -> Maybe Color -> Text diff --git a/src/Erebos/TextFormat/Types.hs b/src/Erebos/TextFormat/Types.hs index a03bc71..a93026d 100644 --- a/src/Erebos/TextFormat/Types.hs +++ b/src/Erebos/TextFormat/Types.hs @@ -12,6 +12,7 @@ data FormattedText = PlainText Text | ConcatenatedText [ FormattedText ] | FormattedText TextStyle FormattedText + | EndWithNewline FormattedText instance IsString FormattedText where fromString = PlainText . fromString |