diff --git a/apps/dog-food/ChatTerminal/Basic.hs b/apps/dog-food/ChatTerminal/Basic.hs index 52b618e41..875313c64 100644 --- a/apps/dog-food/ChatTerminal/Basic.hs +++ b/apps/dog-food/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/apps/dog-food/Styled.hs b/apps/dog-food/Styled.hs index 63f4ccecb..5b54644ba 100644 --- a/apps/dog-food/Styled.hs +++ b/apps/dog-food/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 diff --git a/src/Simplex/Markdown.hs b/src/Simplex/Markdown.hs index a5bc92b56..3c4da710d 100644 --- a/src/Simplex/Markdown.hs +++ b/src/Simplex/Markdown.hs @@ -24,6 +24,7 @@ data Format | Underline | StrikeThrough | Snippet + | Secret | Colored Color | NoFormat deriving (Eq, Show) @@ -40,6 +41,9 @@ unmarked = Markdown NoFormat colorMD :: Char colorMD = '!' +secretMD :: Char +secretMD = '#' + formats :: Map Char Format formats = M.fromList @@ -48,6 +52,7 @@ formats = ('+', Underline), ('~', StrikeThrough), ('`', Snippet), + (secretMD, Secret), (colorMD, Colored White) ] @@ -88,6 +93,7 @@ markdownP = merge <$> A.many' fragmentP A.anyChar >>= \case ' ' -> unmarked . T.cons ' ' <$> A.takeWhile (== ' ') c -> case M.lookup c formats of + Just Secret -> secretP Just (Colored White) -> coloredP Just f -> formattedP c "" f Nothing -> unformattedP c @@ -100,6 +106,15 @@ markdownP = merge <$> A.many' fragmentP | T.null s || T.head s == ' ' || T.last s == ' ' = unmarked $ c `T.cons` p <> s `T.snoc` c | otherwise = Markdown f s + secretP :: Parser Markdown + secretP = secret <$> A.takeWhile (== secretMD) <*> A.takeTill (== secretMD) <*> A.takeWhile (== secretMD) + secret :: Text -> Text -> Text -> Markdown + secret b s a + | T.null a || T.null s || T.head s == ' ' || T.last s == ' ' = + unmarked $ secretMD `T.cons` ss + | otherwise = Markdown Secret $ T.init ss + where + ss = b <> s <> a coloredP :: Parser Markdown coloredP = do color <- A.takeWhile (\c -> c /= ' ' && c /= colorMD) diff --git a/tests/MarkdownTests.hs b/tests/MarkdownTests.hs index 216ac9b95..ff1d4eebc 100644 --- a/tests/MarkdownTests.hs +++ b/tests/MarkdownTests.hs @@ -11,6 +11,7 @@ import Test.Hspec markdownTests :: Spec markdownTests = do textFormat + secretText textColor textFormat :: Spec @@ -49,6 +50,44 @@ textFormat = describe "text format (bold)" do parseMarkdown "snippet: `this is *bold text*`" `shouldBe` "snippet: " <> Markdown Snippet "this is *bold text*" +secretText :: Spec +secretText = describe "secret text" do + it "correct markdown" do + parseMarkdown "this is #black_secret# text" + `shouldBe` "this is " <> Markdown Secret "black_secret" <> " " <> "text" + parseMarkdown "##black_secret### text" + `shouldBe` Markdown Secret "#black_secret##" <> " " <> "text" + parseMarkdown "this is #black secret# text" + `shouldBe` "this is " <> Markdown Secret "black secret" <> " " <> "text" + parseMarkdown "##black secret### text" + `shouldBe` Markdown Secret "#black secret##" <> " " <> "text" + parseMarkdown "this is #secret#" + `shouldBe` "this is " <> Markdown Secret "secret" + parseMarkdown " #secret# text" + `shouldBe` " " <> Markdown Secret "secret" <> " " <> "text" + parseMarkdown " #secret# text" + `shouldBe` " " <> Markdown Secret "secret" <> " " <> "text" + parseMarkdown "this is #secret# " + `shouldBe` "this is " <> Markdown Secret "secret" <> " " + parseMarkdown "this is #secret# " + `shouldBe` "this is " <> Markdown Secret "secret" <> " " + it "ignored as markdown" do + parseMarkdown "this is # unformatted # text" + `shouldBe` "this is " <> "# unformatted #" <> " " <> "text" + parseMarkdown "this is #unformatted # text" + `shouldBe` "this is " <> "#unformatted #" <> " " <> "text" + parseMarkdown "this is # unformatted# text" + `shouldBe` "this is " <> "# unformatted#" <> " " <> "text" + parseMarkdown "this is ## unformatted ## text" + `shouldBe` "this is " <> "## unformatted ##" <> " " <> "text" + parseMarkdown "this is#unformatted# text" + `shouldBe` "this is#unformatted# text" + parseMarkdown "this is #unformatted text" + `shouldBe` "this is " <> "#unformatted text" + it "ignored internal markdown" do + parseMarkdown "snippet: `this is #secret_text#`" + `shouldBe` "snippet: " <> Markdown Snippet "this is #secret_text#" + red :: Text -> Markdown red = Markdown (Colored Red)