{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE OverloadedRecordDot #-}

module Ghcitui.Brick.Events (handleEvent, handleCursorPosition) where

import qualified Brick.Main as B
import qualified Brick.Types as B
import Control.Monad.IO.Class (MonadIO (..))
import qualified Data.Text as T
import qualified Graphics.Vty as V
import Lens.Micro ((^.))
import qualified Lens.Micro as Lens

import Ghcitui.Brick.AppState as AppState
import Ghcitui.Brick.AppTopLevel
    ( AppName (..)
    , CustomAppEvent (..)
    )
import Ghcitui.Brick.EventUtils (invalidateLineCache)
import qualified Ghcitui.Brick.InterpWindowEvents as InterpWindowEvents
import qualified Ghcitui.Brick.SourceWindow as SourceWindow
import qualified Ghcitui.Brick.SourceWindowEvents as SourceWindowEvents
import qualified Ghcitui.Ghcid.Daemon as Daemon

-- | Handle any Brick event and update the state.
handleEvent
    :: B.BrickEvent AppName (CustomAppEvent (AppState AppName))
    -- ^ Event to handle.
    -> B.EventM AppName (AppState AppName) ()
handleEvent :: BrickEvent AppName (CustomAppEvent (AppState AppName))
-> EventM AppName (AppState AppName) ()
handleEvent (B.VtyEvent (V.EvResize Int
_ Int
_)) = EventM AppName (AppState AppName) ()
forall n s. Ord n => EventM n s ()
B.invalidateCache
handleEvent (B.VtyEvent (V.EvKey (V.KChar Char
'c') [Modifier
V.MCtrl])) = do
    -- Handle interrupts right away, regardless of our window.
    AppState AppName
appState <- EventM AppName (AppState AppName) (AppState AppName)
forall s (m :: * -> *). MonadState s m => m s
B.get
    IO () -> EventM AppName (AppState AppName) ()
forall a. IO a -> EventM AppName (AppState AppName) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM AppName (AppState AppName) ())
-> (AppState AppName -> IO ())
-> AppState AppName
-> EventM AppName (AppState AppName) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterpState () -> IO ()
forall a. InterpState a -> IO ()
Daemon.interruptDaemon (InterpState () -> IO ())
-> (AppState AppName -> InterpState ())
-> AppState AppName
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState AppName -> InterpState ()
forall n. AppState n -> InterpState ()
AppState.interpState (AppState AppName -> EventM AppName (AppState AppName) ())
-> AppState AppName -> EventM AppName (AppState AppName) ()
forall a b. (a -> b) -> a -> b
$ AppState AppName
appState
    -- Invalidate everything.
    EventM AppName (AppState AppName) ()
forall n s. Ord n => EventM n s ()
B.invalidateCache
handleEvent (B.AppEvent (ErrorOnCb AppState AppName
appState Text
msg)) =
    -- Handle errors cleanly and crash out.
    AppState AppName -> EventM AppName (AppState AppName) ()
forall n s. AppState n -> EventM n s ()
quit AppState AppName
appState EventM AppName (AppState AppName) ()
-> EventM AppName (AppState AppName) ()
-> EventM AppName (AppState AppName) ()
forall a b.
EventM AppName (AppState AppName) a
-> EventM AppName (AppState AppName) b
-> EventM AppName (AppState AppName) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> EventM AppName (AppState AppName) ()
forall a. HasCallStack => [Char] -> a
error (Text -> [Char]
T.unpack Text
msg)
handleEvent (B.AppEvent CustomAppEvent (AppState AppName)
ev) = do
    CustomAppEvent (AppState AppName)
-> EventM AppName (AppState AppName) ()
SourceWindowEvents.handleSourceWindowPostCb CustomAppEvent (AppState AppName)
ev
    CustomAppEvent (AppState AppName)
-> EventM AppName (AppState AppName) ()
InterpWindowEvents.handleInterpWindowPostCb CustomAppEvent (AppState AppName)
ev
handleEvent BrickEvent AppName (CustomAppEvent (AppState AppName))
ev = do
    AppState AppName
appState <- EventM AppName (AppState AppName) (AppState AppName)
forall s (m :: * -> *). MonadState s m => m s
B.get
    SourceWindow AppName Text
updatedSourceWindow <- SourceWindow AppName Text
-> EventM AppName (AppState AppName) (SourceWindow AppName Text)
forall n e m.
Ord n =>
SourceWindow n e -> EventM n m (SourceWindow n e)
SourceWindow.updateVerticalSpace (AppState AppName
appState AppState AppName
-> Getting
     (SourceWindow AppName Text)
     (AppState AppName)
     (SourceWindow AppName Text)
-> SourceWindow AppName Text
forall s a. s -> Getting a s a -> a
^. Getting
  (SourceWindow AppName Text)
  (AppState AppName)
  (SourceWindow AppName Text)
forall n (f :: * -> *).
Functor f =>
(SourceWindow n Text -> f (SourceWindow n Text))
-> AppState n -> f (AppState n)
AppState.sourceWindow)
    let appStateUpdated :: AppState AppName
appStateUpdated = ASetter
  (AppState AppName)
  (AppState AppName)
  (SourceWindow AppName Text)
  (SourceWindow AppName Text)
-> SourceWindow AppName Text
-> AppState AppName
-> AppState AppName
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter
  (AppState AppName)
  (AppState AppName)
  (SourceWindow AppName Text)
  (SourceWindow AppName Text)
forall n (f :: * -> *).
Functor f =>
(SourceWindow n Text -> f (SourceWindow n Text))
-> AppState n -> f (AppState n)
AppState.sourceWindow SourceWindow AppName Text
updatedSourceWindow AppState AppName
appState
    AppState AppName -> EventM AppName (AppState AppName) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
B.put AppState AppName
appStateUpdated
    let handler :: B.BrickEvent AppName e -> B.EventM AppName (AppState AppName) ()
        handler :: forall e.
BrickEvent AppName e -> EventM AppName (AppState AppName) ()
handler = case AppState AppName
appStateUpdated.activeWindow of
            ActiveWindow
AppState.ActiveCodeViewport -> BrickEvent AppName e -> EventM AppName (AppState AppName) ()
forall e.
BrickEvent AppName e -> EventM AppName (AppState AppName) ()
SourceWindowEvents.handleSrcWindowEvent
            ActiveWindow
AppState.ActiveLiveInterpreter -> BrickEvent AppName e -> EventM AppName (AppState AppName) ()
forall e.
BrickEvent AppName e -> EventM AppName (AppState AppName) ()
InterpWindowEvents.handleInterpreterEvent
            ActiveWindow
AppState.ActiveInfoWindow -> BrickEvent AppName e -> EventM AppName (AppState AppName) ()
forall e.
BrickEvent AppName e -> EventM AppName (AppState AppName) ()
handleInfoEvent
            ActiveWindow
AppState.ActiveDialogQuit -> BrickEvent AppName e -> EventM AppName (AppState AppName) ()
forall e.
BrickEvent AppName e -> EventM AppName (AppState AppName) ()
handleDialogQuit
            ActiveWindow
AppState.ActiveDialogHelp -> BrickEvent AppName e -> EventM AppName (AppState AppName) ()
forall e.
BrickEvent AppName e -> EventM AppName (AppState AppName) ()
handleDialogHelp
    BrickEvent AppName (CustomAppEvent (AppState AppName))
-> EventM AppName (AppState AppName) ()
forall e.
BrickEvent AppName e -> EventM AppName (AppState AppName) ()
handler BrickEvent AppName (CustomAppEvent (AppState AppName))
ev

-- -------------------------------------------------------------------------------------------------
-- Info Event Handling
-- -------------------------------------------------------------------------------------------------

handleInfoEvent :: B.BrickEvent AppName e -> B.EventM AppName (AppState AppName) ()
handleInfoEvent :: forall e.
BrickEvent AppName e -> EventM AppName (AppState AppName) ()
handleInfoEvent BrickEvent AppName e
ev = do
    AppState AppName
appState <- EventM AppName (AppState AppName) (AppState AppName)
forall s (m :: * -> *). MonadState s m => m s
B.get
    case BrickEvent AppName e
ev of
        B.VtyEvent (V.EvKey Key
key [Modifier]
_ms)
            | Key
key Key -> [Key] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char -> Key
V.KChar Char
'j', Key
V.KDown] -> do
                AppState AppName -> EventM AppName (AppState AppName) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
B.put (AppState AppName -> EventM AppName (AppState AppName) ())
-> AppState AppName -> EventM AppName (AppState AppName) ()
forall a b. (a -> b) -> a -> b
$ Int -> AppState AppName -> AppState AppName
forall n. Int -> AppState n -> AppState n
AppState.changeSelectedModuleInInfoPanel Int
1 AppState AppName
appState
            | Key
key Key -> [Key] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char -> Key
V.KChar Char
'k', Key
V.KUp] -> do
                AppState AppName -> EventM AppName (AppState AppName) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
B.put (AppState AppName -> EventM AppName (AppState AppName) ())
-> AppState AppName -> EventM AppName (AppState AppName) ()
forall a b. (a -> b) -> a -> b
$ Int -> AppState AppName -> AppState AppName
forall n. Int -> AppState n -> AppState n
AppState.changeSelectedModuleInInfoPanel (-Int
1) AppState AppName
appState
            | Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
V.KEnter Bool -> Bool -> Bool
|| Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Key
V.KChar Char
'o' -> do
                let mayFp :: Maybe [Char]
mayFp = AppState AppName -> Maybe [Char]
forall n. AppState n -> Maybe [Char]
AppState.filePathOfInfoSelectedModule AppState AppName
appState
                case Maybe [Char]
mayFp of
                    Just [Char]
_ -> do
                        AppState AppName
updatedState <- IO (AppState AppName)
-> EventM AppName (AppState AppName) (AppState AppName)
forall a. IO a -> EventM AppName (AppState AppName) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (AppState AppName)
 -> EventM AppName (AppState AppName) (AppState AppName))
-> IO (AppState AppName)
-> EventM AppName (AppState AppName) (AppState AppName)
forall a b. (a -> b) -> a -> b
$ Maybe [Char] -> AppState AppName -> IO (AppState AppName)
forall (m :: * -> *) n.
MonadIO m =>
Maybe [Char] -> AppState n -> m (AppState n)
AppState.setSelectedFile Maybe [Char]
mayFp AppState AppName
appState
                        AppState AppName -> EventM AppName (AppState AppName) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
B.put AppState AppName
updatedState
                        EventM AppName (AppState AppName) ()
forall n (state :: * -> *). Ord n => EventM n (state n) ()
invalidateLineCache
                    Maybe [Char]
Nothing -> () -> EventM AppName (AppState AppName) ()
forall a. a -> EventM AppName (AppState AppName) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            | Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
V.KEsc Bool -> Bool -> Bool
|| Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Key
V.KChar Char
'C' -> do
                AppState AppName -> EventM AppName (AppState AppName) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
B.put AppState AppName
appState{activeWindow = AppState.ActiveCodeViewport}
        B.VtyEvent (V.EvKey (V.KChar Char
'x') [Modifier
V.MCtrl]) -> do
            AppState AppName -> EventM AppName (AppState AppName) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
B.put AppState AppName
appState{activeWindow = AppState.ActiveLiveInterpreter}
        B.VtyEvent (V.EvKey (V.KChar Char
'?') [Modifier]
_) -> do
            AppState AppName -> EventM AppName (AppState AppName) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
B.put AppState AppName
appState{activeWindow = AppState.ActiveDialogHelp}

        -- Resizing
        B.VtyEvent (V.EvKey (V.KChar Char
'-') []) -> do
            AppState AppName -> EventM AppName (AppState AppName) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
B.put (Int -> AppState AppName -> AppState AppName
forall n. Int -> AppState n -> AppState n
AppState.changeInfoWidgetSize (-Int
1) AppState AppName
appState)
            EventM AppName (AppState AppName) ()
forall n (state :: * -> *). Ord n => EventM n (state n) ()
invalidateLineCache
        B.VtyEvent (V.EvKey (V.KChar Char
'+') []) -> do
            AppState AppName -> EventM AppName (AppState AppName) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
B.put (Int -> AppState AppName -> AppState AppName
forall n. Int -> AppState n -> AppState n
AppState.changeInfoWidgetSize Int
1 AppState AppName
appState)
            EventM AppName (AppState AppName) ()
forall n (state :: * -> *). Ord n => EventM n (state n) ()
invalidateLineCache
        BrickEvent AppName e
_ -> () -> EventM AppName (AppState AppName) ()
forall a. a -> EventM AppName (AppState AppName) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    AppName -> EventM AppName (AppState AppName) ()
forall n s. Ord n => n -> EventM n s ()
B.invalidateCacheEntry AppName
ModulesViewport

-- -------------------------------------------------------------------------------------------------
-- Dialog boxes
-- -------------------------------------------------------------------------------------------------

handleDialogQuit :: B.BrickEvent AppName e -> B.EventM AppName (AppState AppName) ()
handleDialogQuit :: forall e.
BrickEvent AppName e -> EventM AppName (AppState AppName) ()
handleDialogQuit BrickEvent AppName e
ev = do
    AppState AppName
appState <- EventM AppName (AppState AppName) (AppState AppName)
forall s (m :: * -> *). MonadState s m => m s
B.get
    case BrickEvent AppName e
ev of
        (B.VtyEvent (V.EvKey Key
key [Modifier]
_))
            | Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Key
V.KChar Char
'q' Bool -> Bool -> Bool
|| Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
V.KEsc -> do
                AppState AppName -> EventM AppName (AppState AppName) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
B.put (AppState AppName -> EventM AppName (AppState AppName) ())
-> AppState AppName -> EventM AppName (AppState AppName) ()
forall a b. (a -> b) -> a -> b
$ AppState AppName
appState{activeWindow = AppState.ActiveCodeViewport}
            | Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
V.KEnter -> AppState AppName -> EventM AppName (AppState AppName) ()
forall n s. AppState n -> EventM n s ()
quit AppState AppName
appState
        BrickEvent AppName e
_ -> () -> EventM AppName (AppState AppName) ()
forall a. a -> EventM AppName (AppState AppName) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    () -> EventM AppName (AppState AppName) ()
forall a. a -> EventM AppName (AppState AppName) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

handleDialogHelp :: B.BrickEvent AppName e -> B.EventM AppName (AppState AppName) ()
handleDialogHelp :: forall e.
BrickEvent AppName e -> EventM AppName (AppState AppName) ()
handleDialogHelp (B.VtyEvent (V.EvKey Key
key [Modifier]
_))
    | Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Key
V.KChar Char
'q' Bool -> Bool -> Bool
|| Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
V.KEsc Bool -> Bool -> Bool
|| Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
V.KEnter = do
        AppState AppName
appState <- EventM AppName (AppState AppName) (AppState AppName)
forall s (m :: * -> *). MonadState s m => m s
B.get
        AppState AppName -> EventM AppName (AppState AppName) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
B.put (AppState AppName -> EventM AppName (AppState AppName) ())
-> AppState AppName -> EventM AppName (AppState AppName) ()
forall a b. (a -> b) -> a -> b
$ AppState AppName
appState{activeWindow = AppState.ActiveCodeViewport}
    | Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
V.KPageDown = ViewportScroll AppName
-> forall s. Direction -> EventM AppName s ()
forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
B.vScrollPage ViewportScroll AppName
scroller Direction
B.Down
    | Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
V.KPageUp = ViewportScroll AppName
-> forall s. Direction -> EventM AppName s ()
forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
B.vScrollPage ViewportScroll AppName
scroller Direction
B.Up
    | Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
V.KDown = ViewportScroll AppName -> forall s. Int -> EventM AppName s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
B.vScrollBy ViewportScroll AppName
scroller Int
1
    | Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
V.KUp = ViewportScroll AppName -> forall s. Int -> EventM AppName s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
B.vScrollBy ViewportScroll AppName
scroller (-Int
1)
    | Bool
otherwise = () -> EventM AppName (AppState AppName) ()
forall a. a -> EventM AppName (AppState AppName) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
    scroller :: ViewportScroll AppName
scroller = AppName -> ViewportScroll AppName
forall n. n -> ViewportScroll n
B.viewportScroll AppName
HelpViewport
handleDialogHelp BrickEvent AppName e
_ = () -> EventM AppName (AppState AppName) ()
forall a. a -> EventM AppName (AppState AppName) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Stop the TUI.
quit :: AppState n -> B.EventM n s ()
quit :: forall n s. AppState n -> EventM n s ()
quit AppState n
appState = IO (InterpState ()) -> EventM n s (InterpState ())
forall a. IO a -> EventM n s a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (InterpState () -> IO (InterpState ())
forall a. InterpState a -> IO (InterpState a)
Daemon.quit AppState n
appState.interpState) EventM n s (InterpState ()) -> EventM n s () -> EventM n s ()
forall a b. EventM n s a -> EventM n s b -> EventM n s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EventM n s ()
forall n s. EventM n s ()
B.halt

-- -------------------------------------------------------------------------------------------------
-- Handle Cursor Position
-- -------------------------------------------------------------------------------------------------

-- | Determine whether to show the cursor.
handleCursorPosition
    :: AppState AppName
    -- ^ State of the app.
    -> [B.CursorLocation AppName]
    -- ^ Potential Locs
    -> Maybe (B.CursorLocation AppName)
    -- ^ The chosen cursor location if any.
handleCursorPosition :: AppState AppName
-> [CursorLocation AppName] -> Maybe (CursorLocation AppName)
handleCursorPosition AppState AppName
s [CursorLocation AppName]
ls =
    if AppState AppName
s.activeWindow ActiveWindow -> ActiveWindow -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveWindow
AppState.ActiveLiveInterpreter
        then -- If we're in the interpreter window, show the cursor.
            AppName
-> [CursorLocation AppName] -> Maybe (CursorLocation AppName)
forall n.
Eq n =>
n -> [CursorLocation n] -> Maybe (CursorLocation n)
B.showCursorNamed AppName
widgetName [CursorLocation AppName]
ls
        else -- No cursor
            Maybe (CursorLocation AppName)
forall a. Maybe a
Nothing
  where
    widgetName :: AppName
widgetName = AppName
LiveInterpreter