1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE RankNTypes #-}
3module Matterhorn.State.NotifyPrefs
4    ( enterEditNotifyPrefsMode
5    , exitEditNotifyPrefsMode
6    )
7where
8
9import Prelude ()
10import Matterhorn.Prelude
11
12import Network.Mattermost.Types ( ChannelNotifyProps
13                                , TeamId
14                                , User(..)
15                                , UserNotifyProps(..)
16                                , Type(..)
17                                , channelNotifyPropsMarkUnread
18                                , channelNotifyPropsIgnoreChannelMentions
19                                , WithDefault(..)
20                                , NotifyOption(..)
21                                )
22
23import Brick
24import Brick.Forms
25import Lens.Micro.Platform ( Lens', (.=), lens )
26
27import Matterhorn.Types
28
29
30muteLens :: Lens' ChannelNotifyProps Bool
31muteLens = lens (\props -> props^.channelNotifyPropsMarkUnreadL == IsValue NotifyOptionMention)
32           (\props muted -> props { channelNotifyPropsMarkUnread =
33                                          if muted
34                                          then IsValue NotifyOptionMention
35                                          else IsValue NotifyOptionAll
36                                  })
37
38channelMentionLens :: Lens' ChannelNotifyProps Bool
39channelMentionLens = lens (\props -> props^.channelNotifyPropsIgnoreChannelMentionsL == IsValue True)
40                     (\props ignoreChannelMentions ->
41                          props { channelNotifyPropsIgnoreChannelMentions = if ignoreChannelMentions
42                                                                            then IsValue True
43                                                                            else Default
44                                })
45
46notifyOptionName :: NotifyOption -> Text
47notifyOptionName NotifyOptionAll = "All activity"
48notifyOptionName NotifyOptionMention = "Mentions"
49notifyOptionName NotifyOptionNone = "Never"
50
51mkNotifyButtons :: ((WithDefault NotifyOption) -> Name)
52                -> Lens' ChannelNotifyProps (WithDefault NotifyOption)
53                -> NotifyOption
54                -> ChannelNotifyProps
55                -> FormFieldState ChannelNotifyProps e Name
56mkNotifyButtons mkName l globalDefault =
57    let optTuple opt = (IsValue opt, mkName $ IsValue opt, notifyOptionName opt)
58        defaultField = (Default, mkName Default, "Global default (" <> notifyOptionName globalDefault <> ")")
59        nonDefault = optTuple <$> [ NotifyOptionAll
60                                  , NotifyOptionMention
61                                  , NotifyOptionNone
62                                  ]
63    in radioField l (defaultField : nonDefault)
64
65notifyPrefsForm :: TeamId -> UserNotifyProps -> ChannelNotifyProps -> Form ChannelNotifyProps e Name
66notifyPrefsForm tId globalDefaults =
67    newForm [ checkboxField muteLens (MuteToggleField tId) "Mute channel"
68            , (padTop $ Pad 1) @@= checkboxField channelMentionLens (ChannelMentionsField tId) "Ignore channel mentions"
69            , radioStyle "Desktop notifications" @@=
70                mkNotifyButtons (DesktopNotificationsField tId) channelNotifyPropsDesktopL (userNotifyPropsDesktop globalDefaults)
71            , radioStyle "Push notifications" @@=
72                mkNotifyButtons (PushNotificationsField tId) channelNotifyPropsPushL (userNotifyPropsPush globalDefaults)
73            ]
74    where radioStyle label = (padTop $ Pad 1 ) . (str label <=>) . (padLeft $ Pad 1)
75
76enterEditNotifyPrefsMode :: MH ()
77enterEditNotifyPrefsMode = do
78    chanInfo <- use (csCurrentChannel.ccInfo)
79    case chanInfo^.cdType of
80      Direct -> mhError $ GenericError "Cannot open notification preferences for DM channel."
81      _ -> do
82        let props = chanInfo^.cdNotifyProps
83        user <- use csMe
84        tId <- use csCurrentTeamId
85        csCurrentTeam.tsNotifyPrefs .= (Just (notifyPrefsForm tId (userNotifyProps user) props))
86        setMode EditNotifyPrefs
87
88exitEditNotifyPrefsMode :: MH ()
89exitEditNotifyPrefsMode = do
90    setMode Main
91