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

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

import qualified Brick.Main as B
import qualified Brick.Types as B
import qualified Brick.Widgets.Edit as BE
import Control.Error (atDef, fromMaybe, lastDef, note)
import Control.Monad.IO.Class (MonadIO (..))
import Data.List (foldl')
import qualified Data.Text as T
import qualified Data.Text.Zipper as T
import qualified Graphics.Vty as V
import Lens.Micro ((^.))
import qualified Lens.Micro as Lens

import qualified Ghcitui.Brick.AppInterpState as AIS
import Ghcitui.Brick.AppState as AppState
import Ghcitui.Brick.AppTopLevel
    ( AppName (..)
    )
import qualified Ghcitui.Brick.SourceWindow as SourceWindow
import qualified Ghcitui.Ghcid.Daemon as Daemon
import qualified Ghcitui.Loc as Loc
import Ghcitui.Util (showT)

-- | Handle any Brick event and update the state.
handleEvent :: B.BrickEvent AppName e -> B.EventM AppName (AppState AppName) ()
handleEvent :: forall e.
BrickEvent AppName e -> 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 BrickEvent AppName e
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) ()
handleSrcWindowEvent
            ActiveWindow
AppState.ActiveLiveInterpreter -> BrickEvent AppName e -> EventM AppName (AppState AppName) ()
forall e.
BrickEvent AppName e -> EventM AppName (AppState AppName) ()
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 e -> EventM AppName (AppState AppName) ()
forall e.
BrickEvent AppName e -> EventM AppName (AppState AppName) ()
handler BrickEvent AppName e
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 FilePath
mayFp = AppState AppName -> Maybe FilePath
forall n. AppState n -> Maybe FilePath
AppState.filePathOfInfoSelectedModule AppState AppName
appState
                case Maybe FilePath
mayFp of
                    Just FilePath
_ -> 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 FilePath -> AppState AppName -> IO (AppState AppName)
forall (m :: * -> *) n.
MonadIO m =>
Maybe FilePath -> AppState n -> m (AppState n)
AppState.setSelectedFile Maybe FilePath
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 FilePath
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

-- -------------------------------------------------------------------------------------------------
-- Interpreter Event Handling
-- -------------------------------------------------------------------------------------------------

-- | Handle events when the interpreter (live GHCi) is selected.
handleInterpreterEvent :: B.BrickEvent AppName e -> B.EventM AppName (AppState AppName) ()
handleInterpreterEvent :: forall e.
BrickEvent AppName e -> EventM AppName (AppState AppName) ()
handleInterpreterEvent 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
V.KEnter []) -> do
            let cmd :: Text
cmd = Text -> Text
T.strip ([Text] -> Text
T.unlines (AppState AppName -> [Text]
forall {n}. AppState n -> [Text]
editorContents AppState AppName
appState))
            -- Actually run the command.
            (AppState AppName
newAppState1, [Text]
output) <- (InterpState () -> DaemonIO (InterpState (), [Text]))
-> AppState AppName
-> EventM AppName (AppState AppName) (AppState AppName, [Text])
forall n a m.
Ord n =>
(InterpState () -> DaemonIO (InterpState (), a))
-> AppState n -> EventM n m (AppState n, a)
runDaemon2 (Text -> InterpState () -> DaemonIO (InterpState (), [Text])
forall a.
Monoid a =>
Text
-> InterpState a -> ExceptT DaemonError IO (InterpState a, [Text])
Daemon.execCleaned Text
cmd) AppState AppName
appState
            let newEditor :: Editor Text AppName
newEditor =
                    (TextZipper Text -> TextZipper Text)
-> Editor Text AppName -> Editor Text AppName
forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
BE.applyEdit
                        (TextZipper Text -> TextZipper Text
forall a. Monoid a => TextZipper a -> TextZipper a
T.killToEOF (TextZipper Text -> TextZipper Text)
-> (TextZipper Text -> TextZipper Text)
-> TextZipper Text
-> TextZipper Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextZipper Text -> TextZipper Text
forall a. Monoid a => TextZipper a -> TextZipper a
T.gotoBOF)
                        (AppState AppName
appState AppState AppName
-> Getting
     (Editor Text AppName) (AppState AppName) (Editor Text AppName)
-> Editor Text AppName
forall s a. s -> Getting a s a -> a
^. Getting
  (Editor Text AppName) (AppState AppName) (Editor Text AppName)
forall n (f :: * -> *).
Functor f =>
(Editor Text n -> f (Editor Text n))
-> AppState n -> f (AppState n)
liveEditor)
            let newAppState2 :: AppState AppName
newAppState2 =
                    Text -> AppState AppName -> AppState AppName
forall n. Text -> AppState n -> AppState n
writeDebugLog (Text
"Handled Enter: Ran '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cmd Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'")
                        (AppState AppName -> AppState AppName)
-> (AppState AppName -> AppState AppName)
-> AppState AppName
-> AppState AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter (AppState AppName) (AppState AppName) Bool Bool
-> Bool -> AppState AppName -> AppState AppName
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ((AppInterpState Text AppName
 -> Identity (AppInterpState Text AppName))
-> AppState AppName -> Identity (AppState AppName)
forall n (f :: * -> *).
Functor f =>
(AppInterpState Text n -> f (AppInterpState Text n))
-> AppState n -> f (AppState n)
appInterpState ((AppInterpState Text AppName
  -> Identity (AppInterpState Text AppName))
 -> AppState AppName -> Identity (AppState AppName))
-> ((Bool -> Identity Bool)
    -> AppInterpState Text AppName
    -> Identity (AppInterpState Text AppName))
-> ASetter (AppState AppName) (AppState AppName) Bool Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> AppInterpState Text AppName
-> Identity (AppInterpState Text AppName)
forall s n (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> AppInterpState s n -> f (AppInterpState s n)
AIS.viewLock) Bool
True
                        (AppState AppName -> AppState AppName)
-> (AppState AppName -> AppState AppName)
-> AppState AppName
-> AppState AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AppInterpState Text AppName
  -> Identity (AppInterpState Text AppName))
 -> AppState AppName -> Identity (AppState AppName))
-> (AppInterpState Text AppName -> AppInterpState Text AppName)
-> AppState AppName
-> AppState AppName
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
Lens.over (AppInterpState Text AppName
 -> Identity (AppInterpState Text AppName))
-> AppState AppName -> Identity (AppState AppName)
forall n (f :: * -> *).
Functor f =>
(AppInterpState Text n -> f (AppInterpState Text n))
-> AppState n -> f (AppState n)
appInterpState ([Text]
-> AppInterpState Text AppName -> AppInterpState Text AppName
forall s n. [s] -> AppInterpState s n -> AppInterpState s n
AIS.pushHistory [Text
cmd])
                        (AppState AppName -> AppState AppName)
-> AppState AppName -> AppState AppName
forall a b. (a -> b) -> a -> b
$ [Text] -> Text -> AppState AppName -> AppState AppName
forall n. [Text] -> Text -> AppState n -> AppState n
appendToLogs [Text]
output Text
cmd AppState AppName
newAppState1
            let appStateFinalIO :: IO (AppState AppName)
appStateFinalIO = AppState AppName -> IO (AppState AppName)
forall n. AppState n -> IO (AppState n)
updateSourceMap (ASetter
  (AppState AppName)
  (AppState AppName)
  (Editor Text AppName)
  (Editor Text AppName)
-> Editor Text AppName -> AppState AppName -> AppState AppName
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter
  (AppState AppName)
  (AppState AppName)
  (Editor Text AppName)
  (Editor Text AppName)
forall n (f :: * -> *).
Functor f =>
(Editor Text n -> f (Editor Text n))
-> AppState n -> f (AppState n)
liveEditor Editor Text AppName
newEditor AppState AppName
newAppState2)
            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
=<< 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)
appStateFinalIO
            -- Invalidate the entire render state of the application
            -- because we don't know what's actually changed here now.
            EventM AppName (AppState AppName) ()
forall n s. Ord n => EventM n s ()
B.invalidateCache
        B.VtyEvent (V.EvKey (V.KChar Char
'\t') []) -> do
            -- We want to preserve spaces, but not trailing newlines.
            let cmd :: Text
cmd = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char
'\n' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) (Text -> Text)
-> (AppState AppName -> Text) -> AppState AppName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> Text)
-> (AppState AppName -> [Text]) -> AppState AppName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState AppName -> [Text]
forall {n}. AppState n -> [Text]
editorContents (AppState AppName -> Text) -> AppState AppName -> Text
forall a b. (a -> b) -> a -> b
$ AppState AppName
appState
            -- Tab completion expects input to be 'show'n in quotes.
            -- There's probably a better way of doing this!
            (AppState AppName
newAppState, (Text
prefix, [Text]
completions)) <- (InterpState () -> DaemonIO (InterpState (), (Text, [Text])))
-> AppState AppName
-> EventM
     AppName (AppState AppName) (AppState AppName, (Text, [Text]))
forall n a m.
Ord n =>
(InterpState () -> DaemonIO (InterpState (), a))
-> AppState n -> EventM n m (AppState n, a)
runDaemon2 (Text -> InterpState () -> DaemonIO (InterpState (), (Text, [Text]))
forall a.
Monoid a =>
Text -> InterpState a -> DaemonIO (InterpState a, (Text, [Text]))
Daemon.tabComplete Text
cmd) AppState AppName
appState
            let maxCompletionLen :: Int
maxCompletionLen = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length (Text -> Int) -> [Text] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
completions
            let columnPadding :: Int
columnPadding = Int
1
            Extent AppName
extent <-
                AppName
-> EventM AppName (AppState AppName) (Maybe (Extent AppName))
forall n s. Eq n => n -> EventM n s (Maybe (Extent n))
B.lookupExtent AppName
LiveInterpreterViewport EventM AppName (AppState AppName) (Maybe (Extent AppName))
-> (Maybe (Extent AppName)
    -> EventM AppName (AppState AppName) (Extent AppName))
-> EventM AppName (AppState AppName) (Extent AppName)
forall a b.
EventM AppName (AppState AppName) a
-> (a -> EventM AppName (AppState AppName) b)
-> EventM AppName (AppState AppName) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Just Extent AppName
e -> Extent AppName
-> EventM AppName (AppState AppName) (Extent AppName)
forall a. a -> EventM AppName (AppState AppName) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Extent AppName
e
                    Maybe (Extent AppName)
Nothing -> FilePath -> EventM AppName (AppState AppName) (Extent AppName)
forall a. HasCallStack => FilePath -> a
error FilePath
"Could not find extent of LiveInterpreterViewport"
            let interpWidth :: Int
interpWidth = (Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int)
-> (Extent AppName -> (Int, Int)) -> Extent AppName -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extent AppName -> (Int, Int)
forall n. Extent n -> (Int, Int)
B.extentSize (Extent AppName -> Int) -> Extent AppName -> Int
forall a b. (a -> b) -> a -> b
$ Extent AppName
extent
            let completionColWidth :: Int
completionColWidth = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
interpWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Int
maxCompletionLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
columnPadding
            let numCols :: Int
numCols = Int
interpWidth Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
completionColWidth
            let updateCompletions :: [Text] -> AppState AppName -> AppState AppName
updateCompletions [Text]
cs AppState AppName
s = case [Text]
cs of
                    -- Only one completion, just replace the entire buffer with it.
                    [Text
c] -> Text -> AppState AppName -> AppState AppName
forall n. Text -> AppState n -> AppState n
replaceCommandBuffer (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ") AppState AppName
s
                    -- No completions. Just go to a new prompt.
                    [] -> [Text] -> Text -> AppState AppName -> AppState AppName
forall n. [Text] -> Text -> AppState n -> AppState n
appendToLogs [] Text
cmd AppState AppName
s
                    -- Replace the buffer with the longest possible prefix among options, and
                    -- print the remaining.
                    [Text]
_ ->
                        Text -> AppState AppName -> AppState AppName
forall n. Text -> AppState n -> AppState n
replaceCommandBuffer (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
commonPrefixes [Text]
cs)
                            (AppState AppName -> AppState AppName)
-> (AppState AppName -> AppState AppName)
-> AppState AppName
-> AppState AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text -> AppState AppName -> AppState AppName
forall n. [Text] -> Text -> AppState n -> AppState n
appendToLogs (Int -> Int -> [Text] -> [Text]
reflowText Int
numCols Int
completionColWidth [Text]
cs) Text
cmd
                            (AppState AppName -> AppState AppName)
-> AppState AppName -> AppState AppName
forall a b. (a -> b) -> a -> b
$ AppState AppName
s
            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
. Text -> AppState AppName -> AppState AppName
forall n. Text -> AppState n -> AppState n
writeDebugLog
                    ( Text
"Handled Tab, Prefix was: '"
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cmd
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' Completions were: "
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall a. Show a => a -> Text
showT [Text]
completions
                    )
                (AppState AppName -> AppState AppName)
-> (AppState AppName -> AppState AppName)
-> AppState AppName
-> AppState AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> AppState AppName -> AppState AppName
updateCompletions [Text]
completions
                (AppState AppName -> EventM AppName (AppState AppName) ())
-> AppState AppName -> EventM AppName (AppState AppName) ()
forall a b. (a -> b) -> a -> b
$ AppState AppName
newAppState
        B.VtyEvent (V.EvKey (V.KChar Char
'x') [Modifier
V.MCtrl]) ->
            -- Toggle out of the interpreter.
            EventM AppName (AppState AppName) ()
leaveInterpreter
        B.VtyEvent (V.EvKey Key
V.KEsc [Modifier]
_) -> do
            if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ AppState AppName
appState AppState AppName -> Getting Bool (AppState AppName) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (AppInterpState Text AppName
 -> Const Bool (AppInterpState Text AppName))
-> AppState AppName -> Const Bool (AppState AppName)
forall n (f :: * -> *).
Functor f =>
(AppInterpState Text n -> f (AppInterpState Text n))
-> AppState n -> f (AppState n)
appInterpState ((AppInterpState Text AppName
  -> Const Bool (AppInterpState Text AppName))
 -> AppState AppName -> Const Bool (AppState AppName))
-> ((Bool -> Const Bool Bool)
    -> AppInterpState Text AppName
    -> Const Bool (AppInterpState Text AppName))
-> Getting Bool (AppState AppName) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> AppInterpState Text AppName
-> Const Bool (AppInterpState Text AppName)
forall s n (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> AppInterpState s n -> f (AppInterpState s n)
AIS.viewLock
                then -- Exit scroll mode first.
                    AppState AppName -> EventM AppName (AppState AppName) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
B.put (ASetter (AppState AppName) (AppState AppName) Bool Bool
-> Bool -> AppState AppName -> AppState AppName
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ((AppInterpState Text AppName
 -> Identity (AppInterpState Text AppName))
-> AppState AppName -> Identity (AppState AppName)
forall n (f :: * -> *).
Functor f =>
(AppInterpState Text n -> f (AppInterpState Text n))
-> AppState n -> f (AppState n)
appInterpState ((AppInterpState Text AppName
  -> Identity (AppInterpState Text AppName))
 -> AppState AppName -> Identity (AppState AppName))
-> ((Bool -> Identity Bool)
    -> AppInterpState Text AppName
    -> Identity (AppInterpState Text AppName))
-> ASetter (AppState AppName) (AppState AppName) Bool Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> AppInterpState Text AppName
-> Identity (AppInterpState Text AppName)
forall s n (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> AppInterpState s n -> f (AppInterpState s n)
AIS.viewLock) Bool
True AppState AppName
appState)
                else -- Also toggle out of the interpreter.
                    EventM AppName (AppState AppName) ()
leaveInterpreter

        -- Selecting previous commands.
        B.VtyEvent (V.EvKey Key
V.KUp [Modifier]
_) -> do
            let maybeStoreBuffer :: AppState n -> AppState n
maybeStoreBuffer AppState n
s =
                    if Bool -> Bool
not (AppInterpState Text n -> Bool
forall s n. AppInterpState s n -> Bool
AIS.isScanningHist (AppState n -> AppInterpState Text n
forall {n}. AppState n -> AppInterpState Text n
getAis AppState n
s))
                        then AppState n -> AppState n
forall {n}. AppState n -> AppState n
storeCommandBuffer AppState n
s
                        else AppState n
s
            let wDebug :: AppState n -> AppState n
wDebug AppState n
s =
                    Text -> AppState n -> AppState n
forall n. Text -> AppState n -> AppState n
writeDebugLog
                        ( Text
"Handled Up; historyPos is "
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Int -> Text
forall a. Show a => a -> Text
showT (Int -> Text) -> (AppState n -> Int) -> AppState n -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppInterpState Text n -> Int
forall s n. AppInterpState s n -> Int
AIS.historyPos (AppInterpState Text n -> Int)
-> (AppState n -> AppInterpState Text n) -> AppState n -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState n -> AppInterpState Text n
forall {n}. AppState n -> AppInterpState Text n
getAis (AppState n -> Text) -> AppState n -> Text
forall a b. (a -> b) -> a -> b
$ AppState n
s)
                        )
                        AppState n
s
            let appState' :: AppState AppName
appState' =
                    AppState AppName -> AppState AppName
forall {n}. AppState n -> AppState n
wDebug
                        (AppState AppName -> AppState AppName)
-> (AppState AppName -> AppState AppName)
-> AppState AppName
-> AppState AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState AppName -> AppState AppName
forall {n}. AppState n -> AppState n
replaceCommandBufferWithHist -- Display the history.
                        (AppState AppName -> AppState AppName)
-> (AppState AppName -> AppState AppName)
-> AppState AppName
-> AppState AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AppInterpState Text AppName
  -> Identity (AppInterpState Text AppName))
 -> AppState AppName -> Identity (AppState AppName))
-> (AppInterpState Text AppName -> AppInterpState Text AppName)
-> AppState AppName
-> AppState AppName
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
Lens.over (AppInterpState Text AppName
 -> Identity (AppInterpState Text AppName))
-> AppState AppName -> Identity (AppState AppName)
forall n (f :: * -> *).
Functor f =>
(AppInterpState Text n -> f (AppInterpState Text n))
-> AppState n -> f (AppState n)
appInterpState AppInterpState Text AppName -> AppInterpState Text AppName
forall s n. AppInterpState s n -> AppInterpState s n
AIS.pastHistoryPos -- Go back in time.
                        (AppState AppName -> AppState AppName)
-> (AppState AppName -> AppState AppName)
-> AppState AppName
-> AppState AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState AppName -> AppState AppName
forall {n}. AppState n -> AppState n
maybeStoreBuffer -- Store the buffer if we're not scanning already.
                        (AppState AppName -> AppState AppName)
-> AppState AppName -> AppState AppName
forall a b. (a -> b) -> a -> b
$ AppState AppName
appState
            AppState AppName -> EventM AppName (AppState AppName) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
B.put AppState AppName
appState'
        B.VtyEvent (V.EvKey Key
V.KDown [Modifier]
_) -> do
            let wDebug :: AppState n -> AppState n
wDebug AppState n
s =
                    Text -> AppState n -> AppState n
forall n. Text -> AppState n -> AppState n
writeDebugLog
                        ( Text
"Handled Down; historyPos is "
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Int -> Text
forall a. Show a => a -> Text
showT (Int -> Text) -> (AppState n -> Int) -> AppState n -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppInterpState Text n -> Int
forall s n. AppInterpState s n -> Int
AIS.historyPos (AppInterpState Text n -> Int)
-> (AppState n -> AppInterpState Text n) -> AppState n -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState n -> AppInterpState Text n
forall {n}. AppState n -> AppInterpState Text n
getAis (AppState n -> Text) -> AppState n -> Text
forall a b. (a -> b) -> a -> b
$ AppState n
s)
                        )
                        AppState n
s
            let appState' :: AppState AppName
appState' =
                    AppState AppName -> AppState AppName
forall {n}. AppState n -> AppState n
wDebug
                        (AppState AppName -> AppState AppName)
-> (AppState AppName -> AppState AppName)
-> AppState AppName
-> AppState AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState AppName -> AppState AppName
forall {n}. AppState n -> AppState n
replaceCommandBufferWithHist -- Display the history.
                        (AppState AppName -> AppState AppName)
-> (AppState AppName -> AppState AppName)
-> AppState AppName
-> AppState AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AppInterpState Text AppName
  -> Identity (AppInterpState Text AppName))
 -> AppState AppName -> Identity (AppState AppName))
-> (AppInterpState Text AppName -> AppInterpState Text AppName)
-> AppState AppName
-> AppState AppName
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
Lens.over (AppInterpState Text AppName
 -> Identity (AppInterpState Text AppName))
-> AppState AppName -> Identity (AppState AppName)
forall n (f :: * -> *).
Functor f =>
(AppInterpState Text n -> f (AppInterpState Text n))
-> AppState n -> f (AppState n)
appInterpState AppInterpState Text AppName -> AppInterpState Text AppName
forall s n. AppInterpState s n -> AppInterpState s n
AIS.futHistoryPos -- Go forward in time.
                        (AppState AppName -> AppState AppName)
-> AppState AppName -> AppState AppName
forall a b. (a -> b) -> a -> b
$ AppState AppName
appState
            AppState AppName -> EventM AppName (AppState AppName) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
B.put AppState AppName
appState'

        -- Scrolling back through the logs.
        B.VtyEvent (V.EvKey Key
V.KPageDown [Modifier]
_) ->
            ViewportScroll AppName
-> forall s. Direction -> EventM AppName s ()
forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
B.vScrollPage (AppName -> ViewportScroll AppName
forall n. n -> ViewportScroll n
B.viewportScroll AppName
LiveInterpreterViewport) Direction
B.Down
        B.VtyEvent (V.EvKey Key
V.KPageUp [Modifier]
_) -> do
            ViewportScroll AppName
-> forall s. Direction -> EventM AppName s ()
forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
B.vScrollPage (AppName -> ViewportScroll AppName
forall n. n -> ViewportScroll n
B.viewportScroll AppName
LiveInterpreterViewport) Direction
B.Up
            AppState AppName -> EventM AppName (AppState AppName) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
B.put (ASetter (AppState AppName) (AppState AppName) Bool Bool
-> Bool -> AppState AppName -> AppState AppName
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ((AppInterpState Text AppName
 -> Identity (AppInterpState Text AppName))
-> AppState AppName -> Identity (AppState AppName)
forall n (f :: * -> *).
Functor f =>
(AppInterpState Text n -> f (AppInterpState Text n))
-> AppState n -> f (AppState n)
appInterpState ((AppInterpState Text AppName
  -> Identity (AppInterpState Text AppName))
 -> AppState AppName -> Identity (AppState AppName))
-> ((Bool -> Identity Bool)
    -> AppInterpState Text AppName
    -> Identity (AppInterpState Text AppName))
-> ASetter (AppState AppName) (AppState AppName) Bool Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> AppInterpState Text AppName
-> Identity (AppInterpState Text AppName)
forall s n (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> AppInterpState s n -> f (AppInterpState s n)
AIS.viewLock) Bool
False AppState AppName
appState)
        B.VtyEvent (V.EvKey (V.KChar Char
'n') [Modifier
V.MCtrl]) -> do
            -- Invert the viewLock.
            AppState AppName -> EventM AppName (AppState AppName) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
B.put (ASetter (AppState AppName) (AppState AppName) Bool Bool
-> (Bool -> Bool) -> AppState AppName -> AppState AppName
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
Lens.over ((AppInterpState Text AppName
 -> Identity (AppInterpState Text AppName))
-> AppState AppName -> Identity (AppState AppName)
forall n (f :: * -> *).
Functor f =>
(AppInterpState Text n -> f (AppInterpState Text n))
-> AppState n -> f (AppState n)
appInterpState ((AppInterpState Text AppName
  -> Identity (AppInterpState Text AppName))
 -> AppState AppName -> Identity (AppState AppName))
-> ((Bool -> Identity Bool)
    -> AppInterpState Text AppName
    -> Identity (AppInterpState Text AppName))
-> ASetter (AppState AppName) (AppState AppName) Bool Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> AppInterpState Text AppName
-> Identity (AppInterpState Text AppName)
forall s n (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> AppInterpState s n -> f (AppInterpState s n)
AIS.viewLock) Bool -> Bool
not AppState AppName
appState)

        -- While scrolling (viewLock disabled), allow resizing the live interpreter history.
        B.VtyEvent (V.EvKey (V.KChar Char
'+') [])
            | Bool -> Bool
not (AppState AppName
appState AppState AppName -> Getting Bool (AppState AppName) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (AppInterpState Text AppName
 -> Const Bool (AppInterpState Text AppName))
-> AppState AppName -> Const Bool (AppState AppName)
forall n (f :: * -> *).
Functor f =>
(AppInterpState Text n -> f (AppInterpState Text n))
-> AppState n -> f (AppState n)
appInterpState ((AppInterpState Text AppName
  -> Const Bool (AppInterpState Text AppName))
 -> AppState AppName -> Const Bool (AppState AppName))
-> ((Bool -> Const Bool Bool)
    -> AppInterpState Text AppName
    -> Const Bool (AppInterpState Text AppName))
-> Getting Bool (AppState AppName) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> AppInterpState Text AppName
-> Const Bool (AppInterpState Text AppName)
forall s n (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> AppInterpState s n -> f (AppInterpState s n)
AIS.viewLock) -> 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.changeReplWidgetSize Int
1 AppState AppName
appState)
        B.VtyEvent (V.EvKey (V.KChar Char
'-') [])
            | Bool -> Bool
not (AppState AppName
appState AppState AppName -> Getting Bool (AppState AppName) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (AppInterpState Text AppName
 -> Const Bool (AppInterpState Text AppName))
-> AppState AppName -> Const Bool (AppState AppName)
forall n (f :: * -> *).
Functor f =>
(AppInterpState Text n -> f (AppInterpState Text n))
-> AppState n -> f (AppState n)
appInterpState ((AppInterpState Text AppName
  -> Const Bool (AppInterpState Text AppName))
 -> AppState AppName -> Const Bool (AppState AppName))
-> ((Bool -> Const Bool Bool)
    -> AppInterpState Text AppName
    -> Const Bool (AppInterpState Text AppName))
-> Getting Bool (AppState AppName) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> AppInterpState Text AppName
-> Const Bool (AppInterpState Text AppName)
forall s n (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> AppInterpState s n -> f (AppInterpState s n)
AIS.viewLock) -> 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.changeReplWidgetSize (-Int
1) AppState AppName
appState)

        -- Actually handle keystrokes.
        BrickEvent AppName e
ev' -> do
            -- When typing, bring us back down to the terminal.
            AppState AppName -> EventM AppName (AppState AppName) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
B.put (ASetter (AppState AppName) (AppState AppName) Bool Bool
-> Bool -> AppState AppName -> AppState AppName
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ((AppInterpState Text AppName
 -> Identity (AppInterpState Text AppName))
-> AppState AppName -> Identity (AppState AppName)
forall n (f :: * -> *).
Functor f =>
(AppInterpState Text n -> f (AppInterpState Text n))
-> AppState n -> f (AppState n)
appInterpState ((AppInterpState Text AppName
  -> Identity (AppInterpState Text AppName))
 -> AppState AppName -> Identity (AppState AppName))
-> ((Bool -> Identity Bool)
    -> AppInterpState Text AppName
    -> Identity (AppInterpState Text AppName))
-> ASetter (AppState AppName) (AppState AppName) Bool Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> AppInterpState Text AppName
-> Identity (AppInterpState Text AppName)
forall s n (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> AppInterpState s n -> f (AppInterpState s n)
AIS.viewLock) Bool
True AppState AppName
appState)
            -- Actually handle text input commands.
            LensLike'
  (Zoomed (EventM AppName (Editor Text AppName)) ())
  (AppState AppName)
  (Editor Text AppName)
-> EventM AppName (Editor Text AppName) ()
-> EventM AppName (AppState AppName) ()
forall c.
LensLike'
  (Zoomed (EventM AppName (Editor Text AppName)) c)
  (AppState AppName)
  (Editor Text AppName)
-> EventM AppName (Editor Text AppName) c
-> EventM AppName (AppState AppName) c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
B.zoom (Editor Text AppName
 -> Focusing
      (StateT (EventState AppName) IO) () (Editor Text AppName))
-> AppState AppName
-> Focusing (StateT (EventState AppName) IO) () (AppState AppName)
LensLike'
  (Zoomed (EventM AppName (Editor Text AppName)) ())
  (AppState AppName)
  (Editor Text AppName)
forall n (f :: * -> *).
Functor f =>
(Editor Text n -> f (Editor Text n))
-> AppState n -> f (AppState n)
liveEditor (EventM AppName (Editor Text AppName) ()
 -> EventM AppName (AppState AppName) ())
-> EventM AppName (Editor Text AppName) ()
-> EventM AppName (AppState AppName) ()
forall a b. (a -> b) -> a -> b
$ BrickEvent AppName e -> EventM AppName (Editor Text AppName) ()
forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
BE.handleEditorEvent BrickEvent AppName e
ev'
  where
    editorContents :: AppState n -> [Text]
editorContents AppState n
appState = Editor Text n -> [Text]
forall t n. Monoid t => Editor t n -> [t]
BE.getEditContents (Editor Text n -> [Text]) -> Editor Text n -> [Text]
forall a b. (a -> b) -> a -> b
$ AppState n
appState AppState n
-> Getting (Editor Text n) (AppState n) (Editor Text n)
-> Editor Text n
forall s a. s -> Getting a s a -> a
^. Getting (Editor Text n) (AppState n) (Editor Text n)
forall n (f :: * -> *).
Functor f =>
(Editor Text n -> f (Editor Text n))
-> AppState n -> f (AppState n)
liveEditor
    storeCommandBuffer :: AppState n -> AppState n
storeCommandBuffer AppState n
appState =
        ASetter (AppState n) (AppState n) [Text] [Text]
-> [Text] -> AppState n -> AppState n
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ((AppInterpState Text n -> Identity (AppInterpState Text n))
-> AppState n -> Identity (AppState n)
forall n (f :: * -> *).
Functor f =>
(AppInterpState Text n -> f (AppInterpState Text n))
-> AppState n -> f (AppState n)
appInterpState ((AppInterpState Text n -> Identity (AppInterpState Text n))
 -> AppState n -> Identity (AppState n))
-> (([Text] -> Identity [Text])
    -> AppInterpState Text n -> Identity (AppInterpState Text n))
-> ASetter (AppState n) (AppState n) [Text] [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Identity [Text])
-> AppInterpState Text n -> Identity (AppInterpState Text n)
forall s n (f :: * -> *).
Functor f =>
([s] -> f [s]) -> AppInterpState s n -> f (AppInterpState s n)
AIS.commandBuffer) (AppState n -> [Text]
forall {n}. AppState n -> [Text]
editorContents AppState n
appState) AppState n
appState
    getAis :: AppState n -> AppInterpState Text n
getAis AppState n
s = AppState n
s AppState n
-> Getting
     (AppInterpState Text n) (AppState n) (AppInterpState Text n)
-> AppInterpState Text n
forall s a. s -> Getting a s a -> a
^. Getting
  (AppInterpState Text n) (AppState n) (AppInterpState Text n)
forall n (f :: * -> *).
Functor f =>
(AppInterpState Text n -> f (AppInterpState Text n))
-> AppState n -> f (AppState n)
appInterpState
    getCommandAtHist :: Int -> AppState n -> [T.Text]
    getCommandAtHist :: forall n. Int -> AppState n -> [Text]
getCommandAtHist Int
i AppState n
s
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = AppState n
s AppState n -> Getting [Text] (AppState n) [Text] -> [Text]
forall s a. s -> Getting a s a -> a
^. (AppInterpState Text n -> Const [Text] (AppInterpState Text n))
-> AppState n -> Const [Text] (AppState n)
forall n (f :: * -> *).
Functor f =>
(AppInterpState Text n -> f (AppInterpState Text n))
-> AppState n -> f (AppState n)
appInterpState ((AppInterpState Text n -> Const [Text] (AppInterpState Text n))
 -> AppState n -> Const [Text] (AppState n))
-> (([Text] -> Const [Text] [Text])
    -> AppInterpState Text n -> Const [Text] (AppInterpState Text n))
-> Getting [Text] (AppState n) [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Const [Text] [Text])
-> AppInterpState Text n -> Const [Text] (AppInterpState Text n)
forall s n (f :: * -> *).
Functor f =>
([s] -> f [s]) -> AppInterpState s n -> f (AppInterpState s n)
AIS.commandBuffer
        | Bool
otherwise = [Text] -> [[Text]] -> Int -> [Text]
forall a. a -> [a] -> Int -> a
atDef ([Text] -> [[Text]] -> [Text]
forall a. a -> [a] -> a
lastDef [] [[Text]]
hist) [[Text]]
hist (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      where
        hist :: [[Text]]
hist = AppState n
s AppState n -> Getting [[Text]] (AppState n) [[Text]] -> [[Text]]
forall s a. s -> Getting a s a -> a
^. (AppInterpState Text n -> Const [[Text]] (AppInterpState Text n))
-> AppState n -> Const [[Text]] (AppState n)
forall n (f :: * -> *).
Functor f =>
(AppInterpState Text n -> f (AppInterpState Text n))
-> AppState n -> f (AppState n)
appInterpState ((AppInterpState Text n -> Const [[Text]] (AppInterpState Text n))
 -> AppState n -> Const [[Text]] (AppState n))
-> (([[Text]] -> Const [[Text]] [[Text]])
    -> AppInterpState Text n -> Const [[Text]] (AppInterpState Text n))
-> Getting [[Text]] (AppState n) [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AppInterpState Text n -> [[Text]])
-> SimpleGetter (AppInterpState Text n) [[Text]]
forall s a. (s -> a) -> SimpleGetter s a
Lens.to AppInterpState Text n -> [[Text]]
forall s n. AppInterpState s n -> [[s]]
AIS.cmdHistory

    leaveInterpreter :: EventM AppName (AppState AppName) ()
leaveInterpreter = 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

    replaceCommandBufferWithHist :: AppState n -> AppState n
    replaceCommandBufferWithHist :: forall {n}. AppState n -> AppState n
replaceCommandBufferWithHist s :: AppState n
s@AppState{AppInterpState Text n
_appInterpState :: AppInterpState Text n
$sel:_appInterpState:AppState :: forall {n}. AppState n -> AppInterpState Text n
_appInterpState} = Text -> AppState n -> AppState n
forall n. Text -> AppState n -> AppState n
replaceCommandBuffer Text
cmd AppState n
s
      where
        cmd :: Text
cmd = [Text] -> Text
T.unlines ([Text] -> Text) -> (AppState n -> [Text]) -> AppState n -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> AppState n -> [Text]
forall n. Int -> AppState n -> [Text]
getCommandAtHist (AppInterpState Text n -> Int
forall s n. AppInterpState s n -> Int
AIS.historyPos AppInterpState Text n
_appInterpState) (AppState n -> Text) -> AppState n -> Text
forall a b. (a -> b) -> a -> b
$ AppState n
s

appendToLogs
    :: [T.Text]
    -- ^ Logs between commands.
    -> T.Text
    -- ^ The command sent to produce the logs.
    -> AppState n
    -- ^ State to update.
    -> AppState n
    -- ^ Updated state.
appendToLogs :: forall n. [Text] -> Text -> AppState n -> AppState n
appendToLogs [Text]
logs Text
promptEntry AppState n
state = AppState n
state{interpLogs = take interpreterLogLimit combinedLogs}
  where
    combinedLogs :: [Text]
combinedLogs = [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
logs [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Text
formattedWithPrompt Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: AppState n -> [Text]
forall {n}. AppState n -> [Text]
interpLogs AppState n
state)
    formattedWithPrompt :: Text
formattedWithPrompt = AppConfig -> Text
getInterpreterPrompt (AppState n -> AppConfig
forall n. AppState n -> AppConfig
appConfig AppState n
state) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
promptEntry
    -- TODO: Should be configurable?
    interpreterLogLimit :: Int
interpreterLogLimit = Int
1000

{- | Reflow entries of text into columns.
     Mostly useful right now for printing autocomplete suggestions into columns.
-}
reflowText
    :: Int
    -- ^ Num columns
    -> Int
    -- ^ Column width
    -> [T.Text]
    -- ^ Text entries to reflow
    -> [T.Text]
    -- ^ Reflowed lines.
reflowText :: Int -> Int -> [Text] -> [Text]
reflowText Int
numCols Int
colWidth = [Text] -> [Text]
go
  where
    go :: [T.Text] -> [T.Text]
    go :: [Text] -> [Text]
go [] = []
    go [Text]
entries' = [Text] -> Text
makeLine [Text]
toMakeLine Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
go [Text]
rest
      where
        ([Text]
toMakeLine, [Text]
rest) = Int -> [Text] -> ([Text], [Text])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
numCols [Text]
entries'
    maxTextLen :: Int
maxTextLen = Int
colWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    makeLine :: [Text] -> Text
makeLine [Text]
xs = [Text] -> Text
T.concat (Int -> Char -> Text -> Text
T.justifyLeft Int
colWidth Char
' ' (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
shortenText Int
maxTextLen (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
xs)

-- | Limit text to a given length, and cut with an elipses.
shortenText :: Int -> T.Text -> T.Text
shortenText :: Int -> Text -> Text
shortenText Int
maxLen Text
text
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxLen = Text
text
    | Bool
otherwise = Int -> Text -> Text
T.take (Int
maxLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
text Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"…"
  where
    len :: Int
len = Text -> Int
T.length Text
text

-- | Return the shared prefix among all the input Texts.
commonPrefixes :: [T.Text] -> T.Text
commonPrefixes :: [Text] -> Text
commonPrefixes [] = Text
""
commonPrefixes (Text
t : [Text]
ts) = (Text -> Text -> Text) -> Text -> [Text] -> Text
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Text -> Text -> Text
folder Text
t [Text]
ts
  where
    folder :: T.Text -> T.Text -> T.Text
    folder :: Text -> Text -> Text
folder Text
acc Text
t' = case Text -> Text -> Maybe (Text, Text, Text)
T.commonPrefixes Text
acc Text
t' of
        Just (Text
p, Text
_, Text
_) -> Text
p
        Maybe (Text, Text, Text)
_ -> Text
""

-- | Replace the command buffer with the given strings of Text.
replaceCommandBuffer
    :: T.Text
    -- ^ Text to replace with.
    -> AppState n
    -- ^ State to modify.
    -> AppState n
    -- ^ New state.
replaceCommandBuffer :: forall n. Text -> AppState n -> AppState n
replaceCommandBuffer Text
replacement AppState n
s = ASetter (AppState n) (AppState n) (Editor Text n) (Editor Text n)
-> Editor Text n -> AppState n -> AppState n
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter (AppState n) (AppState n) (Editor Text n) (Editor Text n)
forall n (f :: * -> *).
Functor f =>
(Editor Text n -> f (Editor Text n))
-> AppState n -> f (AppState n)
liveEditor Editor Text n
newEditor AppState n
s
  where
    zipp :: T.TextZipper T.Text -> T.TextZipper T.Text
    zipp :: TextZipper Text -> TextZipper Text
zipp = TextZipper Text -> TextZipper Text
forall a. Monoid a => TextZipper a -> TextZipper a
T.killToEOF (TextZipper Text -> TextZipper Text)
-> (TextZipper Text -> TextZipper Text)
-> TextZipper Text
-> TextZipper Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TextZipper Text -> TextZipper Text
forall a. Monoid a => a -> TextZipper a -> TextZipper a
T.insertMany Text
replacement (TextZipper Text -> TextZipper Text)
-> (TextZipper Text -> TextZipper Text)
-> TextZipper Text
-> TextZipper Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextZipper Text -> TextZipper Text
forall a. Monoid a => TextZipper a -> TextZipper a
T.gotoBOF
    newEditor :: Editor Text n
newEditor = (TextZipper Text -> TextZipper Text)
-> Editor Text n -> Editor Text n
forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
BE.applyEdit TextZipper Text -> TextZipper Text
zipp (AppState n
s AppState n
-> Getting (Editor Text n) (AppState n) (Editor Text n)
-> Editor Text n
forall s a. s -> Getting a s a -> a
^. Getting (Editor Text n) (AppState n) (Editor Text n)
forall n (f :: * -> *).
Functor f =>
(Editor Text n -> f (Editor Text n))
-> AppState n -> f (AppState n)
liveEditor)

-- -------------------------------------------------------------------------------------------------
-- 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
    | Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Key
V.KChar Char
's' = do
        AppState AppName
appState <- EventM AppName (AppState AppName) (AppState AppName)
forall s (m :: * -> *). MonadState s m => m s
B.get
        AppState AppName
newState <- InterpState () -> ExceptT DaemonError IO (InterpState ())
forall a.
Monoid a =>
InterpState a -> ExceptT DaemonError IO (InterpState a)
Daemon.step (InterpState () -> ExceptT DaemonError IO (InterpState ()))
-> AppState AppName
-> EventM AppName (AppState AppName) (AppState AppName)
forall n m.
Ord n =>
(InterpState () -> ExceptT DaemonError IO (InterpState ()))
-> AppState n -> EventM n m (AppState n)
`runDaemon` AppState AppName
appState
        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
newState
    | Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Key
V.KChar Char
'c' = do
        AppState AppName
appState <- EventM AppName (AppState AppName) (AppState AppName)
forall s (m :: * -> *). MonadState s m => m s
B.get
        AppState AppName
newState <- InterpState () -> ExceptT DaemonError IO (InterpState ())
forall a.
Monoid a =>
InterpState a -> ExceptT DaemonError IO (InterpState a)
Daemon.continue (InterpState () -> ExceptT DaemonError IO (InterpState ()))
-> AppState AppName
-> EventM AppName (AppState AppName) (AppState AppName)
forall n m.
Ord n =>
(InterpState () -> ExceptT DaemonError IO (InterpState ()))
-> AppState n -> EventM n m (AppState n)
`runDaemon` AppState AppName
appState
        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
newState
    | Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Key
V.KChar Char
't' = do
        AppState AppName
appState <- EventM AppName (AppState AppName) (AppState AppName)
forall s (m :: * -> *). MonadState s m => m s
B.get
        AppState AppName
newState <- InterpState () -> ExceptT DaemonError IO (InterpState ())
forall a.
Monoid a =>
InterpState a -> ExceptT DaemonError IO (InterpState a)
Daemon.trace (InterpState () -> ExceptT DaemonError IO (InterpState ()))
-> AppState AppName
-> EventM AppName (AppState AppName) (AppState AppName)
forall n m.
Ord n =>
(InterpState () -> ExceptT DaemonError IO (InterpState ()))
-> AppState n -> EventM n m (AppState n)
`runDaemon` AppState AppName
appState
        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
newState
    | 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 ()

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 daemonOp :: ExceptT DaemonError IO (InterpState ())
daemonOp = BreakpointArg
-> InterpState () -> ExceptT DaemonError IO (InterpState ())
forall a.
Monoid a =>
BreakpointArg -> InterpState a -> DaemonIO (InterpState a)
Daemon.toggleBreakpointLine (ModuleLoc -> BreakpointArg
Daemon.ModLoc ModuleLoc
ml) AppState AppName
appState.interpState
            InterpState ()
interpState <-
                IO (InterpState ())
-> EventM AppName (AppState AppName) (InterpState ())
forall a. IO a -> EventM AppName (AppState AppName) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (InterpState ())
 -> EventM AppName (AppState AppName) (InterpState ()))
-> IO (InterpState ())
-> EventM AppName (AppState AppName) (InterpState ())
forall a b. (a -> b) -> a -> b
$ do
                    Either DaemonError (InterpState ())
eNewState <- ExceptT DaemonError IO (InterpState ())
-> IO (Either DaemonError (InterpState ()))
forall r. DaemonIO r -> IO (Either DaemonError r)
Daemon.run ExceptT DaemonError IO (InterpState ())
daemonOp
                    case Either DaemonError (InterpState ())
eNewState of
                        Right InterpState ()
out -> InterpState () -> IO (InterpState ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InterpState ()
out
                        Left DaemonError
er -> FilePath -> IO (InterpState ())
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO (InterpState ()))
-> FilePath -> IO (InterpState ())
forall a b. (a -> b) -> a -> b
$ DaemonError -> FilePath
forall a. Show a => a -> FilePath
show DaemonError
er
            -- 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
ml) 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}

-- TODO: Invalidate only the lines instead of the entire application.
invalidateLineCache :: (Ord n) => B.EventM n (state n) ()
invalidateLineCache :: forall n (state :: * -> *). Ord n => EventM n (state n) ()
invalidateLineCache = EventM n (state n) ()
forall n s. Ord n => EventM n s ()
B.invalidateCache

-- | Run a DaemonIO function on a given interpreter state, within an EventM monad.
runDaemon
    :: (Ord n)
    => (Daemon.InterpState () -> Daemon.DaemonIO (Daemon.InterpState ()))
    -> AppState n
    -> B.EventM n m (AppState n)
runDaemon :: forall n m.
Ord n =>
(InterpState () -> ExceptT DaemonError IO (InterpState ()))
-> AppState n -> EventM n m (AppState n)
runDaemon InterpState () -> ExceptT DaemonError IO (InterpState ())
f AppState n
appState = do
    InterpState ()
interp <- IO (InterpState ()) -> EventM n m (InterpState ())
forall a. IO a -> EventM n m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (InterpState ()) -> EventM n m (InterpState ()))
-> IO (InterpState ()) -> EventM n m (InterpState ())
forall a b. (a -> b) -> a -> b
$ do
        (ExceptT DaemonError IO (InterpState ())
-> IO (Either DaemonError (InterpState ()))
forall r. DaemonIO r -> IO (Either DaemonError r)
Daemon.run (ExceptT DaemonError IO (InterpState ())
 -> IO (Either DaemonError (InterpState ())))
-> (InterpState () -> ExceptT DaemonError IO (InterpState ()))
-> InterpState ()
-> IO (Either DaemonError (InterpState ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterpState () -> ExceptT DaemonError IO (InterpState ())
f) AppState n
appState.interpState IO (Either DaemonError (InterpState ()))
-> (Either DaemonError (InterpState ()) -> IO (InterpState ()))
-> IO (InterpState ())
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Right InterpState ()
out -> InterpState () -> IO (InterpState ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InterpState ()
out
            Left DaemonError
er -> FilePath -> IO (InterpState ())
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO (InterpState ()))
-> FilePath -> IO (InterpState ())
forall a b. (a -> b) -> a -> b
$ DaemonError -> FilePath
forall a. Show a => a -> FilePath
show DaemonError
er
    AppState n -> EventM n m (AppState n)
forall n m. Ord n => AppState n -> EventM n m (AppState n)
selectPausedLine AppState n
appState{interpState = interp}

-- | Alternative to 'runDaemon' which returns a value along with the state.
runDaemon2
    :: (Ord n)
    => (Daemon.InterpState () -> Daemon.DaemonIO (Daemon.InterpState (), a))
    -> AppState n
    -> B.EventM n m (AppState n, a)
runDaemon2 :: forall n a m.
Ord n =>
(InterpState () -> DaemonIO (InterpState (), a))
-> AppState n -> EventM n m (AppState n, a)
runDaemon2 InterpState () -> DaemonIO (InterpState (), a)
f AppState n
appState = do
    (InterpState ()
interp, a
x) <-
        IO (InterpState (), a) -> EventM n m (InterpState (), a)
forall a. IO a -> EventM n m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (InterpState (), a) -> EventM n m (InterpState (), a))
-> IO (InterpState (), a) -> EventM n m (InterpState (), a)
forall a b. (a -> b) -> a -> b
$
            (DaemonIO (InterpState (), a)
-> IO (Either DaemonError (InterpState (), a))
forall r. DaemonIO r -> IO (Either DaemonError r)
Daemon.run (DaemonIO (InterpState (), a)
 -> IO (Either DaemonError (InterpState (), a)))
-> (InterpState () -> DaemonIO (InterpState (), a))
-> InterpState ()
-> IO (Either DaemonError (InterpState (), a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterpState () -> DaemonIO (InterpState (), a)
f) AppState n
appState.interpState IO (Either DaemonError (InterpState (), a))
-> (Either DaemonError (InterpState (), a)
    -> IO (InterpState (), a))
-> IO (InterpState (), a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Right (InterpState (), a)
out -> (InterpState (), a) -> IO (InterpState (), a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InterpState (), a)
out
                Left DaemonError
er -> FilePath -> IO (InterpState (), a)
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO (InterpState (), a))
-> FilePath -> IO (InterpState (), a)
forall a b. (a -> b) -> a -> b
$ DaemonError -> FilePath
forall a. Show a => a -> FilePath
show DaemonError
er
    AppState n
newState <- AppState n -> EventM n m (AppState n)
forall n m. Ord n => AppState n -> EventM n m (AppState n)
selectPausedLine AppState n
appState{interpState = interp}
    (AppState n, a) -> EventM n m (AppState n, a)
forall a. a -> EventM n m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AppState n
newState, a
x)

-- | 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

-- | 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

-- -------------------------------------------------------------------------------------------------
-- 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