diff --git a/ChatTerminal/Basic.hs b/ChatTerminal/Basic.hs index 52b618e414..875313c645 100644 --- a/ChatTerminal/Basic.hs +++ b/ChatTerminal/Basic.hs @@ -61,7 +61,7 @@ setSGR = mapM_ $ \case getKey :: MonadTerminal m => m (Key, Modifiers) getKey = - awaitEvent >>= \case + flush >> awaitEvent >>= \case Left Interrupt -> liftIO exitSuccess Right (KeyEvent key ms) -> pure (key, ms) _ -> getKey diff --git a/Styled.hs b/Styled.hs index 63f4ccecbe..5b54644bad 100644 --- a/Styled.hs +++ b/Styled.hs @@ -1,4 +1,14 @@ -module Styled where +{-# LANGUAGE LambdaCase #-} + +module Styled + ( StyledString (..), + bPlain, + plain, + styleMarkdown, + styleMarkdownText, + sLength, + ) +where import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B @@ -6,7 +16,6 @@ import Data.String import Data.Text (Text) import qualified Data.Text as T import Simplex.Markdown -import System.Console.ANSI (setSGRCode) import System.Console.ANSI.Types data StyledString = Styled [SGR] String | StyledString :<>: StyledString @@ -28,8 +37,15 @@ styleMarkdownText = styleMarkdown . parseMarkdown styleMarkdown :: Markdown -> StyledString styleMarkdown (s1 :|: s2) = styleMarkdown s1 <> styleMarkdown s2 -styleMarkdown (Markdown Snippet s) = plain . T.unpack $ '`' `T.cons` s `T.snoc` '`' -styleMarkdown (Markdown f s) = Styled sgr $ T.unpack s +styleMarkdown (Markdown Snippet s) = '`' `wrap` styled Snippet s +styleMarkdown (Markdown Secret s) = '#' `wrap` styled Secret s +styleMarkdown (Markdown f s) = styled f s + +wrap :: Char -> StyledString -> StyledString +wrap c s = plain [c] <> s <> plain [c] + +styled :: Format -> Text -> StyledString +styled f = Styled sgr . T.unpack where sgr = case f of Bold -> [SetConsoleIntensity BoldIntensity] @@ -37,18 +53,10 @@ styleMarkdown (Markdown f s) = Styled sgr $ T.unpack s Underline -> [SetUnderlining SingleUnderline] StrikeThrough -> [SetSwapForegroundBackground True] Colored c -> [SetColor Foreground Vivid c] + Secret -> [SetColor Foreground Dull Black, SetColor Background Dull Black] Snippet -> [] NoFormat -> [] -styledToANSITerm :: StyledString -> String -styledToANSITerm (Styled [] s) = s -styledToANSITerm (Styled sgr s) = setSGRCode sgr <> s <> setSGRCode [Reset] -styledToANSITerm (s1 :<>: s2) = styledToANSITerm s1 <> styledToANSITerm s2 - -styledToPlain :: StyledString -> String -styledToPlain (Styled _ s) = s -styledToPlain (s1 :<>: s2) = styledToPlain s1 <> styledToPlain s2 - sLength :: StyledString -> Int sLength (Styled _ s) = length s sLength (s1 :<>: s2) = sLength s1 + sLength s2