1{-# LANGUAGE MultiWayIf #-}
2module Matterhorn.Events.Main where
3
4import           Prelude ()
5import           Matterhorn.Prelude
6
7import           Brick.Widgets.Edit
8import qualified Graphics.Vty as Vty
9
10import           Matterhorn.Command
11import           Matterhorn.Events.Keybindings
12import           Matterhorn.State.Attachments
13import           Matterhorn.State.ChannelSelect
14import           Matterhorn.State.ChannelList
15import           Matterhorn.State.Channels
16import           Matterhorn.State.Editing
17import           Matterhorn.State.MessageSelect
18import           Matterhorn.State.PostListOverlay ( enterFlaggedPostListMode )
19import           Matterhorn.State.Teams
20import           Matterhorn.State.UrlSelect
21import           Matterhorn.Types
22
23
24onEventMain :: Vty.Event -> MH ()
25onEventMain =
26  void . handleKeyboardEvent mainKeybindings (\ ev -> do
27      resetReturnChannel
28      case ev of
29          (Vty.EvPaste bytes) -> handlePaste bytes
30          _ -> handleEditingInput ev
31  )
32
33mainKeybindings :: KeyConfig -> KeyHandlerMap
34mainKeybindings = mkKeybindings mainKeyHandlers
35
36mainKeyHandlers :: [KeyEventHandler]
37mainKeyHandlers =
38    [ mkKb EnterSelectModeEvent
39        "Select a message to edit/reply/delete"
40        beginMessageSelect
41
42    , mkKb ReplyRecentEvent
43        "Reply to the most recent message"
44        replyToLatestMessage
45
46    , mkKb ToggleMessagePreviewEvent "Toggle message preview"
47        toggleMessagePreview
48
49    , mkKb ToggleChannelListVisibleEvent "Toggle channel list visibility"
50        toggleChannelListVisibility
51
52    , mkKb ToggleExpandedChannelTopicsEvent "Toggle display of expanded channel topics"
53        toggleExpandedChannelTopics
54
55    , mkKb NextTeamEvent "Switch to the next available team"
56        nextTeam
57
58    , mkKb PrevTeamEvent "Switch to the previous available team"
59        prevTeam
60
61    , mkKb MoveCurrentTeamLeftEvent "Move the current team to the left in the team list"
62        moveCurrentTeamLeft
63
64    , mkKb MoveCurrentTeamRightEvent "Move the current team to the right in the team list"
65        moveCurrentTeamRight
66
67    , mkKb
68        InvokeEditorEvent
69        "Invoke `$EDITOR` to edit the current message"
70        invokeExternalEditor
71
72    , mkKb
73        EnterFastSelectModeEvent
74        "Enter fast channel selection mode"
75         beginChannelSelect
76
77    , mkKb
78        QuitEvent
79        "Quit"
80        requestQuit
81
82    , staticKb "Tab-complete forward"
83         (Vty.EvKey (Vty.KChar '\t') []) $
84         tabComplete Forwards
85
86    , staticKb "Tab-complete backward"
87         (Vty.EvKey (Vty.KBackTab) []) $
88         tabComplete Backwards
89
90    , mkKb
91        ScrollUpEvent
92        "Scroll up in the channel input history" $ do
93             -- Up in multiline mode does the usual thing; otherwise we
94             -- navigate the history.
95             isMultiline <- use (csCurrentTeam.tsEditState.cedEphemeral.eesMultiline)
96             case isMultiline of
97                 True -> mhHandleEventLensed (csCurrentTeam.tsEditState.cedEditor) handleEditorEvent
98                                           (Vty.EvKey Vty.KUp [])
99                 False -> channelHistoryBackward
100
101    , mkKb
102        ScrollDownEvent
103        "Scroll down in the channel input history" $ do
104             -- Down in multiline mode does the usual thing; otherwise
105             -- we navigate the history.
106             isMultiline <- use (csCurrentTeam.tsEditState.cedEphemeral.eesMultiline)
107             case isMultiline of
108                 True -> mhHandleEventLensed (csCurrentTeam.tsEditState.cedEditor) handleEditorEvent
109                                           (Vty.EvKey Vty.KDown [])
110                 False -> channelHistoryForward
111
112    , mkKb PageUpEvent "Page up in the channel message list (enters message select mode)" $ do
113             beginMessageSelect
114
115    , mkKb SelectOldestMessageEvent "Scroll to top of channel message list" $ do
116             beginMessageSelect
117             messageSelectFirst
118
119    , mkKb NextChannelEvent "Change to the next channel in the channel list"
120         nextChannel
121
122    , mkKb PrevChannelEvent "Change to the previous channel in the channel list"
123         prevChannel
124
125    , mkKb NextUnreadChannelEvent "Change to the next channel with unread messages or return to the channel marked '~'"
126         nextUnreadChannel
127
128    , mkKb ShowAttachmentListEvent "Show the attachment list"
129         showAttachmentList
130
131    , mkKb NextUnreadUserOrChannelEvent
132         "Change to the next channel with unread messages preferring direct messages"
133         nextUnreadUserOrChannel
134
135    , mkKb LastChannelEvent "Change to the most recently-focused channel"
136         recentChannel
137
138    , staticKb "Send the current message"
139         (Vty.EvKey Vty.KEnter []) $ do
140             isMultiline <- use (csCurrentTeam.tsEditState.cedEphemeral.eesMultiline)
141             case isMultiline of
142                 -- Normally, this event causes the current message to
143                 -- be sent. But in multiline mode we want to insert a
144                 -- newline instead.
145                 True -> handleEditingInput (Vty.EvKey Vty.KEnter [])
146                 False -> do
147                     tId <- use csCurrentTeamId
148                     cId <- use (csCurrentChannelId tId)
149                     content <- getEditorContent
150                     handleInputSubmission tId cId content
151
152    , mkKb EnterOpenURLModeEvent "Select and open a URL posted to the current channel"
153           startUrlSelect
154
155    , mkKb ClearUnreadEvent "Clear the current channel's unread / edited indicators" $ do
156           tId <- use csCurrentTeamId
157           clearChannelUnreadStatus =<< use (csCurrentChannelId tId)
158
159    , mkKb ToggleMultiLineEvent "Toggle multi-line message compose mode"
160           toggleMultilineEditing
161
162    , mkKb CancelEvent "Cancel autocomplete, message reply, or edit, in that order"
163         cancelAutocompleteOrReplyOrEdit
164
165    , mkKb EnterFlaggedPostsEvent "View currently flagged posts"
166         enterFlaggedPostListMode
167    ]
168