core: voice msg content type (#1368)

This commit is contained in:
JRoberts
2022-11-15 15:24:55 +04:00
committed by GitHub
parent cf23399262
commit b1fa1a84fe
3 changed files with 27 additions and 8 deletions
+1
View File
@@ -387,6 +387,7 @@ processChatCommand = \case
MCFile _ -> False
MCLink {} -> True
MCImage {} -> True
MCVoice {} -> False
MCUnknown {} -> True
qText = msgContentText qmc
qFileName = maybe qText (T.pack . (fileName :: CIFile d -> String)) ciFile_
+2 -7
View File
@@ -881,14 +881,9 @@ ciCallInfoText status duration = case status of
CISCallRejected -> "rejected"
CISCallAccepted -> "accepted"
CISCallNegotiated -> "connecting..."
CISCallProgress -> "in progress " <> d
CISCallEnded -> "ended " <> d
CISCallProgress -> "in progress " <> durationText duration
CISCallEnded -> "ended " <> durationText duration
CISCallError -> "error"
where
d = let (mins, secs) = duration `divMod` 60 in T.pack $ "(" <> with0 mins <> ":" <> with0 secs <> ")"
with0 n
| n < 9 = '0' : show n
| otherwise = show n
data SChatType (c :: ChatType) where
SCTDirect :: SChatType 'CTDirect
+24 -1
View File
@@ -29,6 +29,7 @@ import Data.ByteString.Internal (c2w, w2c)
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
import Data.Time.Clock (UTCTime)
import Data.Type.Equality
@@ -263,7 +264,7 @@ cmToQuotedMsg = \case
ACME _ (XMsgNew (MCQuote quotedMsg _)) -> Just quotedMsg
_ -> Nothing
data MsgContentTag = MCText_ | MCLink_ | MCImage_ | MCFile_ | MCUnknown_ Text
data MsgContentTag = MCText_ | MCLink_ | MCImage_ | MCVoice_ | MCFile_ | MCUnknown_ Text
instance StrEncoding MsgContentTag where
strEncode = \case
@@ -271,11 +272,13 @@ instance StrEncoding MsgContentTag where
MCLink_ -> "link"
MCImage_ -> "image"
MCFile_ -> "file"
MCVoice_ -> "voice"
MCUnknown_ t -> encodeUtf8 t
strDecode = \case
"text" -> Right MCText_
"link" -> Right MCLink_
"image" -> Right MCImage_
"voice" -> Right MCVoice_
"file" -> Right MCFile_
t -> Right . MCUnknown_ $ safeDecodeUtf8 t
strP = strDecode <$?> A.takeTill (== ' ')
@@ -313,6 +316,7 @@ data MsgContent
= MCText Text
| MCLink {text :: Text, preview :: LinkPreview}
| MCImage {text :: Text, image :: ImageData}
| MCVoice {text :: Text, duration :: Int}
| MCFile Text
| MCUnknown {tag :: Text, text :: Text, json :: J.Object}
deriving (Eq, Show)
@@ -322,14 +326,27 @@ msgContentText = \case
MCText t -> t
MCLink {text} -> text
MCImage {text} -> text
MCVoice {text, duration} ->
if T.null text then msg else msg <> "; " <> text
where
msg = "voice message " <> durationText duration <> "s"
MCFile t -> t
MCUnknown {text} -> text
durationText :: Int -> Text
durationText duration =
let (mins, secs) = duration `divMod` 60 in T.pack $ "(" <> with0 mins <> ":" <> with0 secs <> ")"
where
with0 n
| n < 9 = '0' : show n
| otherwise = show n
msgContentTag :: MsgContent -> MsgContentTag
msgContentTag = \case
MCText _ -> MCText_
MCLink {} -> MCLink_
MCImage {} -> MCImage_
MCVoice {} -> MCVoice_
MCFile {} -> MCFile_
MCUnknown {tag} -> MCUnknown_ tag
@@ -356,6 +373,10 @@ instance FromJSON MsgContent where
text <- v .: "text"
image <- v .: "image"
pure MCImage {image, text}
MCVoice_ -> do
text <- v .: "text"
duration <- v .: "duration"
pure MCVoice {text, duration}
MCFile_ -> MCFile <$> v .: "text"
MCUnknown_ tag -> do
text <- fromMaybe unknownMsgType <$> v .:? "text"
@@ -382,12 +403,14 @@ instance ToJSON MsgContent where
MCText t -> J.object ["type" .= MCText_, "text" .= t]
MCLink {text, preview} -> J.object ["type" .= MCLink_, "text" .= text, "preview" .= preview]
MCImage {text, image} -> J.object ["type" .= MCImage_, "text" .= text, "image" .= image]
MCVoice {text, duration} -> J.object ["type" .= MCVoice_, "text" .= text, "duration" .= duration]
MCFile t -> J.object ["type" .= MCFile_, "text" .= t]
toEncoding = \case
MCUnknown {json} -> JE.value $ J.Object json
MCText t -> J.pairs $ "type" .= MCText_ <> "text" .= t
MCLink {text, preview} -> J.pairs $ "type" .= MCLink_ <> "text" .= text <> "preview" .= preview
MCImage {text, image} -> J.pairs $ "type" .= MCImage_ <> "text" .= text <> "image" .= image
MCVoice {text, duration} -> J.pairs $ "type" .= MCVoice_ <> "text" .= text <> "duration" .= duration
MCFile t -> J.pairs $ "type" .= MCFile_ <> "text" .= t
instance ToField MsgContent where