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

module Ghcitui.Brick.SourceWindowEvents (handleSrcWindowEvent, handleSourceWindowPostCb) where

import qualified Brick.Main as B
import qualified Brick.Types as B
import Control.Error (fromMaybe, note)
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 qualified Brick.BChan as B
import Ghcitui.Brick.AppState as AppState
import Ghcitui.Brick.AppTopLevel
    ( AppName (..)
    , CustomAppEvent (..)
    )
import Ghcitui.Brick.EventUtils
import qualified Ghcitui.Brick.SourceWindow as SourceWindow
import qualified Ghcitui.Ghcid.Daemon as Daemon
import qualified Ghcitui.Loc as Loc
import Ghcitui.Util (showT)

-- -------------------------------------------------------------------------------------------------
-- Code Viewport Event Handling
-- -------------------------------------------------------------------------------------------------

-- TODO: Handle mouse events?
handleSrcWindowEvent :: B.BrickEvent AppName e -> B.EventM AppName (AppState AppName) ()
handleSrcWindowEvent :: forall e.
BrickEvent AppName e -> EventM AppName (AppState AppName) ()
handleSrcWindowEvent (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
'q', Key
V.KEsc] = do
        EventM AppName (AppState AppName) ()
confirmQuit

    -- GHCi Blocking Events.
    | Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Key
V.KChar Char
's' = do
        appState :: AppState AppName
appState@AppState.AppState{InterpState ()
interpState :: InterpState ()
$sel:interpState:AppState :: forall n. AppState n -> InterpState ()
AppState.interpState} <- EventM AppName (AppState AppName) (AppState AppName)
forall s (m :: * -> *). MonadState s m => m s
B.get
        let callback :: Either DaemonError (InterpState ()) -> IO ()
callback = AppState AppName -> Either DaemonError (InterpState ()) -> IO ()
forall n.
AppState n -> Either DaemonError (InterpState ()) -> IO ()
stepCb AppState AppName
appState
        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) ())
-> IO () -> EventM AppName (AppState AppName) ()
forall a b. (a -> b) -> a -> b
$ InterpState ()
-> DaemonIO (InterpState ())
-> (Either DaemonError (InterpState ()) -> IO ())
-> IO ()
forall a r.
InterpState a
-> DaemonIO r -> (Either DaemonError r -> IO ()) -> IO ()
Daemon.scheduleWithCb InterpState ()
interpState (InterpState () -> DaemonIO (InterpState ())
forall a.
Monoid a =>
InterpState a -> ExceptT DaemonError IO (InterpState a)
Daemon.step InterpState ()
interpState) Either DaemonError (InterpState ()) -> IO ()
callback
    | Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Key
V.KChar Char
'c' = do
        appState :: AppState AppName
appState@AppState.AppState{InterpState ()
$sel:interpState:AppState :: forall n. AppState n -> InterpState ()
interpState :: InterpState ()
AppState.interpState} <- EventM AppName (AppState AppName) (AppState AppName)
forall s (m :: * -> *). MonadState s m => m s
B.get
        let callback :: Either DaemonError (InterpState ()) -> IO ()
callback = AppState AppName -> Either DaemonError (InterpState ()) -> IO ()
forall n.
AppState n -> Either DaemonError (InterpState ()) -> IO ()
stepCb AppState AppName
appState
        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) ())
-> IO () -> EventM AppName (AppState AppName) ()
forall a b. (a -> b) -> a -> b
$ InterpState ()
-> DaemonIO (InterpState ())
-> (Either DaemonError (InterpState ()) -> IO ())
-> IO ()
forall a r.
InterpState a
-> DaemonIO r -> (Either DaemonError r -> IO ()) -> IO ()
Daemon.scheduleWithCb InterpState ()
interpState (InterpState () -> DaemonIO (InterpState ())
forall a.
Monoid a =>
InterpState a -> ExceptT DaemonError IO (InterpState a)
Daemon.step InterpState ()
interpState) Either DaemonError (InterpState ()) -> IO ()
callback
    | Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Key
V.KChar Char
't' = do
        appState :: AppState AppName
appState@AppState.AppState{InterpState ()
$sel:interpState:AppState :: forall n. AppState n -> InterpState ()
interpState :: InterpState ()
AppState.interpState} <- EventM AppName (AppState AppName) (AppState AppName)
forall s (m :: * -> *). MonadState s m => m s
B.get
        let callback :: Either DaemonError (InterpState ()) -> IO ()
callback = AppState AppName -> Either DaemonError (InterpState ()) -> IO ()
forall n.
AppState n -> Either DaemonError (InterpState ()) -> IO ()
stepCb AppState AppName
appState
        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) ())
-> IO () -> EventM AppName (AppState AppName) ()
forall a b. (a -> b) -> a -> b
$ InterpState ()
-> DaemonIO (InterpState ())
-> (Either DaemonError (InterpState ()) -> IO ())
-> IO ()
forall a r.
InterpState a
-> DaemonIO r -> (Either DaemonError r -> IO ()) -> IO ()
Daemon.scheduleWithCb InterpState ()
interpState (InterpState () -> DaemonIO (InterpState ())
forall a.
Monoid a =>
InterpState a -> ExceptT DaemonError IO (InterpState a)
Daemon.trace InterpState ()
interpState) Either DaemonError (InterpState ()) -> IO ()
callback
    | Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Key
V.KChar Char
'b' = 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) ()
insertBreakpoint AppState AppName
appState

    -- j and k are the vim navigation keybindings.
    | Key
key Key -> [Key] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key
V.KDown, Char -> Key
V.KChar Char
'j'] = do
        Int -> EventM AppName (AppState AppName) ()
moveSelectedLineby Int
1
    | Key
key Key -> [Key] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key
V.KUp, Char -> Key
V.KChar Char
'k'] = do
        Int -> EventM AppName (AppState AppName) ()
moveSelectedLineby (-Int
1)
    | Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
V.KPageDown = do
        ScrollDir -> EventM AppName (AppState AppName) ()
scrollPage ScrollDir
SourceWindow.Down
    | Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
V.KPageUp = do
        ScrollDir -> EventM AppName (AppState AppName) ()
scrollPage ScrollDir
SourceWindow.Up

    -- '+' and '-' move the middle border.
    | Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Key
V.KChar Char
'+' Bool -> Bool -> Bool
&& [Modifier] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Modifier]
ms = 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 (Int -> AppState AppName -> AppState AppName
forall n. Int -> AppState n -> AppState n
AppState.changeInfoWidgetSize (-Int
1) AppState AppName
appState)
        AppName -> EventM AppName (AppState AppName) ()
forall n s. Ord n => n -> EventM n s ()
B.invalidateCacheEntry AppName
ModulesViewport
        EventM AppName (AppState AppName) ()
forall n (state :: * -> *). Ord n => EventM n (state n) ()
invalidateLineCache
    | Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Key
V.KChar Char
'-' Bool -> Bool -> Bool
&& [Modifier] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Modifier]
ms = 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 (Int -> AppState AppName -> AppState AppName
forall n. Int -> AppState n -> AppState n
AppState.changeInfoWidgetSize Int
1 AppState AppName
appState)
        AppName -> EventM AppName (AppState AppName) ()
forall n s. Ord n => n -> EventM n s ()
B.invalidateCacheEntry AppName
ModulesViewport
        EventM AppName (AppState AppName) ()
forall n (state :: * -> *). Ord n => EventM n (state n) ()
invalidateLineCache
    | Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Key
V.KChar Char
'x' Bool -> Bool -> Bool
&& [Modifier]
ms [Modifier] -> [Modifier] -> Bool
forall a. Eq a => a -> a -> Bool
== [Modifier
V.MCtrl] =
        AppState AppName -> EventM AppName (AppState AppName) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
B.put (AppState AppName -> EventM AppName (AppState AppName) ())
-> (AppState AppName -> AppState AppName)
-> AppState AppName
-> EventM AppName (AppState AppName) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState AppName -> AppState AppName
forall n. AppState n -> AppState n
toggleActiveLineInterpreter (AppState AppName -> EventM AppName (AppState AppName) ())
-> EventM AppName (AppState AppName) (AppState AppName)
-> EventM AppName (AppState AppName) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< EventM AppName (AppState AppName) (AppState AppName)
forall s (m :: * -> *). MonadState s m => m s
B.get
    | Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Key
V.KChar Char
'M' = 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
appState{activeWindow = AppState.ActiveInfoWindow}
        AppName -> EventM AppName (AppState AppName) ()
forall n s. Ord n => n -> EventM n s ()
B.invalidateCacheEntry AppName
ModulesViewport
    | Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Key
V.KChar Char
'?' = (AppState AppName -> AppState AppName)
-> EventM AppName (AppState AppName) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
B.modify (\AppState AppName
state -> AppState AppName
state{activeWindow = AppState.ActiveDialogHelp})
handleSrcWindowEvent BrickEvent AppName e
_ = () -> EventM AppName (AppState AppName) ()
forall a. a -> EventM AppName (AppState AppName) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

{- | Redraw Step Callback. Called asynchronously after the 'DaemonIO' resolves
     for 'step' and similar.
-}
stepCb
    :: AppState n
    -- ^ 'AppState' to use for asynchronous channel communication.
    -> Either Daemon.DaemonError (Daemon.InterpState ())
    -- ^ The incoming response from the Daemon for the 'step' (or similar) operation.
    -> IO ()
    -- ^ IO used to write to the event bounded channel.
stepCb :: forall n.
AppState n -> Either DaemonError (InterpState ()) -> IO ()
stepCb AppState n
appState (Right InterpState ()
interpState) =
    BChan (CustomAppEvent (AppState n))
-> CustomAppEvent (AppState n) -> IO ()
forall a. BChan a -> a -> IO ()
B.writeBChan (AppState n -> BChan (CustomAppEvent (AppState n))
forall n. AppState n -> BChan (CustomAppEvent (AppState n))
AppState.eventChannel AppState n
appState) (AppState n -> CustomAppEvent (AppState n)
forall state. state -> CustomAppEvent state
StepCb AppState n
appState{interpState})
stepCb AppState n
appState (Left DaemonError
msg) =
    BChan (CustomAppEvent (AppState n))
-> CustomAppEvent (AppState n) -> IO ()
forall a. BChan a -> a -> IO ()
B.writeBChan (AppState n -> BChan (CustomAppEvent (AppState n))
forall n. AppState n -> BChan (CustomAppEvent (AppState n))
AppState.eventChannel AppState n
appState) (AppState n -> Text -> CustomAppEvent (AppState n)
forall state. state -> Text -> CustomAppEvent state
ErrorOnCb AppState n
appState (DaemonError -> Text
forall a. Show a => a -> Text
showT DaemonError
msg))

breakpointCb
    :: Loc.ModuleLoc
    -> AppState n
    -> Either Daemon.DaemonError (Daemon.InterpState ())
    -> IO ()
breakpointCb :: forall n.
ModuleLoc
-> AppState n -> Either DaemonError (InterpState ()) -> IO ()
breakpointCb ModuleLoc
moduleLoc AppState n
appState (Right InterpState ()
interpState) =
    BChan (CustomAppEvent (AppState n))
-> CustomAppEvent (AppState n) -> IO ()
forall a. BChan a -> a -> IO ()
B.writeBChan
        (AppState n -> BChan (CustomAppEvent (AppState n))
forall n. AppState n -> BChan (CustomAppEvent (AppState n))
AppState.eventChannel AppState n
appState)
        (AppState n -> ModuleLoc -> CustomAppEvent (AppState n)
forall state. state -> ModuleLoc -> CustomAppEvent state
BreakpointCb AppState n
appState{interpState} ModuleLoc
moduleLoc)
breakpointCb ModuleLoc
_ AppState n
appState (Left DaemonError
msg) =
    BChan (CustomAppEvent (AppState n))
-> CustomAppEvent (AppState n) -> IO ()
forall a. BChan a -> a -> IO ()
B.writeBChan (AppState n -> BChan (CustomAppEvent (AppState n))
forall n. AppState n -> BChan (CustomAppEvent (AppState n))
AppState.eventChannel AppState n
appState) (AppState n -> Text -> CustomAppEvent (AppState n)
forall state. state -> Text -> CustomAppEvent state
ErrorOnCb AppState n
appState (DaemonError -> Text
forall a. Show a => a -> Text
showT DaemonError
msg))

-- | Synchronous code to update the state after a SourceWindowEvent callback.
handleSourceWindowPostCb
    :: CustomAppEvent (AppState AppName) -> B.EventM AppName (AppState AppName) ()
handleSourceWindowPostCb :: CustomAppEvent (AppState AppName)
-> EventM AppName (AppState AppName) ()
handleSourceWindowPostCb (StepCb AppState AppName
appState) = do
    AppState AppName -> EventM AppName (AppState AppName) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
B.put (AppState AppName -> EventM AppName (AppState AppName) ())
-> EventM AppName (AppState AppName) (AppState AppName)
-> EventM AppName (AppState AppName) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AppState AppName
-> EventM AppName (AppState AppName) (AppState AppName)
forall n m. Ord n => AppState n -> EventM n m (AppState n)
AppState.selectPausedLine AppState AppName
appState
    EventM AppName (AppState AppName) ()
forall n (state :: * -> *). Ord n => EventM n (state n) ()
invalidateLineCache
handleSourceWindowPostCb (BreakpointCb AppState AppName
appState ModuleLoc
moduleLoc) = do
    let interpState :: InterpState ()
interpState = AppState AppName -> InterpState ()
forall n. AppState n -> InterpState ()
AppState.interpState AppState AppName
appState
    -- We may need to be smarter about this,
    -- because there's a chance that the module loc 'ml'
    -- doesn't actually refer to this viewed file?
    case SourceRange -> Maybe (Int, ColumnRange)
Loc.singleify (ModuleLoc -> SourceRange
forall a. HasSourceRange a => a -> SourceRange
Loc.sourceRange ModuleLoc
moduleLoc) of
        Just (Int
lineno, ColumnRange
_colrange) ->
            Int -> EventM AppName (AppState AppName) ()
forall s. Int -> EventM AppName s ()
invalidateCachedLine Int
lineno
        Maybe (Int, ColumnRange)
_ ->
            -- If we don't know, just invalidate everything.
            EventM AppName (AppState AppName) ()
forall n (state :: * -> *). Ord n => EventM n (state n) ()
invalidateLineCache
    AppState AppName -> EventM AppName (AppState AppName) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
B.put AppState AppName
appState{interpState}
-- For all other AppEvent types, ignore them. They're handled elsewhere.
handleSourceWindowPostCb CustomAppEvent (AppState AppName)
_ = () -> EventM AppName (AppState AppName) ()
forall a. a -> EventM AppName (AppState AppName) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

moveSelectedLineby :: Int -> B.EventM AppName (AppState AppName) ()
moveSelectedLineby :: Int -> EventM AppName (AppState AppName) ()
moveSelectedLineby Int
movAmnt = do
    AppState AppName
appState <- EventM AppName (AppState AppName) (AppState AppName)
forall s (m :: * -> *). MonadState s m => m s
B.get
    let oldLineno :: Int
oldLineno = AppState AppName -> Int
forall n. AppState n -> Int
AppState.selectedLine AppState AppName
appState
    AppState AppName
movedAppState <- do
        SourceWindow AppName Text
sw <- Int
-> SourceWindow AppName Text
-> EventM AppName (AppState AppName) (SourceWindow AppName Text)
forall n e m.
Ord n =>
Int -> SourceWindow n e -> EventM n m (SourceWindow n e)
SourceWindow.srcWindowMoveSelectionBy Int
movAmnt (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)
        AppState AppName
-> EventM AppName (AppState AppName) (AppState AppName)
forall a. a -> EventM AppName (AppState AppName) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AppState AppName
 -> EventM AppName (AppState AppName) (AppState AppName))
-> AppState AppName
-> EventM AppName (AppState AppName) (AppState AppName)
forall a b. (a -> b) -> a -> b
$ 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
sw AppState AppName
appState
    let newLineno :: Int
newLineno = AppState AppName -> Int
forall n. AppState n -> Int
AppState.selectedLine AppState AppName
movedAppState
    -- These two lines need to be re-rendered.
    Int -> EventM AppName (AppState AppName) ()
forall s. Int -> EventM AppName s ()
invalidateCachedLine Int
oldLineno
    Int -> EventM AppName (AppState AppName) ()
forall s. Int -> EventM AppName s ()
invalidateCachedLine Int
newLineno
    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
$ Text -> AppState AppName -> AppState AppName
forall n. Text -> AppState n -> AppState n
writeDebugLog (Text
"selected line is: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
newLineno) AppState AppName
movedAppState

scrollPage :: SourceWindow.ScrollDir -> B.EventM AppName (AppState AppName) ()
scrollPage :: ScrollDir -> EventM AppName (AppState AppName) ()
scrollPage ScrollDir
dir = 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) ())
-> (SourceWindow AppName Text -> AppState AppName)
-> SourceWindow AppName Text
-> EventM AppName (AppState AppName) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\SourceWindow AppName Text
srcW -> 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
srcW AppState AppName
appState)
        (SourceWindow AppName Text -> EventM AppName (AppState AppName) ())
-> EventM AppName (AppState AppName) (SourceWindow AppName Text)
-> EventM AppName (AppState AppName) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ScrollDir
-> SourceWindow AppName Text
-> EventM AppName (AppState AppName) (SourceWindow AppName Text)
forall n e m.
Ord n =>
ScrollDir -> SourceWindow n e -> EventM n m (SourceWindow n e)
SourceWindow.srcWindowScrollPage ScrollDir
dir (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)
    EventM AppName (AppState AppName) ()
forall n (state :: * -> *). Ord n => EventM n (state n) ()
invalidateLineCache

-- | Open up the quit dialog. See 'quit' for the actual quitting.
confirmQuit :: B.EventM AppName (AppState AppName) ()
confirmQuit :: EventM AppName (AppState AppName) ()
confirmQuit = AppState AppName -> EventM AppName (AppState AppName) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
B.put (AppState AppName -> EventM AppName (AppState AppName) ())
-> (AppState AppName -> AppState AppName)
-> AppState AppName
-> EventM AppName (AppState AppName) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\AppState AppName
s -> AppState AppName
s{activeWindow = AppState.ActiveDialogQuit}) (AppState AppName -> EventM AppName (AppState AppName) ())
-> EventM AppName (AppState AppName) (AppState AppName)
-> EventM AppName (AppState AppName) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< EventM AppName (AppState AppName) (AppState AppName)
forall s (m :: * -> *). MonadState s m => m s
B.get

invalidateCachedLine :: Int -> B.EventM AppName s ()
invalidateCachedLine :: forall s. Int -> EventM AppName s ()
invalidateCachedLine Int
lineno = AppName -> EventM AppName s ()
forall n s. Ord n => n -> EventM n s ()
B.invalidateCacheEntry (Int -> AppName
SourceWindowLine Int
lineno)

insertBreakpoint :: AppState AppName -> B.EventM AppName (AppState AppName) ()
insertBreakpoint :: AppState AppName -> EventM AppName (AppState AppName) ()
insertBreakpoint AppState AppName
appState =
    case AppState AppName -> Either Text ModuleLoc
forall n. AppState n -> Either Text ModuleLoc
selectedModuleLoc AppState AppName
appState of
        Left Text
err -> do
            let selectedFileMsg :: FilePath
selectedFileMsg = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"<unknown>" (AppState AppName -> Maybe FilePath
forall n. AppState n -> Maybe FilePath
selectedFile AppState AppName
appState)
            let errMsg :: FilePath
errMsg =
                    FilePath
"Cannot find module of line: "
                        FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
selectedFileMsg
                        FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
":"
                        FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show (AppState AppName -> Int
forall n. AppState n -> Int
selectedLine AppState AppName
appState)
                        FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
": "
                        FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack Text
err
            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) ())
-> IO () -> EventM AppName (AppState AppName) ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
errMsg
        Right ModuleLoc
ml -> do
            let interpState :: InterpState ()
interpState = AppState AppName -> InterpState ()
forall n. AppState n -> InterpState ()
AppState.interpState AppState AppName
appState
            let daemonOp :: DaemonIO (InterpState ())
daemonOp = BreakpointArg -> InterpState () -> DaemonIO (InterpState ())
forall a.
Monoid a =>
BreakpointArg -> InterpState a -> DaemonIO (InterpState a)
Daemon.toggleBreakpointLine (ModuleLoc -> BreakpointArg
Daemon.ModLoc ModuleLoc
ml) InterpState ()
interpState
            let callback :: Either DaemonError (InterpState ()) -> IO ()
callback = ModuleLoc
-> AppState AppName -> Either DaemonError (InterpState ()) -> IO ()
forall n.
ModuleLoc
-> AppState n -> Either DaemonError (InterpState ()) -> IO ()
breakpointCb ModuleLoc
ml AppState AppName
appState
            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) ())
-> IO () -> EventM AppName (AppState AppName) ()
forall a b. (a -> b) -> a -> b
$
                InterpState ()
-> DaemonIO (InterpState ())
-> (Either DaemonError (InterpState ()) -> IO ())
-> IO ()
forall a r.
InterpState a
-> DaemonIO r -> (Either DaemonError r -> IO ()) -> IO ()
Daemon.scheduleWithCb
                    InterpState ()
interpState
                    DaemonIO (InterpState ())
daemonOp
                    Either DaemonError (InterpState ()) -> IO ()
callback

-- | Get Location that's currently selected.
selectedModuleLoc :: AppState n -> Either T.Text Loc.ModuleLoc
selectedModuleLoc :: forall n. AppState n -> Either Text ModuleLoc
selectedModuleLoc AppState n
s = FileLoc -> Either Text ModuleLoc
eModuleLoc (FileLoc -> Either Text ModuleLoc)
-> Either Text FileLoc -> Either Text ModuleLoc
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either Text FileLoc
fl
  where
    sourceRange :: SourceRange
sourceRange = Int -> SourceRange
Loc.srFromLineNo (AppState n -> Int
forall n. AppState n -> Int
selectedLine AppState n
s)
    fl :: Either Text FileLoc
fl = case AppState n -> Maybe FilePath
forall n. AppState n -> Maybe FilePath
selectedFile AppState n
s of
        Maybe FilePath
Nothing -> Text -> Either Text FileLoc
forall a b. a -> Either a b
Left Text
"No selected file to get module of"
        Just FilePath
x -> FileLoc -> Either Text FileLoc
forall a b. b -> Either a b
Right (FilePath -> SourceRange -> FileLoc
Loc.FileLoc FilePath
x SourceRange
sourceRange)
    eModuleLoc :: FileLoc -> Either Text ModuleLoc
eModuleLoc FileLoc
x =
        let moduleFileMap :: ModuleFileMap
moduleFileMap = InterpState () -> ModuleFileMap
forall a. InterpState a -> ModuleFileMap
Daemon.moduleFileMap (AppState n -> InterpState ()
forall n. AppState n -> InterpState ()
interpState AppState n
s)
            res :: Maybe ModuleLoc
res = ModuleFileMap -> FileLoc -> Maybe ModuleLoc
Loc.toModuleLoc ModuleFileMap
moduleFileMap FileLoc
x
            errMsg :: Text
errMsg =
                Text
"No matching module found for '"
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FileLoc -> Text
forall a. Show a => a -> Text
showT FileLoc
x
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' because moduleFileMap was '"
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ModuleFileMap -> Text
forall a. Show a => a -> Text
showT ModuleFileMap
moduleFileMap
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
         in Text -> Maybe ModuleLoc -> Either Text ModuleLoc
forall a b. a -> Maybe b -> Either a b
note Text
errMsg Maybe ModuleLoc
res