Secret markdown (#91)

* secret text markdown

* refactor

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

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

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)

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)