packages feed

matterhorn-40901.0.0: src/State/Reactions.hs

module State.Reactions
  ( asyncFetchReactionsForPost
  , addReactions
  , removeReaction
  )
where

import           Prelude ()
import           Prelude.MH

import qualified Data.Map.Strict as Map
import           Lens.Micro.Platform

import           Network.Mattermost.Endpoints
import           Network.Mattermost.Lenses
import           Network.Mattermost.Types

import           State.Async
import           Types


asyncFetchReactionsForPost :: ChannelId -> Post -> MH ()
asyncFetchReactionsForPost cId p
  | not (p^.postHasReactionsL) = return ()
  | otherwise = doAsyncChannelMM Normal cId
        (\s _ _ -> fmap toList (mmGetReactionsForPost (p^.postIdL) s))
        addReactions

addReactions :: ChannelId -> [Reaction] -> MH ()
addReactions cId rs = csChannel(cId).ccContents.cdMessages %= fmap upd
  where upd msg = msg & mReactions %~ insertAll (msg^.mMessageId)
        insert mId r
          | mId == Just (MessagePostId (r^.reactionPostIdL)) = Map.insertWith (+) (r^.reactionEmojiNameL) 1
          | otherwise = id
        insertAll mId msg = foldr (insert mId) msg rs

removeReaction :: Reaction -> ChannelId -> MH ()
removeReaction r cId = csChannel(cId).ccContents.cdMessages %= fmap upd
  where upd m | m^.mMessageId == Just (MessagePostId $ r^.reactionPostIdL) =
                  m & mReactions %~ (Map.insertWith (+) (r^.reactionEmojiNameL) (-1))
              | otherwise = m