content: -- This file is part of purebred
  -- Copyright (C) 2017-2021 Róman Joost and Fraser Tweedale
  --
  -- purebred is free software: you can redistribute it and/or modify
  -- it under the terms of the GNU Affero General Public License as published by
  -- the Free Software Foundation, either version 3 of the License, or
  -- (at your option) any later version.
  --
  -- This program is distributed in the hope that it will be useful,
  -- but WITHOUT ANY WARRANTY; without even the implied warranty of
  -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  -- GNU Affero General Public License for more details.
  --
  -- You should have received a copy of the GNU Affero General Public License
  -- along with this program.  If not, see <http://www.gnu.org/licenses/>.
  
  {-# LANGUAGE DataKinds #-}
  
  module Purebred.UI.Keybindings (
    -- * API
    dispatch
    -- * Event Handlers
    -- $eventhandlers
    , 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 qualified Brick.Types as Brick
  import qualified Brick.Widgets.Edit as E
  import qualified Brick.Widgets.List as L
  import qualified Brick.Widgets.FileBrowser as FB
  import Brick.Widgets.Dialog (handleDialogEvent)
  import Graphics.Vty (Event (..))
  import Control.Lens (Getter, _Left, assign, preview, to, use, view)
  import Control.Monad.State
  import Data.Attoparsec.Text (parseOnly)
  import Data.List (find)
  import Data.Text.Zipper (currentLine)
  import Data.Text.Zipper.Generic (GenericTextZipper)
  import qualified Data.Text as T
  import Prelude hiding (readFile, unlines)
  
  import Data.IMF.Text (mailboxList, addressList)
  
  import Purebred.Storage.Tags (parseTagOps)
  import Purebred.Types
  import Purebred.Types.Parser.Text (niceEndOfInput)
  import Purebred.UI.Validation (dispatchValidation)
  import Purebred.UI.Widgets (editEditorL)
  import Purebred.UI.Notifications (makeWarning)
  
  -- | Purebreds event handler. Either we can look up a function
  -- declared for the key press or send the key press to the Brick widget
  -- to handle it.
  --
  data EventHandler v m = EventHandler
    (forall f. Functor f
      => ([Keybinding v m] -> f [Keybinding v m])
      -> AppState -> f AppState) -- lens to keybindings
    (Event -> Brick.EventM Name AppState ()) -- fallback handler
  
  lookupKeybinding :: Event -> [Keybinding v ctx] -> Maybe (Keybinding v ctx)
  lookupKeybinding e = find (\x -> view kbEvent x == e)
  
  dispatch :: EventHandler v m -> Event -> Brick.EventM Name AppState ()
  dispatch (EventHandler l fallback) ev = do
    kbs <- use l
    case lookupKeybinding ev kbs of
      Just kb -> assign asUserMessage Nothing *> view (kbAction . aAction) kb
      Nothing -> fallback ev
  
  -- | Wrapper for @Brick.Widgets.Edit.handleEditorEvent@ that takes
  -- @Graphics.Vty.Event@.
  --
  -- /brick-0.72/ changed the type of @handleEditorEvent@ to take a
  -- 'BrickEvent' rather than vty 'Event'.  We implemented this wrapper
  -- rather than the more invasive approach of changing the event type
  -- we pass around in our event handling framework.
  --
  -- We can make the bigger change in the future, e.g. if we want our
  -- widgts to handle mouse events.
  --
  handleEditorVtyEvent
    :: (Eq n, E.DecodeUtf8 t, Eq t, GenericTextZipper t)
    => Graphics.Vty.Event -> Brick.EventM n (E.Editor t n) ()
  handleEditorVtyEvent = E.handleEditorEvent . Brick.VtyEvent
  
  
  -- | Simple wrapper around the validation function to not repeating
  -- myself pulling the text values out of the lens.
  --
  runValidation
    :: (Monoid a, MonadIO m, MonadState AppState m)
    => (a -> Maybe UserMessage) -- ^ validation
    -> Getter AppState (E.Editor a n) -- ^ lens to retrieve the text used for validation
    -> m ()
  runValidation fx l = do
    v <- use (l . E.editContentsL . to currentLine)
    dispatchValidation fx v
  
  -- $eventhandlers
  -- Each event handler is handling a single widget in Purebreds UI
  
  -- | Handlers capable of running used in more than one view
  --
  composeFromHandler, composeToHandler, composeCcHandler, composeBccHandler, manageMailTagHandler
    :: Event -> Brick.EventM Name AppState ()
  
  composeFromHandler e = do
    Brick.zoom (asCompose . cFrom . editEditorL) (handleEditorVtyEvent e)
    runValidation
      (preview (_Left . to (makeWarning ComposeFrom . T.pack)) . parseOnly (mailboxList <* niceEndOfInput))
      (asCompose . cFrom . editEditorL)
  
  composeToHandler e = do
    Brick.zoom (asCompose . cTo . editEditorL) (handleEditorVtyEvent e)
    runValidation
      (preview (_Left . to (makeWarning ComposeTo . T.pack)) . parseOnly (addressList <* niceEndOfInput))
      (asCompose . cTo . editEditorL)
  
  composeCcHandler e = do
    Brick.zoom (asCompose . cCc . editEditorL) (handleEditorVtyEvent e)
    runValidation
      (preview (_Left . to (makeWarning ComposeCc . T.pack)) . parseOnly (addressList <* niceEndOfInput))
      (asCompose . cCc . editEditorL)
  
  composeBccHandler e = do
    Brick.zoom (asCompose . cBcc . editEditorL) (handleEditorVtyEvent e)
    runValidation
      (preview (_Left . to (makeWarning ComposeBcc . T.pack)) . parseOnly (addressList <* niceEndOfInput))
      (asCompose . cBcc . editEditorL)
  
  manageMailTagHandler e = do
    Brick.zoom (asThreadsView . miMailTagsEditor) (handleEditorVtyEvent e)
    runValidation (preview _Left . parseTagOps) (asThreadsView . miMailTagsEditor)
  
  -- | Do nothing.  It might be worthwhile to enhance this to display
  -- a message like "no binding for key <blah>".
  --
  nullEventHandler :: EventHandler v m
  nullEventHandler = EventHandler (\f s -> s <$ f []) (\_e -> pure ())
  
  
  eventHandlerListOfThreads :: EventHandler 'Threads 'ListOfThreads
  eventHandlerListOfThreads = EventHandler
    (asConfig . confIndexView . ivBrowseThreadsKeybindings)
    (Brick.zoom (asThreadsView . miListOfThreads) . L.handleListEvent)
  
  eventHandlerSearchThreadsEditor :: EventHandler 'Threads 'SearchThreadsEditor
  eventHandlerSearchThreadsEditor = EventHandler
    (asConfig . confIndexView . ivSearchThreadsKeybindings)
    (Brick.zoom (asThreadsView . miSearchThreadsEditor . editEditorL) . handleEditorVtyEvent)
  
  eventHandlerViewMailManageMailTagsEditor :: EventHandler 'ViewMail 'ManageMailTagsEditor
  eventHandlerViewMailManageMailTagsEditor = EventHandler
    (asConfig . confMailView . mvManageMailTagsKeybindings)
    manageMailTagHandler
  
  eventHandlerMailsListOfAttachments:: EventHandler 'ViewMail 'MailListOfAttachments
  eventHandlerMailsListOfAttachments = EventHandler
    (asConfig . confMailView . mvMailListOfAttachmentsKeybindings)
    (Brick.zoom (asMailView . mvAttachments) . L.handleListEvent)
  
  eventHandlerMailAttachmentOpenWithEditor :: EventHandler 'ViewMail 'MailAttachmentOpenWithEditor
  eventHandlerMailAttachmentOpenWithEditor = EventHandler
    (asConfig . confMailView . mvOpenWithKeybindings)
    (Brick.zoom (asMailView . mvOpenCommand) . handleEditorVtyEvent)
  
  eventHandlerMailAttachmentPipeToEditor :: EventHandler 'ViewMail 'MailAttachmentPipeToEditor
  eventHandlerMailAttachmentPipeToEditor = EventHandler
    (asConfig . confMailView . mvPipeToKeybindings)
    (Brick.zoom (asMailView . mvPipeCommand) . handleEditorVtyEvent)
  
  eventHandlerSaveToDiskEditor :: EventHandler 'ViewMail 'SaveToDiskPathEditor
  eventHandlerSaveToDiskEditor = EventHandler
    (asConfig . confMailView . mvSaveToDiskKeybindings)
    (Brick.zoom (asMailView . mvSaveToDiskPath) . handleEditorVtyEvent)
  
  eventHandlerManageThreadTagsEditor :: EventHandler 'Threads 'ManageThreadTagsEditor
  eventHandlerManageThreadTagsEditor =
    EventHandler
      (asConfig . confIndexView . ivManageThreadTagsKeybindings)
      (\e -> do
        Brick.zoom (asThreadsView . miThreadTagsEditor) (handleEditorVtyEvent e)
        runValidation
          (preview _Left . parseTagOps)
          (asThreadsView . miThreadTagsEditor)
      )
  
  eventHandlerScrollingMailView :: EventHandler 'ViewMail 'ScrollingMailView
  eventHandlerScrollingMailView = EventHandler
    (asConfig . confMailView . mvKeybindings)
    (\_e -> pure ())
  
  eventHandlerScrollingMailViewFind :: EventHandler 'ViewMail 'ScrollingMailViewFindWordEditor
  eventHandlerScrollingMailViewFind = EventHandler
    (asConfig . confMailView . mvFindWordEditorKeybindings)
    (Brick.zoom (asMailView . mvFindWordEditor) . handleEditorVtyEvent)
  
  eventHandlerScrollingHelpView :: EventHandler 'Help 'ScrollingHelpView
  eventHandlerScrollingHelpView = EventHandler
    (asConfig . confHelpView . hvKeybindings)
    (\_e -> pure ())
  
  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)
    (Brick.zoom (asCompose . cSubject . editEditorL) . handleEditorVtyEvent)
  
  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)
    (Brick.zoom (asCompose . cSubject . editEditorL) . handleEditorVtyEvent)
  
  eventHandlerConfirm :: EventHandler 'ComposeView 'ConfirmDialog
  eventHandlerConfirm = EventHandler
    (asConfig . confComposeView . cvConfirmKeybindings)
    (Brick.zoom (asCompose . cKeepDraft) . handleDialogEvent)
  
  eventHandlerComposeListOfAttachments :: EventHandler 'ComposeView 'ComposeListOfAttachments
  eventHandlerComposeListOfAttachments = EventHandler
    (asConfig . confComposeView . cvListOfAttachmentsKeybindings)
    (Brick.zoom (asCompose . cAttachments) . L.handleListEvent)
  
  eventHandlerComposeFileBrowser :: EventHandler 'FileBrowser 'ListOfFiles
  eventHandlerComposeFileBrowser = EventHandler
    (asConfig . confFileBrowserView . fbKeybindings)
    (Brick.zoom (asFileBrowser . fbEntries) . FB.handleFileBrowserEvent)
  
  eventHandlerManageFileBrowserSearchPath :: EventHandler 'FileBrowser 'ManageFileBrowserSearchPath
  eventHandlerManageFileBrowserSearchPath = EventHandler
    (asConfig . confFileBrowserView . fbSearchPathKeybindings)
    (Brick.zoom (asFileBrowser . fbSearchPath . editEditorL) . handleEditorVtyEvent)
  
  eventHandlerViewMailComposeTo :: EventHandler 'ViewMail 'ComposeTo
  eventHandlerViewMailComposeTo = EventHandler
    (asConfig . confMailView . mvToKeybindings)
    composeToHandler
  