change contact color (#48)

apps/dog-food/ChatTerminal/Core.hs

@@ -11,6 +11,7 @@ import Data.List (dropWhileEnd)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding
+import Simplex.Markdown
 import Styled
 import System.Console.ANSI.Types
 import System.Terminal hiding (insertChars)
@@ -115,7 +116,7 @@ updateTermState ac tw (key, ms) ts@TerminalState {inputString = s, inputPosition
 styleMessage :: String -> StyledString
 styleMessage = \case
   "" -> ""
-  s@('@' : _) -> let (c, rest) = span (/= ' ') s in Styled selfSGR c <> markdown rest
+  s@('@' : _) -> let (c, rest) = span (/= ' ') s in styled (Colored Cyan) c <> markdown rest
   s -> markdown s
   where
     markdown :: String -> StyledString
@@ -127,13 +128,7 @@ safeDecodeUtf8 = decodeUtf8With onError
     onError _ _ = Just '?'
 
 ttyContact :: Contact -> StyledString
-ttyContact (Contact a) = Styled contactSGR $ B.unpack a
+ttyContact (Contact a) = styled (Colored Green) a
 
 ttyFromContact :: Contact -> StyledString
-ttyFromContact (Contact a) = Styled contactSGR $ B.unpack a <> "> "
-
-contactSGR :: [SGR]
-contactSGR = [SetColor Foreground Vivid Yellow]
-
-selfSGR :: [SGR]
-selfSGR = [SetColor Foreground Vivid Cyan]
+ttyFromContact (Contact a) = styled (Colored Yellow) $ a <> "> "

apps/dog-food/Main.hs

@@ -110,7 +110,7 @@ serializeChatResponse = \case
   Confirmation c -> [ttyContact c <> " ok"]
   ReceivedMessage c t -> prependFirst (ttyFromContact c) $ msgPlain t
   -- TODO either add command to re-connect or update message below
-  Disconnected c -> ["disconnected from " <> ttyContact c <> " - try \"/chat " <> bPlain (toBs c) <> "\""]
+  Disconnected c -> ["disconnected from " <> ttyContact c <> " - restart chat"]
   YesYes -> ["you got it!"]
   ContactError e c -> case e of
     UNKNOWN -> ["no contact " <> ttyContact c]

apps/dog-food/Styled.hs

@@ -1,9 +1,13 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+
 module Styled
   ( StyledString (..),
     bPlain,
     plain,
     styleMarkdown,
     styleMarkdownText,
+    styled,
     sLength,
   )
 where
@@ -42,18 +46,25 @@ 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]
-      Italic -> [SetUnderlining SingleUnderline, SetItalicized True]
-      Underline -> [SetUnderlining SingleUnderline]
-      StrikeThrough -> [SetSwapForegroundBackground True]
-      Colored c -> [SetColor Foreground Vivid c]
-      Secret -> [SetColor Foreground Dull Black, SetColor Background Dull Black]
-      Snippet -> []
-      NoFormat -> []
+class StyledFormat a where
+  styled :: Format -> a -> StyledString
+
+instance StyledFormat String where styled = Styled . sgr
+
+instance StyledFormat ByteString where styled f = styled f . B.unpack
+
+instance StyledFormat Text where styled f = styled f . T.unpack
+
+sgr :: Format -> [SGR]
+sgr = \case
+  Bold -> [SetConsoleIntensity BoldIntensity]
+  Italic -> [SetUnderlining SingleUnderline, SetItalicized True]
+  Underline -> [SetUnderlining SingleUnderline]
+  StrikeThrough -> [SetSwapForegroundBackground True]
+  Colored c -> [SetColor Foreground Vivid c]
+  Secret -> [SetColor Foreground Dull Black, SetColor Background Dull Black]
+  Snippet -> []
+  NoFormat -> []
 
 sLength :: StyledString -> Int
 sLength (Styled _ s) = length s