1module Matterhorn.State.Flagging 2 ( loadFlaggedMessages 3 , updateMessageFlag 4 ) 5where 6 7import Prelude () 8import Matterhorn.Prelude 9 10import Data.Function ( on ) 11import qualified Data.Set as Set 12import qualified Data.HashMap.Strict as HM 13import Lens.Micro.Platform 14 15import Network.Mattermost.Types 16 17import Matterhorn.State.Common 18import Matterhorn.Types 19 20 21loadFlaggedMessages :: Seq FlaggedPost -> ChatState -> IO () 22loadFlaggedMessages prefs st = doAsyncWithIO Normal st $ do 23 return $ Just $ do 24 sequence_ [ updateMessageFlag (flaggedPostId fp) True 25 | fp <- toList prefs 26 , flaggedPostStatus fp 27 ] 28 29 30-- | Update the UI to reflect the flagged/unflagged state of a 31-- message. This __does not__ talk to the Mattermost server, but 32-- rather is the function we call when the Mattermost server notifies 33-- us of flagged or unflagged messages. 34updateMessageFlag :: PostId -> Bool -> MH () 35updateMessageFlag pId f = do 36 if f 37 then csResources.crFlaggedPosts %= Set.insert pId 38 else csResources.crFlaggedPosts %= Set.delete pId 39 msgMb <- use (csPostMap.at(pId)) 40 case msgMb of 41 Just msg 42 | Just cId <- msg^.mChannelId -> withChannel cId $ \chan -> do 43 let isTargetMessage m = m^.mMessageId == Just (MessagePostId pId) 44 csChannel(cId).ccContents.cdMessages.traversed.filtered isTargetMessage.mFlagged .= f 45 csPostMap.ix(pId).mFlagged .= f 46 47 let mTId = chan^.ccInfo.cdTeamId 48 updatePostOverlay :: TeamId -> MH () 49 updatePostOverlay tId = do 50 -- We also want to update the post overlay if this happens 51 -- while we're we're observing it 52 mode <- use (csTeam tId.tsMode) 53 case mode of 54 PostListOverlay PostListFlagged 55 | f -> 56 csTeam tId.tsPostListOverlay.postListPosts %= 57 addMessage (msg & mFlagged .~ True) 58 59 -- deleting here is tricky, because it means that we 60 -- need to move the focus somewhere: we'll try moving 61 -- it _up_ unless we can't, in which case we'll try 62 -- moving it down. 63 | otherwise -> do 64 selId <- use (csTeam tId.tsPostListOverlay.postListSelected) 65 posts <- use (csTeam tId.tsPostListOverlay.postListPosts) 66 let nextId = case getNextPostId selId posts of 67 Nothing -> getPrevPostId selId posts 68 Just x -> Just x 69 csTeam tId.tsPostListOverlay.postListSelected .= nextId 70 csTeam tId.tsPostListOverlay.postListPosts %= 71 filterMessages (((/=) `on` _mMessageId) msg) 72 _ -> return () 73 74 case mTId of 75 Nothing -> do 76 ts <- use csTeams 77 forM_ (HM.keys ts) updatePostOverlay 78 Just tId -> updatePostOverlay tId 79 80 _ -> return () 81