mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-03-30 18:35:49 +00:00
64381be91d
* initial mobile app design draft * add proposals * xcode project * refactor function to send to view as parameter * export C interface * remove unused files * run chat from chatInit * split chatStart to a separate function * replace file-embed with QQ * add mobile views * server using IP address * pass dbFilePrefix as parameter to chatInit * comment on enabling logging * fix mobile db config * update C API, make user non-optional in ChatController * restore SMP server addresses * revert the change in the tests * flip dependency - now Controller depends on Terminal * make ChatController independent of terminal package * fix Main.hs * add iOS .gitignore * refactor Simplex.Chat.Terminal Co-authored-by: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com>
80 lines
2.2 KiB
Haskell
80 lines
2.2 KiB
Haskell
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
|
|
module Simplex.Chat.Styled
|
|
( StyledString (..),
|
|
StyledFormat (..),
|
|
styleMarkdown,
|
|
styleMarkdownText,
|
|
unStyle,
|
|
sLength,
|
|
sShow,
|
|
)
|
|
where
|
|
|
|
import Data.ByteString.Char8 (ByteString)
|
|
import qualified Data.ByteString.Char8 as B
|
|
import Data.String
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as T
|
|
import Simplex.Chat.Markdown
|
|
import System.Console.ANSI.Types
|
|
|
|
data StyledString = Styled [SGR] String | StyledString :<>: StyledString
|
|
|
|
instance Semigroup StyledString where (<>) = (:<>:)
|
|
|
|
instance Monoid StyledString where mempty = plain ""
|
|
|
|
instance IsString StyledString where fromString = plain
|
|
|
|
styleMarkdownText :: Text -> StyledString
|
|
styleMarkdownText = styleMarkdown . parseMarkdown
|
|
|
|
styleMarkdown :: Markdown -> StyledString
|
|
styleMarkdown (s1 :|: s2) = styleMarkdown s1 <> styleMarkdown s2
|
|
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]
|
|
|
|
class StyledFormat a where
|
|
styled :: Format -> a -> StyledString
|
|
plain :: a -> StyledString
|
|
|
|
instance StyledFormat String where
|
|
styled = Styled . sgr
|
|
plain = Styled []
|
|
|
|
instance StyledFormat ByteString where
|
|
styled f = styled f . B.unpack
|
|
plain = Styled [] . B.unpack
|
|
|
|
instance StyledFormat Text where
|
|
styled f = styled f . T.unpack
|
|
plain = Styled [] . T.unpack
|
|
|
|
sShow :: Show a => a -> StyledString
|
|
sShow = plain . show
|
|
|
|
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 -> []
|
|
|
|
unStyle :: StyledString -> String
|
|
unStyle (Styled _ s) = s
|
|
unStyle (s1 :<>: s2) = unStyle s1 <> unStyle s2
|
|
|
|
sLength :: StyledString -> Int
|
|
sLength (Styled _ s) = length s
|
|
sLength (s1 :<>: s2) = sLength s1 + sLength s2
|