module Chat.Flowdock.REST.Message (
Message(..),
MessageId,
msgContent,
msgTags,
msgCreatedAt,
msgEditedAt,
msgFlowId,
msgId,
msgUser,
MessageEvent(..),
messageEventToString,
messageEventFromString,
MessageContent(..),
_MTStatus,
_MTComment,
_MTAction,
_MTTagChange,
_MTMessageEdit,
_MTActivityUser,
_MTFile,
_MTMail,
_MTActivity,
_MTDiscussion,
Comment(..),
commentText,
commentTitle,
Mail(..),
mailSubject,
mailContent,
mailFrom,
mailTo,
mailCc,
mailBcc,
mailReplyTo,
MailAddress(..),
mailAddress,
mailAddressName,
) where
import Control.Applicative
import Control.DeepSeq
import Control.Lens
import Data.Aeson
import Data.Binary.Orphans
import Data.Binary.Tagged
import Data.Hashable
import Data.Monoid
import Data.Text as T
import Data.Time
import GHC.Generics as GHC
import Generics.SOP as SOP
import Text.PrettyPrint.ANSI.Leijen.AnsiPretty
import Chat.Flowdock.REST.Internal
import Chat.Flowdock.REST.User
import Chat.Flowdock.REST.Flow
data Comment = Comment
{ _commentText :: !Text
, _commentTitle :: !Text
}
deriving (Eq, Ord, Show, GHC.Generic)
makeLenses ''Comment
instance NFData Comment
instance Hashable Comment
instance SOP.Generic Comment
instance SOP.HasDatatypeInfo Comment
instance Binary Comment
instance HasStructuralInfo Comment
instance HasSemanticVersion Comment
instance FromJSON Comment where
parseJSON = withObject "Comment" $ \obj ->
Comment <$> obj .: "text"
<*> obj .: "title"
instance AnsiPretty Comment where
ansiPretty = gAnsiPrettyWith (prettyOpts "_comment")
data MailAddress = MailAddress
{ _mailAddress :: !Text
, _mailAddressName :: !(Maybe Text)
}
deriving (Eq, Ord, Show, GHC.Generic)
makeLenses ''MailAddress
instance NFData MailAddress
instance Hashable MailAddress
instance SOP.Generic MailAddress
instance SOP.HasDatatypeInfo MailAddress
instance Binary MailAddress
instance FromJSON MailAddress where
parseJSON = withObject "MailAddress" $ \obj ->
MailAddress <$> obj .: "address"
<*> obj .:? "name"
instance AnsiPretty MailAddress where
ansiPretty (MailAddress addr Nothing) = text . T.unpack $ addr
ansiPretty (MailAddress addr (Just name)) = text . T.unpack $ name <> " <" <> addr <> ">"
data Mail = Mail
{ _mailSubject :: !Text
, _mailContent :: !Text
, _mailTo :: ![MailAddress]
, _mailFrom :: ![MailAddress]
, _mailCc :: ![MailAddress]
, _mailBcc :: ![MailAddress]
, _mailReplyTo :: ![MailAddress]
}
deriving (Eq, Ord, Show, GHC.Generic)
makeLenses ''Mail
instance NFData Mail
instance Hashable Mail
instance SOP.Generic Mail
instance SOP.HasDatatypeInfo Mail
instance Binary Mail
instance FromJSON Mail where
parseJSON = withObject "Mail" $ \obj ->
Mail <$> obj .: "subject"
<*> obj .: "content"
<*> obj .: "to"
<*> obj .: "from"
<*> obj .: "cc"
<*> obj .: "bcc"
<*> obj .: "replyTo"
instance AnsiPretty Mail where
ansiPretty = gAnsiPrettyWith (prettyOpts "_mail")
data MessageEvent = EventMessage
| EventStatus
| EventComment
| EventAction
| EventTagChange
| EventMessageEdit
| EventActivityUser
| EventFile
| EventMail
| EventActivity
| EventDiscussion
deriving (Eq, Ord, Show, Enum, Bounded)
messageEventToString :: MessageEvent -> String
messageEventToString EventMessage = "message"
messageEventToString EventStatus = "status"
messageEventToString EventComment = "comment"
messageEventToString EventAction = "action"
messageEventToString EventTagChange = "tag-change"
messageEventToString EventMessageEdit = "message-edit"
messageEventToString EventActivityUser = "activity.user"
messageEventToString EventFile = "file"
messageEventToString EventMail = "mail"
messageEventToString EventActivity = "activity"
messageEventToString EventDiscussion = "discussion"
messageEventLookupTable :: [(String, MessageEvent)]
messageEventLookupTable = fmap f [minBound..maxBound]
where f e = (messageEventToString e, e)
messageEventFromString :: String -> Maybe MessageEvent
messageEventFromString = flip lookup messageEventLookupTable
data MessageContent = MTMessage !Text
| MTStatus String
| MTComment !Comment
| MTAction !Value
| MTTagChange !Value
| MTMessageEdit !Value
| MTActivityUser !Value
| MTFile !Value
| MTMail !Mail
| MTActivity
| MTDiscussion
deriving (Eq, Show, GHC.Generic)
instance NFData MessageContent
instance Hashable MessageContent
instance SOP.Generic MessageContent
instance SOP.HasDatatypeInfo MessageContent
instance Binary MessageContent
makePrisms ''MessageContent
instance FromJSON MessageContent where
parseJSON = withObject "Message" $ \obj -> do
event <- obj .: "event"
content <- obj .: "content"
case event of
"message" -> MTMessage <$> parseJSON content
"comment" -> MTComment <$> parseJSON content
"status" -> MTStatus <$> parseJSON content
"action" -> MTAction <$> parseJSON content
"file" -> MTFile <$> parseJSON content
"mail" -> MTMail <$> parseJSON content
"activity" -> pure MTActivity
"discussion" -> pure MTDiscussion
_ -> fail $ "Invalid message type: " <> event
instance AnsiPretty MessageContent where
ansiPretty (MTMessage msg) = text "message:" <+> ansiPretty msg
ansiPretty (MTComment com) = ansiPretty com
ansiPretty (MTMail mail) = ansiPretty mail
ansiPretty m = text . show $ m
data Message = Message
{ _msgContent :: !MessageContent
, _msgTags :: ![Text]
, _msgCreatedAt :: !UTCTime
, _msgEditedAt :: !(Maybe UTCTime)
, _msgFlowId :: !FlowId
, _msgUser :: !UserId
, _msgId :: !MessageId
}
deriving (Eq, Show, GHC.Generic)
type MessageId = Identifier Integer Message
makeLenses ''Message
instance NFData Message
instance SOP.Generic Message
instance SOP.HasDatatypeInfo Message
instance Binary Message
instance FromJSON Message where
parseJSON v = do
content <- parseJSON v
flip (withObject "Message") v $ \obj ->
Message <$> pure content
<*> obj .: "tags"
<*> obj .: "created_at"
<*> obj .:? "edited_at"
<*> obj .: "flow"
<*> (mkIdentifier . read <$> obj.: "user")
<*> obj .: "id"
instance AnsiPretty Message where
ansiPretty = gAnsiPrettyWith (prettyOpts "_msg")