mywork-1.0.1.0: lib/Events.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeApplications #-}

module Events
  (
    handleMyWorkEvent
  )
where

import           Brick hiding ( Location )
import           Brick.Panes
import           Control.Lens
import           Control.Monad ( unless, when )
import           Control.Monad.IO.Class ( liftIO )
import           Control.Monad.Reader ( ReaderT, runReaderT, ask, lift )
import           Control.Monad.State ( evalStateT )
import           Control.Monad.Writer ( WriterT, execWriterT, tell )
import qualified Data.List as DL
import           Data.Time.Clock ( getCurrentTime, utctDay )
import qualified Graphics.Vty as Vty

import           Defs
import           Panes.AddProj
import           Panes.Confirmation
import           Panes.FileMgr
import           Panes.Help
import           Panes.LocationInput
import           Panes.Messages
import           Panes.NoteInput
import           Sync
import           Whole


handleMyWorkEvent :: BrickEvent WName MyWorkEvent -> EventM WName MyWorkState ()
handleMyWorkEvent ev = do
  t <- utctDay <$> liftIO getCurrentTime
  modify $ onBaseState . todayL .~ t
  dispatchMyWorkEvent ev


dispatchMyWorkEvent :: BrickEvent WName MyWorkEvent
                    -> EventM WName MyWorkState ()
dispatchMyWorkEvent = \case
  AppEvent _ -> return () -- this app does not use these

  --------------------------------------------------------
  -- Application global actions
  --   * CTRL-q quits
  --   * CTRL-l refreshes vty
  --   * ESC dismisses any modal window

  VtyEvent (Vty.EvKey (Vty.KChar 'q') [Vty.MCtrl]) -> do
    s <- get
    if s ^. onPane @FileMgrPane . to unsavedChanges
      then modify ( (focusRingUpdate myWorkFocusL)
                    . (onPane @Confirm %~ showConfirmation ConfirmQuit)
                  )
      else halt
  VtyEvent (Vty.EvKey (Vty.KChar 'l') [Vty.MCtrl]) ->
    liftIO . Vty.refresh =<< getVtyHandle

  --------------------------------------------------------
  -- Other application global events (see Pane.Operations)

  -- Enter Load/Save modal dialog
  VtyEvent (Vty.EvKey (Vty.KFun 9) []) -> do
    resetMessages
    s <- get
    if s ^. onPane @FileMgrPane . to isFileMgrActive
      then return ()
      else do
        s' <- s & onPane @FileMgrPane %%~ liftIO . showFileMgr
        put $ s' & focusRingUpdate myWorkFocusL

  -- Quickly save to current file (if possible)
  ev@(VtyEvent (Vty.EvKey (Vty.KChar 's') [Vty.MCtrl])) -> do
    isModal <- gets (isPanelModal myWorkFocusL)
    unless isModal $ do
      s <- get
      when (not $ s ^. onPane @FileMgrPane . to isFileMgrActive) $ do
        s' <- s & onPane @FileMgrPane %%~ liftIO . showFileMgr
        put $ s' & focusRingUpdate myWorkFocusL
    eventToPanel ev

  -- Show help on F1
  VtyEvent (Vty.EvKey (Vty.KFun 1) []) ->
    modify $ (   (focusRingUpdate myWorkFocusL)
               . (onPane @HelpPane .~ initHelp)
             )

  -- Add an entry to the currently selected pane
  VtyEvent (Vty.EvKey (Vty.KFun 2) []) -> do
    resetMessages
    s <- get
    case opOnSelection s of
      ProjectOp ->
        put $ s
        & onPane @AddProjPane %~ initAddProj (snd $ getProjects s) Nothing
        & focusRingUpdate myWorkFocusL
      LocationOp -> addLocation s
      NoteOp -> addNote s

  -- Add a sub-entry to the currently selected pane entry
  VtyEvent (Vty.EvKey (Vty.KFun 3) []) -> do
    resetMessages
    s <- get
    case opOnSelection s of
      ProjectOp -> addLocation s
      LocationOp -> addNote s
      NoteOp -> addNote s  -- Note: F3 is not displayed, but no lower entry

  -- Edit the current selected entry in whichever pane is active
  VtyEvent (Vty.EvKey (Vty.KChar 'e') [Vty.MCtrl]) -> do
    isModal <- gets (isPanelModal myWorkFocusL)
    unless isModal $ do
      resetMessages
      s <- get
      case opOnSelection s of
        ProjectOp ->
          case getCurrentLocation s of
            Just (p, _) ->
              put $ s
              & onPane @AddProjPane %~ initAddProj (snd $ getProjects s) (Just p)
              & focusRingUpdate myWorkFocusL
            _ -> return ()
        LocationOp ->
          case getCurrentLocation s of
            Just (p, Just l) ->  -- KWQ: same as addLocation but Just l ...
              let n = p ^. projNameL
                  ls = p ^. locationsL
              in put $ s
                 & onPane @LocationInputPane %~ initLocInput n ls (Just l)
                 & focusRingUpdate myWorkFocusL
            _ -> return ()
        NoteOp ->
          case getCurrentLocation s of
            Just (_, Just l) ->
              let nt = getCurrentNote s l
              in when (maybe False canEditNote nt) $ do
                s' <- s & onPane @NoteInputPane
                          %%~ initNoteInput (l ^. notesL) nt
                put $ s' & focusRingUpdate myWorkFocusL
            _ -> return ()

  -- Delete the current selected entry in whichever pane is active
  VtyEvent (Vty.EvKey Vty.KDel []) -> do
    isModal <- gets (isPanelModal myWorkFocusL)
    unless isModal $ do
      resetMessages
      s <- get
      let cnf =
            case opOnSelection s of
              ProjectOp ->
                ConfirmProjectDelete . view projNameL . fst <$> getCurrentLocation s
              LocationOp -> do
                (p, Just l) <- getCurrentLocation s
                return $ ConfirmLocationDelete (p ^. projNameL) (l ^. locationL)
              NoteOp -> do (p, mbl) <- getCurrentLocation s
                           l <- mbl
                           n <- getCurrentNote s l
                           let c = ConfirmNoteDelete (p ^. projNameL)
                                   (l ^. locationL)
                                   (noteTitle n)
                           if canEditNote n
                             then Just c
                             else Nothing
      case cnf of
        Just cmsg -> put $ s & onPane @Confirm %~ showConfirmation cmsg
                             & focusRingUpdate myWorkFocusL
        Nothing -> return ()

  -- Otherwise, allow the Panes in the Panel to handle the event.  The wrappers
  -- handle updates for any inter-state transitions.
  ev -> eventToPanel ev

  where
    eventToPanel ev = do
      resetMessages
      s <- get
      (t,s') <- handleFocusAndPanelEvents myWorkFocusL s ev
      put s'
      when (exitedModal @FileMgrPane t s') $
             let fmn = Just $ (panelState @FileMgrPane s') ^. fileMgrNotices
             in modify
                (   (onPane @FileMgrPane . fileMgrNotices .~ mempty)
                  . (onPane @MessagesPane %~ updatePane fmn)
                )
      let postop = do handleConfirmation
                      handleNewProject
                      handleProjectChanges
                      mbprj <- handleProjectChange
                      mbprj' <- handleLocationInput mbprj
                      mbloc <- handleLocationChange mbprj'
                      handleNoteInput mbprj' mbloc
      refocus <- execWriterT $ runReaderT postop t
      when (or refocus) $ modify $ focusRingUpdate myWorkFocusL


addLocation :: MyWorkState -> EventM WName MyWorkState ()
addLocation s =
  case getCurrentProject s of
    Just p ->
      let n = p ^. projNameL
          ls = p ^. locationsL
      in put $ s
         & onPane @LocationInputPane %~ initLocInput n ls Nothing
         & focusRingUpdate myWorkFocusL
    _ -> return ()


addNote :: MyWorkState -> EventM WName MyWorkState ()
addNote s =
  case getCurrentLocation s of
    Just (_, Just l) -> do
      s' <- s & onPane @NoteInputPane %%~ initNoteInput (l ^. notesL) Nothing
      put $ s' & focusRingUpdate myWorkFocusL
    _ -> return ()


resetMessages :: EventM WName MyWorkState ()
resetMessages = modify $ onPane @MessagesPane %~ updatePane Nothing


type PostOpM a = ReaderT PanelTransition (WriterT [Bool] (EventM WName MyWorkState)) a

handleConfirmation :: PostOpM ()
handleConfirmation = do
  let confirmOp :: (PaneState Confirm MyWorkEvent -> a) -> PostOpM a
      confirmOp o = gets (view $ onPane @Confirm . to o)
  transition <- ask
  deactivatedConfirmation <- gets (exitedModal @Confirm transition)
  when deactivatedConfirmation $
    do (ps, confirmed) <- confirmOp getConfirmedAction
       modify $ onPane @Confirm .~ ps
       let toFM :: FileMgrOps -> PostOpM ()
           toFM msg = do modify (onPane @FileMgrPane %~ updatePane msg)
                         tell [True]
       case confirmed of
         Nothing -> return ()
         Just (ConfirmProjectDelete pname) -> toFM $ DelProject pname
         Just (ConfirmLocationDelete pname l) ->
           do toFM $ DelLocation pname l
              p <- gets getCurrentProject -- updated by DelLocation above
              modify (onPane @Location %~ updatePane p)
         Just (ConfirmNoteDelete pname locn nt) ->
           do toFM $ DelNote pname locn nt
              cl <- gets getCurrentLocation -- updated by DelNote
              let mbl = do (_,mbl') <- cl
                           mbl'
              modify (onPane @Note %~ updatePane mbl)
         Just (ConfirmLoad fp) -> do
           s <- get
           s' <- s & onPane @FileMgrPane %%~ fileMgrReadProjectsFile fp
           put s'
         Just ConfirmQuit -> lift $ lift halt

handleNewProject :: PostOpM ()
handleNewProject = do
  let inpOp :: (PaneState AddProjPane MyWorkEvent -> a) -> PostOpM a
      inpOp o = gets (view $ onPane @AddProjPane . to o)
  transition <- ask
  changed <- gets (exitedModal @AddProjPane transition)
  when changed $ do
    (mbOld, mbNewProj) <- inpOp projectInputResults
    case mbNewProj of
         Just newProj ->
           modify $ onPane @FileMgrPane %~ updatePane (UpdProject mbOld newProj)
         Nothing -> return ()

handleProjectChanges :: PostOpM ()
handleProjectChanges = lift $ do
  (changed,prjs) <- gets getProjects
  case changed of
    Left cnfrm -> do modify $ \s ->
                       if not $ s ^. onPane @Confirm . to isConfirmationActive
                       then s
                            & onPane @Confirm %~ showConfirmation cnfrm
                            & onPane @FileMgrPane %~ updatePane AckProjectChanges
                            & focusRingUpdate myWorkFocusL
                       else s
    Right True ->
      modify (   (onPane @Projects %~ updatePane prjs)
               . (onPane @FileMgrPane %~ updatePane AckProjectChanges)
             )
    Right False -> return ()


handleProjectChange :: PostOpM (Maybe Project)
handleProjectChange = do
  mbp <- gets getCurrentProject -- from ProjList pane
  pnm <- gets (fmap fst . selectedLocation) -- from Location pane
  let mustUpdate = pnm /= (view projNameL <$> mbp)
  when mustUpdate $ do modify $ onPane @Location %~ updatePane mbp
                       tell [True]
  return mbp

handleLocationInput :: Maybe Project -> PostOpM (Maybe Project)
handleLocationInput mbPrj = do
  let inpOp :: (PaneState LocationInputPane MyWorkEvent -> a) -> PostOpM a
      inpOp o = lift $ gets (view $ onPane @LocationInputPane . to o)
  transition <- ask
  changed <- gets (exitedModal @LocationInputPane transition)
  if changed
    then do (mbOldL, mbNewLoc) <- inpOp locationInputResults
            case (mbNewLoc, mbPrj) of
              (Just newLoc, Just p) -> do
                p' <- evalStateT (applyProjLocSync mbOldL p newLoc) mempty
                let u = UpdProject Nothing p'
                modify (   (onPane @FileMgrPane %~ updatePane u)
                         . (onPane @Location %~ updatePane (Just p'))
                       )
                return $ Just p'
              _ -> return mbPrj
    else return mbPrj


handleLocationChange :: Maybe Project -> PostOpM (Maybe Location)
handleLocationChange mbp = do
  locSel <- gets (fmap snd . selectedLocation)
  let mbl = do p <- mbp
               DL.find ((== locSel) . Just . view locationL) (p ^. locationsL)
  modify $ onPane @Note %~ updatePane mbl
  return mbl
-- handleLocationChange = \case
--   Nothing -> return Nothing
--   Just p -> do
--     loc0 <- gets (fmap snd . selectedLocation) -- Location pane
--     loc1 <- gets (fmap fst . selectedNote) -- Notes pane
--     let mbl = DL.find ((== loc0) . Just . view locationL) (p ^. locationsL)
--     unless (loc0 == loc1) $ do modify $ onPane @Note %~ updatePane mbl
--                                tell [True]
--     return mbl

handleNoteInput :: Maybe Project -> Maybe Location -> PostOpM ()
handleNoteInput mbPrj mbLoc = do
  let inpOp :: (PaneState NoteInputPane MyWorkEvent -> a) -> PostOpM a
      inpOp o = lift $ gets (view $ onPane @NoteInputPane . to o)
  transition <- ask
  changed <- gets (exitedModal @NoteInputPane transition)
  when changed $
    do (mbOldN, mbNewNote) <- inpOp noteInputResults
       case (mbNewNote, mbPrj, mbLoc) of
         (Just newNote, Just p, Just l) ->
           let (p',l') = updateNote mbOldN newNote l p
               u = UpdProject Nothing p'
           in do modify ( (onPane @FileMgrPane %~ updatePane u)
                          . (onPane @Note %~ updatePane (Just l'))
                        )
         _ -> do return ()