{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RankNTypes #-}
module UI.Keybindings (
dispatch
, nullEventHandler
, eventHandlerComposeFrom
, eventHandlerComposeTo
, eventHandlerComposeCc
, eventHandlerComposeBcc
, eventHandlerComposeSubject
, eventHandlerThreadComposeFrom
, eventHandlerThreadComposeTo
, eventHandlerThreadComposeSubject
, eventHandlerManageThreadTagsEditor
, eventHandlerMailAttachmentPipeToEditor
, eventHandlerMailAttachmentOpenWithEditor
, eventHandlerMailsListOfAttachments
, eventHandlerListOfThreads
, eventHandlerViewMailManageMailTagsEditor
, eventHandlerSearchThreadsEditor
, eventHandlerComposeListOfAttachments
, eventHandlerManageFileBrowserSearchPath
, eventHandlerConfirm
, eventHandlerScrollingMailView
, eventHandlerScrollingHelpView
, eventHandlerComposeFileBrowser
, eventHandlerScrollingMailViewFind
, eventHandlerSaveToDiskEditor
, eventHandlerViewMailComposeTo
) where
import Control.Monad ((<=<))
import qualified Brick.Types as Brick
import qualified Brick.Main as Brick
import qualified Brick.Widgets.Edit as E
import qualified Brick.Widgets.List as L
import Brick.Widgets.Dialog (handleDialogEvent)
import Graphics.Vty (Event (..))
import Control.Lens (Getter, _Left, preview, set, to, view)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.State
import Data.Attoparsec.Text (parseOnly)
import Data.List (find)
import Data.Text.Zipper (currentLine)
import Prelude hiding (readFile, unlines)
import Data.RFC5322.Address.Text (mailboxList, addressList)
import Error
import Types
import Purebred.Tags (parseTagOps)
import Purebred.Parsing.Text (niceEndOfInput)
import UI.Validation (dispatchValidation)
data EventHandler v m = EventHandler
(forall f. Functor f
=> ([Keybinding v m] -> f [Keybinding v m])
-> AppState -> f AppState)
(AppState -> Event -> Brick.EventM Name (Brick.Next AppState))
lookupKeybinding :: Event -> [Keybinding v ctx] -> Maybe (Keybinding v ctx)
lookupKeybinding e = find (\x -> view kbEvent x == e)
dispatch :: EventHandler v m -> AppState -> Event -> Brick.EventM Name (Brick.Next AppState)
dispatch (EventHandler l fallback) s ev =
case lookupKeybinding ev (view l s) of
Just kb -> evalStateT (view (kbAction . aAction) kb) (set asError Nothing s)
Nothing -> fallback s ev
runValidation ::
Monoid a
=> (a -> Maybe Error)
-> Getter AppState (E.Editor a n)
-> AppState
-> IO AppState
runValidation fx l s =
dispatchValidation fx asError (view (l . E.editContentsL . to currentLine) s) s
composeFromHandler, composeToHandler, composeCcHandler, composeBccHandler, manageMailTagHandler ::
AppState -> Event -> Brick.EventM Name (Brick.Next AppState)
composeFromHandler s e =
Brick.handleEventLensed s (asCompose . cFrom) E.handleEditorEvent e
>>= liftIO . runValidation
(preview (_Left . to GenericError) . parseOnly (mailboxList <* niceEndOfInput)) (asCompose . cFrom)
>>= Brick.continue
composeToHandler s e =
Brick.handleEventLensed s (asCompose . cTo) E.handleEditorEvent e
>>= liftIO . runValidation
(preview (_Left . to GenericError) . parseOnly (addressList <* niceEndOfInput))
(asCompose . cTo)
>>= Brick.continue
composeCcHandler s e =
Brick.handleEventLensed s (asCompose . cCc) E.handleEditorEvent e
>>= liftIO . runValidation
(preview (_Left . to GenericError) . parseOnly (addressList <* niceEndOfInput))
(asCompose . cCc)
>>= Brick.continue
composeBccHandler s e =
Brick.handleEventLensed s (asCompose . cBcc) E.handleEditorEvent e
>>= liftIO . runValidation
(preview (_Left . to GenericError) . parseOnly (addressList <* niceEndOfInput))
(asCompose . cBcc)
>>= Brick.continue
manageMailTagHandler s e =
Brick.handleEventLensed s (asMailIndex . miMailTagsEditor) E.handleEditorEvent e
>>= liftIO . runValidation (preview _Left . parseTagOps) (asMailIndex . miMailTagsEditor)
>>= Brick.continue
nullEventHandler :: EventHandler v m
nullEventHandler = EventHandler (\f s -> s <$ f []) (const . Brick.continue)
eventHandlerListOfThreads :: EventHandler 'Threads 'ListOfThreads
eventHandlerListOfThreads = EventHandler
(asConfig . confIndexView . ivBrowseThreadsKeybindings)
(\s -> Brick.continue <=< Brick.handleEventLensed s (asMailIndex . miListOfThreads) L.handleListEvent)
eventHandlerSearchThreadsEditor :: EventHandler 'Threads 'SearchThreadsEditor
eventHandlerSearchThreadsEditor = EventHandler
(asConfig . confIndexView . ivSearchThreadsKeybindings)
(\s -> Brick.continue <=< Brick.handleEventLensed s (asMailIndex . miSearchThreadsEditor) E.handleEditorEvent)
eventHandlerViewMailManageMailTagsEditor :: EventHandler 'ViewMail 'ManageMailTagsEditor
eventHandlerViewMailManageMailTagsEditor = EventHandler
(asConfig . confMailView . mvManageMailTagsKeybindings)
manageMailTagHandler
eventHandlerMailsListOfAttachments:: EventHandler 'ViewMail 'MailListOfAttachments
eventHandlerMailsListOfAttachments = EventHandler
(asConfig . confMailView . mvMailListOfAttachmentsKeybindings)
(\s -> Brick.continue <=< Brick.handleEventLensed s (asMailView . mvAttachments) L.handleListEvent)
eventHandlerMailAttachmentOpenWithEditor :: EventHandler 'ViewMail 'MailAttachmentOpenWithEditor
eventHandlerMailAttachmentOpenWithEditor = EventHandler
(asConfig . confMailView . mvOpenWithKeybindings)
(\s -> Brick.continue <=< Brick.handleEventLensed s (asMailView . mvOpenCommand) E.handleEditorEvent)
eventHandlerMailAttachmentPipeToEditor :: EventHandler 'ViewMail 'MailAttachmentPipeToEditor
eventHandlerMailAttachmentPipeToEditor = EventHandler
(asConfig . confMailView . mvPipeToKeybindings)
(\s -> Brick.continue <=< Brick.handleEventLensed s (asMailView . mvPipeCommand) E.handleEditorEvent)
eventHandlerSaveToDiskEditor :: EventHandler 'ViewMail 'SaveToDiskPathEditor
eventHandlerSaveToDiskEditor = EventHandler
(asConfig . confMailView . mvSaveToDiskKeybindings)
(\s -> Brick.continue <=< Brick.handleEventLensed s (asMailView . mvSaveToDiskPath) E.handleEditorEvent)
eventHandlerManageThreadTagsEditor :: EventHandler 'Threads 'ManageThreadTagsEditor
eventHandlerManageThreadTagsEditor =
EventHandler
(asConfig . confIndexView . ivManageThreadTagsKeybindings)
(\s e -> Brick.handleEventLensed s (asMailIndex . miThreadTagsEditor) E.handleEditorEvent e
>>= liftIO . runValidation (preview _Left . parseTagOps) (asMailIndex . miThreadTagsEditor)
>>= Brick.continue)
eventHandlerScrollingMailView :: EventHandler 'ViewMail 'ScrollingMailView
eventHandlerScrollingMailView = EventHandler
(asConfig . confMailView . mvKeybindings)
(const . Brick.continue)
eventHandlerScrollingMailViewFind :: EventHandler 'ViewMail 'ScrollingMailViewFindWordEditor
eventHandlerScrollingMailViewFind = EventHandler
(asConfig . confMailView . mvFindWordEditorKeybindings)
(\s -> Brick.continue <=< Brick.handleEventLensed s (asMailView . mvFindWordEditor) E.handleEditorEvent)
eventHandlerScrollingHelpView :: EventHandler 'Help 'ScrollingHelpView
eventHandlerScrollingHelpView = EventHandler
(asConfig . confHelpView . hvKeybindings)
(const . Brick.continue)
eventHandlerThreadComposeFrom :: EventHandler 'Threads 'ComposeFrom
eventHandlerThreadComposeFrom = EventHandler
(asConfig . confIndexView . ivFromKeybindings)
composeFromHandler
eventHandlerThreadComposeTo :: EventHandler 'Threads 'ComposeTo
eventHandlerThreadComposeTo = EventHandler
(asConfig . confIndexView . ivToKeybindings)
composeToHandler
eventHandlerThreadComposeSubject :: EventHandler 'Threads 'ComposeSubject
eventHandlerThreadComposeSubject = EventHandler
(asConfig . confIndexView . ivSubjectKeybindings)
(\s -> Brick.continue <=< Brick.handleEventLensed s (asCompose . cSubject) E.handleEditorEvent)
eventHandlerComposeFrom :: EventHandler 'ComposeView 'ComposeFrom
eventHandlerComposeFrom = EventHandler
(asConfig . confComposeView . cvFromKeybindings)
composeFromHandler
eventHandlerComposeTo :: EventHandler 'ComposeView 'ComposeTo
eventHandlerComposeTo = EventHandler
(asConfig . confComposeView . cvToKeybindings)
composeToHandler
eventHandlerComposeCc :: EventHandler 'ComposeView 'ComposeCc
eventHandlerComposeCc = EventHandler
(asConfig . confComposeView . cvCcKeybindings)
composeCcHandler
eventHandlerComposeBcc :: EventHandler 'ComposeView 'ComposeBcc
eventHandlerComposeBcc = EventHandler
(asConfig . confComposeView . cvBccKeybindings)
composeBccHandler
eventHandlerComposeSubject :: EventHandler 'ComposeView 'ComposeSubject
eventHandlerComposeSubject = EventHandler
(asConfig . confComposeView . cvSubjectKeybindings)
(\s -> Brick.continue <=< Brick.handleEventLensed s (asCompose . cSubject) E.handleEditorEvent)
eventHandlerConfirm :: EventHandler 'ComposeView 'ConfirmDialog
eventHandlerConfirm = EventHandler
(asConfig . confComposeView . cvConfirmKeybindings)
(\s -> Brick.continue <=< Brick.handleEventLensed s (asCompose . cKeepDraft) handleDialogEvent)
eventHandlerComposeListOfAttachments :: EventHandler 'ComposeView 'ComposeListOfAttachments
eventHandlerComposeListOfAttachments = EventHandler
(asConfig . confComposeView . cvListOfAttachmentsKeybindings)
(\s -> Brick.continue <=< Brick.handleEventLensed s (asCompose . cAttachments) L.handleListEvent)
eventHandlerComposeFileBrowser :: EventHandler 'FileBrowser 'ListOfFiles
eventHandlerComposeFileBrowser = EventHandler
(asConfig . confFileBrowserView . fbKeybindings)
(\s -> Brick.continue <=< Brick.handleEventLensed s (asFileBrowser . fbEntries) L.handleListEvent)
eventHandlerManageFileBrowserSearchPath :: EventHandler 'FileBrowser 'ManageFileBrowserSearchPath
eventHandlerManageFileBrowserSearchPath = EventHandler
(asConfig . confFileBrowserView . fbSearchPathKeybindings)
(\s -> Brick.continue <=< Brick.handleEventLensed s (asFileBrowser . fbSearchPath) E.handleEditorEvent)
eventHandlerViewMailComposeTo :: EventHandler 'ViewMail 'ComposeTo
eventHandlerViewMailComposeTo = EventHandler
(asConfig . confMailView . mvToKeybindings)
composeToHandler