{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
module Brick.Main
  ( App(..)
  , defaultMain
  , customMain
  , customMainWithVty
  , customMainWithDefaultVty
  , simpleMain
  , resizeOrQuit
  , simpleApp

  -- * Event handler functions
  , continueWithoutRedraw
  , halt
  , suspendAndResume
  , suspendAndResume'
  , makeVisible
  , lookupViewport
  , lookupExtent
  , findClickedExtents
  , clickedExtent
  , getVtyHandle

  -- ** Viewport scrolling
  , viewportScroll
  , ViewportScroll
  , vScrollBy
  , vScrollPage
  , vScrollToBeginning
  , vScrollToEnd
  , hScrollBy
  , hScrollPage
  , hScrollToBeginning
  , hScrollToEnd
  , setTop
  , setLeft

  -- * Cursor management functions
  , neverShowCursor
  , showFirstCursor
  , showCursorNamed

  -- * Rendering cache management
  , invalidateCacheEntry
  , invalidateCache

  -- * Renderer internals (for benchmarking)
  , renderFinal
  , getRenderState
  , resetRenderState
  , renderWidget
  )
where

import qualified Control.Exception as E
import Lens.Micro ((^.), (&), (.~), (%~), _1, _2)
import Control.Monad
import Control.Monad.State.Strict
import Control.Monad.Reader
import Control.Concurrent (forkIO, killThread)
import qualified Data.Foldable as F
import Data.List (find)
import Data.Maybe (listToMaybe)
import qualified Data.Map as M
import qualified Data.Set as S
import Graphics.Vty
  ( Vty
  , Picture(..)
  , Cursor(..)
  , Event(..)
  , update
  , outputIface
  , displayBounds
  , shutdown
  , nextEvent
  , restoreInputState
  , inputIface
  )
import Graphics.Vty.CrossPlatform (mkVty)
import Graphics.Vty.Config (defaultConfig)
import Graphics.Vty.Attributes (defAttr)

import Brick.BChan (BChan, newBChan, readBChan, readBChan2, writeBChan)
import Brick.Types.EventM
import Brick.Types.Internal
import Brick.Widgets.Internal
import Brick.AttrMap

-- | The library application abstraction. Your application's operations
-- are provided in an @App@ and then the @App@ is provided to one of the
-- various main functions in this module. An application @App s e n@
-- is in terms of an application state type @s@, an application event
-- type @e@, and a resource name type @n@. In the simplest case 'e' is
-- unused (left polymorphic or set to @()@), but you may define your own
-- event type and use 'customMain' to provide custom events. The state
-- type @s@ is the type of application state to be provided by you and
-- iteratively modified by event handlers. The resource name type @n@
-- is the type of names you can assign to rendering resources such as
-- viewports and cursor locations. Your application must define this
-- type.
data App s e n =
    App { forall s e n. App s e n -> s -> [Widget n]
appDraw :: s -> [Widget n]
        -- ^ This function turns your application state into a list of
        -- widget layers. The layers are listed topmost first.
        , forall s e n.
App s e n -> s -> [CursorLocation n] -> Maybe (CursorLocation n)
appChooseCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n)
        -- ^ This function chooses which of the zero or more cursor
        -- locations reported by the rendering process should be
        -- selected as the one to use to place the cursor. If this
        -- returns 'Nothing', no cursor is placed. The rationale here
        -- is that many widgets may request a cursor placement but your
        -- application state is what you probably want to use to decide
        -- which one wins.
        , forall s e n. App s e n -> BrickEvent n e -> EventM n s ()
appHandleEvent :: BrickEvent n e -> EventM n s ()
        -- ^ This function handles an event and updates the current
        -- application state.
        , forall s e n. App s e n -> EventM n s ()
appStartEvent :: EventM n s ()
        -- ^ This function gets called once just prior to the first
        -- drawing of your application. Here is where you can make
        -- initial scrolling requests, for example.
        , forall s e n. App s e n -> s -> AttrMap
appAttrMap :: s -> AttrMap
        -- ^ The attribute map that should be used during rendering.
        }

-- | The default main entry point which takes an application and an
-- initial state and returns the final state from 'EventM' once the
-- program exits.
defaultMain :: (Ord n)
            => App s e n
            -- ^ The application.
            -> s
            -- ^ The initial application state.
            -> IO s
defaultMain :: forall n s e. Ord n => App s e n -> s -> IO s
defaultMain App s e n
app s
st = do
    (s
s, Vty
vty) <- Maybe (BChan e) -> App s e n -> s -> IO (s, Vty)
forall n e s.
Ord n =>
Maybe (BChan e) -> App s e n -> s -> IO (s, Vty)
customMainWithDefaultVty Maybe (BChan e)
forall a. Maybe a
Nothing App s e n
app s
st
    Vty -> IO ()
shutdown Vty
vty
    s -> IO s
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return s
s

-- | A simple main entry point which takes a widget and renders it. This
-- event loop terminates when the user presses any key, but terminal
-- resize events cause redraws.
simpleMain :: (Ord n)
           => Widget n
           -- ^ The widget to draw.
           -> IO ()
simpleMain :: forall n. Ord n => Widget n -> IO ()
simpleMain Widget n
w = App () Any n -> () -> IO ()
forall n s e. Ord n => App s e n -> s -> IO s
defaultMain (Widget n -> App () Any n
forall n s e. Widget n -> App s e n
simpleApp Widget n
w) ()

-- | A simple application with reasonable defaults to be overridden as
-- desired:
--
-- * Draws only the specified widget
-- * Quits on any event other than resizes
-- * Has no start event handler
-- * Provides no attribute map
-- * Never shows any cursors
simpleApp :: Widget n -> App s e n
simpleApp :: forall n s e. Widget n -> App s e n
simpleApp Widget n
w =
    App { appDraw :: s -> [Widget n]
appDraw = [Widget n] -> s -> [Widget n]
forall a b. a -> b -> a
const [Widget n
w]
        , appHandleEvent :: BrickEvent n e -> EventM n s ()
appHandleEvent = BrickEvent n e -> EventM n s ()
forall n e s. BrickEvent n e -> EventM n s ()
resizeOrQuit
        , appStartEvent :: EventM n s ()
appStartEvent = () -> EventM n s ()
forall a. a -> EventM n s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        , appAttrMap :: s -> AttrMap
appAttrMap = AttrMap -> s -> AttrMap
forall a b. a -> b -> a
const (AttrMap -> s -> AttrMap) -> AttrMap -> s -> AttrMap
forall a b. (a -> b) -> a -> b
$ Attr -> [(AttrName, Attr)] -> AttrMap
attrMap Attr
defAttr []
        , appChooseCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n)
appChooseCursor = s -> [CursorLocation n] -> Maybe (CursorLocation n)
forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
neverShowCursor
        }

-- | An event-handling function which continues execution of the event
-- loop only when resize events occur; all other types of events trigger
-- a halt. This is a convenience function useful as an 'appHandleEvent'
-- value for simple applications using the 'Event' type that do not need
-- to get more sophisticated user input.
resizeOrQuit :: BrickEvent n e -> EventM n s ()
resizeOrQuit :: forall n e s. BrickEvent n e -> EventM n s ()
resizeOrQuit (VtyEvent (EvResize Int
_ Int
_)) = () -> EventM n s ()
forall a. a -> EventM n s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
resizeOrQuit BrickEvent n e
_ = EventM n s ()
forall n s. EventM n s ()
halt

readBrickEvent :: BChan (BrickEvent n e) -> BChan e -> IO (BrickEvent n e)
readBrickEvent :: forall n e.
BChan (BrickEvent n e) -> BChan e -> IO (BrickEvent n e)
readBrickEvent BChan (BrickEvent n e)
brickChan BChan e
userChan = (BrickEvent n e -> BrickEvent n e)
-> (e -> BrickEvent n e)
-> Either (BrickEvent n e) e
-> BrickEvent n e
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either BrickEvent n e -> BrickEvent n e
forall a. a -> a
id e -> BrickEvent n e
forall n e. e -> BrickEvent n e
AppEvent (Either (BrickEvent n e) e -> BrickEvent n e)
-> IO (Either (BrickEvent n e) e) -> IO (BrickEvent n e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BChan (BrickEvent n e) -> BChan e -> IO (Either (BrickEvent n e) e)
forall a b. BChan a -> BChan b -> IO (Either a b)
readBChan2 BChan (BrickEvent n e)
brickChan BChan e
userChan

runWithVty :: (Ord n)
           => VtyContext
           -> BChan (BrickEvent n e)
           -> Maybe (BChan e)
           -> App s e n
           -> RenderState n
           -> s
           -> IO (s, VtyContext)
runWithVty :: forall n e s.
Ord n =>
VtyContext
-> BChan (BrickEvent n e)
-> Maybe (BChan e)
-> App s e n
-> RenderState n
-> s
-> IO (s, VtyContext)
runWithVty VtyContext
vtyCtx BChan (BrickEvent n e)
brickChan Maybe (BChan e)
mUserChan App s e n
app RenderState n
initialRS s
initialSt = do
    let readEvent :: IO (BrickEvent n e)
readEvent = case Maybe (BChan e)
mUserChan of
          Maybe (BChan e)
Nothing -> BChan (BrickEvent n e) -> IO (BrickEvent n e)
forall a. BChan a -> IO a
readBChan BChan (BrickEvent n e)
brickChan
          Just BChan e
uc -> BChan (BrickEvent n e) -> BChan e -> IO (BrickEvent n e)
forall n e.
BChan (BrickEvent n e) -> BChan e -> IO (BrickEvent n e)
readBrickEvent BChan (BrickEvent n e)
brickChan BChan e
uc
        runInner :: VtyContext
-> RenderState n -> [Extent n] -> Bool -> s -> IO (s, VtyContext)
runInner VtyContext
ctx RenderState n
rs [Extent n]
es Bool
draw s
st = do
          let nextRS :: RenderState n
nextRS = if Bool
draw
                       then RenderState n -> RenderState n
forall n. RenderState n -> RenderState n
resetRenderState RenderState n
rs
                       else RenderState n
rs
          (s
nextSt, NextAction
result, RenderState n
newRS, [Extent n]
newExtents, VtyContext
newCtx) <- VtyContext
-> IO (BrickEvent n e)
-> App s e n
-> s
-> RenderState n
-> [Extent n]
-> Bool
-> IO (s, NextAction, RenderState n, [Extent n], VtyContext)
forall n e s.
Ord n =>
VtyContext
-> IO (BrickEvent n e)
-> App s e n
-> s
-> RenderState n
-> [Extent n]
-> Bool
-> IO (s, NextAction, RenderState n, [Extent n], VtyContext)
runVty VtyContext
ctx IO (BrickEvent n e)
readEvent App s e n
app s
st RenderState n
nextRS [Extent n]
es Bool
draw
          case NextAction
result of
              NextAction
Halt ->
                  (s, VtyContext) -> IO (s, VtyContext)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (s
nextSt, VtyContext
newCtx)
              NextAction
Continue ->
                  VtyContext
-> RenderState n -> [Extent n] -> Bool -> s -> IO (s, VtyContext)
runInner VtyContext
newCtx RenderState n
newRS [Extent n]
newExtents Bool
True s
nextSt
              NextAction
ContinueWithoutRedraw ->
                  VtyContext
-> RenderState n -> [Extent n] -> Bool -> s -> IO (s, VtyContext)
runInner VtyContext
newCtx RenderState n
newRS [Extent n]
newExtents Bool
False s
nextSt

    VtyContext
-> RenderState n -> [Extent n] -> Bool -> s -> IO (s, VtyContext)
runInner VtyContext
vtyCtx RenderState n
initialRS [Extent n]
forall a. Monoid a => a
mempty Bool
True s
initialSt

-- | The custom event loop entry point to use when the simpler ones
-- don't permit enough control. Returns the final application state
-- after the application halts.
--
-- Note that this function guarantees that the terminal input state
-- prior to the first Vty initialization is the terminal input state
-- that is restored on shutdown (regardless of exceptions).
customMain :: (Ord n)
           => Vty
           -- ^ The initial Vty handle to use.
           -> IO Vty
           -- ^ An IO action to build a Vty handle. This is used
           -- to build a Vty handle whenever the event loop needs
           -- to reinitialize the terminal, e.g. on resume after
           -- suspension.
           -> Maybe (BChan e)
           -- ^ An event channel for sending custom events to the event
           -- loop (you write to this channel, the event loop reads from
           -- it). Provide 'Nothing' if you don't plan on sending custom
           -- events.
           -> App s e n
           -- ^ The application.
           -> s
           -- ^ The initial application state.
           -> IO s
customMain :: forall n e s.
Ord n =>
Vty -> IO Vty -> Maybe (BChan e) -> App s e n -> s -> IO s
customMain Vty
initialVty IO Vty
buildVty Maybe (BChan e)
mUserChan App s e n
app s
initialAppState = do
    let restoreInitialState :: IO ()
restoreInitialState = Input -> IO ()
restoreInputState (Input -> IO ()) -> Input -> IO ()
forall a b. (a -> b) -> a -> b
$ Vty -> Input
inputIface Vty
initialVty

    (s
s, Vty
vty) <- Vty -> IO Vty -> Maybe (BChan e) -> App s e n -> s -> IO (s, Vty)
forall n e s.
Ord n =>
Vty -> IO Vty -> Maybe (BChan e) -> App s e n -> s -> IO (s, Vty)
customMainWithVty Vty
initialVty IO Vty
buildVty Maybe (BChan e)
mUserChan App s e n
app s
initialAppState
        IO (s, Vty) -> (SomeException -> IO (s, Vty)) -> IO (s, Vty)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` (\(SomeException
e::E.SomeException) -> IO ()
restoreInitialState IO () -> IO (s, Vty) -> IO (s, Vty)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> IO (s, Vty)
forall a e. Exception e => e -> a
E.throw SomeException
e)

    Vty -> IO ()
shutdown Vty
vty
    IO ()
restoreInitialState
    s -> IO s
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return s
s

-- | Like 'customMainWithVty', except that Vty is initialized with the
-- default configuration.
customMainWithDefaultVty :: (Ord n)
                         => Maybe (BChan e)
                         -- ^ An event channel for sending custom
                         -- events to the event loop (you write to this
                         -- channel, the event loop reads from it).
                         -- Provide 'Nothing' if you don't plan on
                         -- sending custom events.
                         -> App s e n
                         -- ^ The application.
                         -> s
                         -- ^ The initial application state.
                         -> IO (s, Vty)
customMainWithDefaultVty :: forall n e s.
Ord n =>
Maybe (BChan e) -> App s e n -> s -> IO (s, Vty)
customMainWithDefaultVty Maybe (BChan e)
mUserChan App s e n
app s
initialAppState = do
    let builder :: IO Vty
builder = VtyUserConfig -> IO Vty
mkVty VtyUserConfig
defaultConfig
    Vty
vty <- IO Vty
builder
    Vty -> IO Vty -> Maybe (BChan e) -> App s e n -> s -> IO (s, Vty)
forall n e s.
Ord n =>
Vty -> IO Vty -> Maybe (BChan e) -> App s e n -> s -> IO (s, Vty)
customMainWithVty Vty
vty IO Vty
builder Maybe (BChan e)
mUserChan App s e n
app s
initialAppState

-- | Like 'customMain', except the last 'Vty' handle used by the
-- application is returned without being shut down with 'shutdown'. This
-- allows the caller to re-use the 'Vty' handle for something else, such
-- as another Brick application.
customMainWithVty :: (Ord n)
                  => Vty
                  -- ^ The initial Vty handle to use.
                  -> IO Vty
                  -- ^ An IO action to build a Vty handle. This is used
                  -- to build a Vty handle whenever the event loop needs
                  -- to reinitialize the terminal, e.g. on resume after
                  -- suspension.
                  -> Maybe (BChan e)
                  -- ^ An event channel for sending custom events to the event
                  -- loop (you write to this channel, the event loop reads from
                  -- it). Provide 'Nothing' if you don't plan on sending custom
                  -- events.
                  -> App s e n
                  -- ^ The application.
                  -> s
                  -- ^ The initial application state.
                  -> IO (s, Vty)
customMainWithVty :: forall n e s.
Ord n =>
Vty -> IO Vty -> Maybe (BChan e) -> App s e n -> s -> IO (s, Vty)
customMainWithVty Vty
initialVty IO Vty
buildVty Maybe (BChan e)
mUserChan App s e n
app s
initialAppState = do
    BChan (BrickEvent n e)
brickChan <- Int -> IO (BChan (BrickEvent n e))
forall a. Int -> IO (BChan a)
newBChan Int
20
    VtyContext
vtyCtx <- IO Vty -> Maybe Vty -> (Event -> IO ()) -> IO VtyContext
newVtyContext IO Vty
buildVty (Vty -> Maybe Vty
forall a. a -> Maybe a
Just Vty
initialVty) (BChan (BrickEvent n e) -> BrickEvent n e -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan (BrickEvent n e)
brickChan (BrickEvent n e -> IO ())
-> (Event -> BrickEvent n e) -> Event -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> BrickEvent n e
forall n e. Event -> BrickEvent n e
VtyEvent)

    let emptyES :: EventState n
emptyES = ES { esScrollRequests :: [(n, ScrollRequest)]
esScrollRequests = []
                     , cacheInvalidateRequests :: Set (CacheInvalidateRequest n)
cacheInvalidateRequests = Set (CacheInvalidateRequest n)
forall a. Monoid a => a
mempty
                     , requestedVisibleNames :: Set n
requestedVisibleNames = Set n
forall a. Monoid a => a
mempty
                     , nextAction :: NextAction
nextAction = NextAction
Continue
                     , vtyContext :: VtyContext
vtyContext = VtyContext
vtyCtx
                     }
        emptyRS :: RenderState n
emptyRS = Map n Viewport
-> [(n, ScrollRequest)]
-> Set n
-> Map n ([n], Result n)
-> [n]
-> Set n
-> Map n (Extent n)
-> RenderState n
forall n.
Map n Viewport
-> [(n, ScrollRequest)]
-> Set n
-> Map n ([n], Result n)
-> [n]
-> Set n
-> Map n (Extent n)
-> RenderState n
RS Map n Viewport
forall k a. Map k a
M.empty [(n, ScrollRequest)]
forall a. Monoid a => a
mempty Set n
forall a. Set a
S.empty Map n ([n], Result n)
forall a. Monoid a => a
mempty [n]
forall a. Monoid a => a
mempty Set n
forall a. Monoid a => a
mempty Map n (Extent n)
forall a. Monoid a => a
mempty
        eventRO :: EventRO n
eventRO = Map n Viewport -> [Extent n] -> RenderState n -> EventRO n
forall n.
Map n Viewport -> [Extent n] -> RenderState n -> EventRO n
EventRO Map n Viewport
forall k a. Map k a
M.empty [Extent n]
forall a. Monoid a => a
mempty RenderState n
emptyRS

    (((), s
appState), EventState n
eState) <- StateT (EventState n) IO ((), s)
-> EventState n -> IO (((), s), EventState n)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (StateT s (StateT (EventState n) IO) ()
-> s -> StateT (EventState n) IO ((), s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
-> EventRO n -> StateT s (StateT (EventState n) IO) ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (EventM n s ()
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
forall n s a.
EventM n s a
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) a
runEventM (App s e n -> EventM n s ()
forall s e n. App s e n -> EventM n s ()
appStartEvent App s e n
app)) EventRO n
eventRO) s
initialAppState) EventState n
emptyES
    let initialRS :: RenderState n
initialRS = RS { viewportMap :: Map n Viewport
viewportMap = Map n Viewport
forall k a. Map k a
M.empty
                       , rsScrollRequests :: [(n, ScrollRequest)]
rsScrollRequests = EventState n -> [(n, ScrollRequest)]
forall n. EventState n -> [(n, ScrollRequest)]
esScrollRequests EventState n
eState
                       , observedNames :: Set n
observedNames = Set n
forall a. Set a
S.empty
                       , renderCache :: Map n ([n], Result n)
renderCache = Map n ([n], Result n)
forall a. Monoid a => a
mempty
                       , clickableNames :: [n]
clickableNames = []
                       , requestedVisibleNames_ :: Set n
requestedVisibleNames_ = EventState n -> Set n
forall n. EventState n -> Set n
requestedVisibleNames EventState n
eState
                       , reportedExtents :: Map n (Extent n)
reportedExtents = Map n (Extent n)
forall a. Monoid a => a
mempty
                       }

    (s
s, VtyContext
ctx) <- VtyContext
-> BChan (BrickEvent n e)
-> Maybe (BChan e)
-> App s e n
-> RenderState n
-> s
-> IO (s, VtyContext)
forall n e s.
Ord n =>
VtyContext
-> BChan (BrickEvent n e)
-> Maybe (BChan e)
-> App s e n
-> RenderState n
-> s
-> IO (s, VtyContext)
runWithVty VtyContext
vtyCtx BChan (BrickEvent n e)
brickChan Maybe (BChan e)
mUserChan App s e n
app RenderState n
initialRS s
appState
                IO (s, VtyContext)
-> (SomeException -> IO (s, VtyContext)) -> IO (s, VtyContext)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` (\(SomeException
e::E.SomeException) -> VtyContext -> IO ()
shutdownVtyContext VtyContext
vtyCtx IO () -> IO (s, VtyContext) -> IO (s, VtyContext)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> IO (s, VtyContext)
forall a e. Exception e => e -> a
E.throw SomeException
e)

    -- Shut down the context's event thread but do NOT shut down Vty
    -- itself because we want the handle to be live when we return it to
    -- the caller.
    VtyContext -> IO ()
shutdownVtyContextThread VtyContext
ctx
    (s, Vty) -> IO (s, Vty)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, VtyContext -> Vty
vtyContextHandle VtyContext
ctx)

supplyVtyEvents :: Vty -> (Event -> IO ()) -> IO ()
supplyVtyEvents :: Vty -> (Event -> IO ()) -> IO ()
supplyVtyEvents Vty
vty Event -> IO ()
putEvent =
    IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Event -> IO ()
putEvent (Event -> IO ()) -> IO Event -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Vty -> IO Event
nextEvent Vty
vty

newVtyContextFrom :: VtyContext -> IO VtyContext
newVtyContextFrom :: VtyContext -> IO VtyContext
newVtyContextFrom VtyContext
old =
    IO Vty -> Maybe Vty -> (Event -> IO ()) -> IO VtyContext
newVtyContext (VtyContext -> IO Vty
vtyContextBuilder VtyContext
old) Maybe Vty
forall a. Maybe a
Nothing (VtyContext -> Event -> IO ()
vtyContextPutEvent VtyContext
old)

newVtyContext :: IO Vty -> Maybe Vty -> (Event -> IO ()) -> IO VtyContext
newVtyContext :: IO Vty -> Maybe Vty -> (Event -> IO ()) -> IO VtyContext
newVtyContext IO Vty
builder Maybe Vty
handle Event -> IO ()
putEvent = do
    Vty
vty <- case Maybe Vty
handle of
        Just Vty
h -> Vty -> IO Vty
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Vty
h
        Maybe Vty
Nothing -> IO Vty
builder
    ThreadId
tId <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Vty -> (Event -> IO ()) -> IO ()
supplyVtyEvents Vty
vty Event -> IO ()
putEvent
    VtyContext -> IO VtyContext
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VtyContext { vtyContextHandle :: Vty
vtyContextHandle = Vty
vty
                      , vtyContextBuilder :: IO Vty
vtyContextBuilder = IO Vty
builder
                      , vtyContextThread :: ThreadId
vtyContextThread = ThreadId
tId
                      , vtyContextPutEvent :: Event -> IO ()
vtyContextPutEvent = Event -> IO ()
putEvent
                      }

shutdownVtyContext :: VtyContext -> IO ()
shutdownVtyContext :: VtyContext -> IO ()
shutdownVtyContext VtyContext
ctx = do
    Vty -> IO ()
shutdown (Vty -> IO ()) -> Vty -> IO ()
forall a b. (a -> b) -> a -> b
$ VtyContext -> Vty
vtyContextHandle VtyContext
ctx
    VtyContext -> IO ()
shutdownVtyContextThread VtyContext
ctx

shutdownVtyContextThread :: VtyContext -> IO ()
shutdownVtyContextThread :: VtyContext -> IO ()
shutdownVtyContextThread VtyContext
ctx =
    ThreadId -> IO ()
killThread (ThreadId -> IO ()) -> ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ VtyContext -> ThreadId
vtyContextThread VtyContext
ctx

runVty :: (Ord n)
       => VtyContext
       -> IO (BrickEvent n e)
       -> App s e n
       -> s
       -> RenderState n
       -> [Extent n]
       -> Bool
       -> IO (s, NextAction, RenderState n, [Extent n], VtyContext)
runVty :: forall n e s.
Ord n =>
VtyContext
-> IO (BrickEvent n e)
-> App s e n
-> s
-> RenderState n
-> [Extent n]
-> Bool
-> IO (s, NextAction, RenderState n, [Extent n], VtyContext)
runVty VtyContext
vtyCtx IO (BrickEvent n e)
readEvent App s e n
app s
appState RenderState n
rs [Extent n]
prevExtents Bool
draw = do
    (RenderState n
firstRS, [Extent n]
exts) <- if Bool
draw
                       then VtyContext
-> App s e n
-> s
-> RenderState n
-> IO (RenderState n, [Extent n])
forall n s e.
Ord n =>
VtyContext
-> App s e n
-> s
-> RenderState n
-> IO (RenderState n, [Extent n])
renderApp VtyContext
vtyCtx App s e n
app s
appState RenderState n
rs
                       else (RenderState n, [Extent n]) -> IO (RenderState n, [Extent n])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RenderState n
rs, [Extent n]
prevExtents)

    BrickEvent n e
e <- IO (BrickEvent n e)
readEvent

    (BrickEvent n e
e', RenderState n
nextRS, [Extent n]
nextExts) <- case BrickEvent n e
e of
        -- If the event was a resize, redraw the UI to update the
        -- viewport states before we invoke the event handler since we
        -- want the event handler to have access to accurate viewport
        -- information.
        VtyEvent (EvResize Int
_ Int
_) -> do
            (RenderState n
rs', [Extent n]
exts') <- VtyContext
-> App s e n
-> s
-> RenderState n
-> IO (RenderState n, [Extent n])
forall n s e.
Ord n =>
VtyContext
-> App s e n
-> s
-> RenderState n
-> IO (RenderState n, [Extent n])
renderApp VtyContext
vtyCtx App s e n
app s
appState (RenderState n -> IO (RenderState n, [Extent n]))
-> RenderState n -> IO (RenderState n, [Extent n])
forall a b. (a -> b) -> a -> b
$ RenderState n
firstRS RenderState n -> (RenderState n -> RenderState n) -> RenderState n
forall a b. a -> (a -> b) -> b
& (Set n -> Identity (Set n))
-> RenderState n -> Identity (RenderState n)
forall n (f :: * -> *).
Functor f =>
(Set n -> f (Set n)) -> RenderState n -> f (RenderState n)
observedNamesL ((Set n -> Identity (Set n))
 -> RenderState n -> Identity (RenderState n))
-> Set n -> RenderState n -> RenderState n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set n
forall a. Set a
S.empty
            (BrickEvent n e, RenderState n, [Extent n])
-> IO (BrickEvent n e, RenderState n, [Extent n])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BrickEvent n e
e, RenderState n
rs', [Extent n]
exts')
        VtyEvent (EvMouseDown Int
c Int
r Button
button [Modifier]
mods) -> do
            let matching :: [Extent n]
matching = (Int, Int) -> [Extent n] -> [Extent n]
forall n. (Int, Int) -> [Extent n] -> [Extent n]
findClickedExtents_ (Int
c, Int
r) [Extent n]
exts
            case [Extent n]
matching of
                (Extent n
n (Location (Int
ec, Int
er)) (Int, Int)
_:[Extent n]
_) ->
                    -- If the clicked extent was registered as
                    -- clickable, send a click event. Otherwise, just
                    -- send the raw mouse event
                    if n
n n -> [n] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` RenderState n
firstRSRenderState n -> Getting [n] (RenderState n) [n] -> [n]
forall s a. s -> Getting a s a -> a
^.Getting [n] (RenderState n) [n]
forall n (f :: * -> *).
Functor f =>
([n] -> f [n]) -> RenderState n -> f (RenderState n)
clickableNamesL
                    then do
                        let localCoords :: Location
localCoords = (Int, Int) -> Location
Location (Int
lc, Int
lr)
                            lc :: Int
lc = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ec
                            lr :: Int
lr = Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
er

                            -- If the clicked extent was a viewport,
                            -- adjust the local coordinates by
                            -- adding the viewport upper-left corner
                            -- offset.
                            newCoords :: Location
newCoords = case n -> Map n Viewport -> Maybe Viewport
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup n
n (RenderState n -> Map n Viewport
forall n. RenderState n -> Map n Viewport
viewportMap RenderState n
firstRS) of
                              Maybe Viewport
Nothing -> Location
localCoords
                              Just Viewport
vp -> Location
localCoords Location -> (Location -> Location) -> Location
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> Location -> Identity Location
forall s t a b. Field1 s t a b => Lens s t a b
Lens Location Location Int Int
_1 ((Int -> Identity Int) -> Location -> Identity Location)
-> (Int -> Int) -> Location -> Location
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Viewport
vpViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Viewport Int
Lens' Viewport Int
vpLeft))
                                                     Location -> (Location -> Location) -> Location
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> Location -> Identity Location
forall s t a b. Field2 s t a b => Lens s t a b
Lens Location Location Int Int
_2 ((Int -> Identity Int) -> Location -> Identity Location)
-> (Int -> Int) -> Location -> Location
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Viewport
vpViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Viewport Int
Lens' Viewport Int
vpTop))

                        (BrickEvent n e, RenderState n, [Extent n])
-> IO (BrickEvent n e, RenderState n, [Extent n])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (n -> Button -> [Modifier] -> Location -> BrickEvent n e
forall n e. n -> Button -> [Modifier] -> Location -> BrickEvent n e
MouseDown n
n Button
button [Modifier]
mods Location
newCoords, RenderState n
firstRS, [Extent n]
exts)
                    else (BrickEvent n e, RenderState n, [Extent n])
-> IO (BrickEvent n e, RenderState n, [Extent n])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BrickEvent n e
e, RenderState n
firstRS, [Extent n]
exts)
                [Extent n]
_ -> (BrickEvent n e, RenderState n, [Extent n])
-> IO (BrickEvent n e, RenderState n, [Extent n])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BrickEvent n e
e, RenderState n
firstRS, [Extent n]
exts)
        VtyEvent (EvMouseUp Int
c Int
r Maybe Button
button) -> do
            let matching :: [Extent n]
matching = (Int, Int) -> [Extent n] -> [Extent n]
forall n. (Int, Int) -> [Extent n] -> [Extent n]
findClickedExtents_ (Int
c, Int
r) [Extent n]
exts
            case [Extent n]
matching of
                (Extent n
n (Location (Int
ec, Int
er)) (Int, Int)
_:[Extent n]
_) ->
                    -- If the clicked extent was registered as
                    -- clickable, send a click event. Otherwise, just
                    -- send the raw mouse event
                    if n
n n -> [n] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` RenderState n
firstRSRenderState n -> Getting [n] (RenderState n) [n] -> [n]
forall s a. s -> Getting a s a -> a
^.Getting [n] (RenderState n) [n]
forall n (f :: * -> *).
Functor f =>
([n] -> f [n]) -> RenderState n -> f (RenderState n)
clickableNamesL
                    then do
                        let localCoords :: Location
localCoords = (Int, Int) -> Location
Location (Int
lc, Int
lr)
                            lc :: Int
lc = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ec
                            lr :: Int
lr = Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
er
                            -- If the clicked extent was a viewport,
                            -- adjust the local coordinates by
                            -- adding the viewport upper-left corner
                            -- offset.
                            newCoords :: Location
newCoords = case n -> Map n Viewport -> Maybe Viewport
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup n
n (RenderState n -> Map n Viewport
forall n. RenderState n -> Map n Viewport
viewportMap RenderState n
firstRS) of
                              Maybe Viewport
Nothing -> Location
localCoords
                              Just Viewport
vp -> Location
localCoords Location -> (Location -> Location) -> Location
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> Location -> Identity Location
forall s t a b. Field1 s t a b => Lens s t a b
Lens Location Location Int Int
_1 ((Int -> Identity Int) -> Location -> Identity Location)
-> (Int -> Int) -> Location -> Location
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Viewport
vpViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Viewport Int
Lens' Viewport Int
vpLeft))
                                                     Location -> (Location -> Location) -> Location
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> Location -> Identity Location
forall s t a b. Field2 s t a b => Lens s t a b
Lens Location Location Int Int
_2 ((Int -> Identity Int) -> Location -> Identity Location)
-> (Int -> Int) -> Location -> Location
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Viewport
vpViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Viewport Int
Lens' Viewport Int
vpTop))
                        (BrickEvent n e, RenderState n, [Extent n])
-> IO (BrickEvent n e, RenderState n, [Extent n])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (n -> Maybe Button -> Location -> BrickEvent n e
forall n e. n -> Maybe Button -> Location -> BrickEvent n e
MouseUp n
n Maybe Button
button Location
newCoords, RenderState n
firstRS, [Extent n]
exts)
                    else (BrickEvent n e, RenderState n, [Extent n])
-> IO (BrickEvent n e, RenderState n, [Extent n])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BrickEvent n e
e, RenderState n
firstRS, [Extent n]
exts)
                [Extent n]
_ -> (BrickEvent n e, RenderState n, [Extent n])
-> IO (BrickEvent n e, RenderState n, [Extent n])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BrickEvent n e
e, RenderState n
firstRS, [Extent n]
exts)
        BrickEvent n e
_ -> (BrickEvent n e, RenderState n, [Extent n])
-> IO (BrickEvent n e, RenderState n, [Extent n])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BrickEvent n e
e, RenderState n
firstRS, [Extent n]
exts)

    let emptyES :: EventState n
emptyES = [(n, ScrollRequest)]
-> Set (CacheInvalidateRequest n)
-> Set n
-> NextAction
-> VtyContext
-> EventState n
forall n.
[(n, ScrollRequest)]
-> Set (CacheInvalidateRequest n)
-> Set n
-> NextAction
-> VtyContext
-> EventState n
ES [] Set (CacheInvalidateRequest n)
forall a. Monoid a => a
mempty Set n
forall a. Monoid a => a
mempty NextAction
Continue VtyContext
vtyCtx
        eventRO :: EventRO n
eventRO = Map n Viewport -> [Extent n] -> RenderState n -> EventRO n
forall n.
Map n Viewport -> [Extent n] -> RenderState n -> EventRO n
EventRO (RenderState n -> Map n Viewport
forall n. RenderState n -> Map n Viewport
viewportMap RenderState n
nextRS) [Extent n]
nextExts RenderState n
nextRS

    (((), s
newAppState), EventState n
eState) <- StateT (EventState n) IO ((), s)
-> EventState n -> IO (((), s), EventState n)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (StateT s (StateT (EventState n) IO) ()
-> s -> StateT (EventState n) IO ((), s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
-> EventRO n -> StateT s (StateT (EventState n) IO) ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (EventM n s ()
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
forall n s a.
EventM n s a
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) a
runEventM (App s e n -> BrickEvent n e -> EventM n s ()
forall s e n. App s e n -> BrickEvent n e -> EventM n s ()
appHandleEvent App s e n
app BrickEvent n e
e'))
                                EventRO n
eventRO) s
appState) EventState n
emptyES
    (s, NextAction, RenderState n, [Extent n], VtyContext)
-> IO (s, NextAction, RenderState n, [Extent n], VtyContext)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ( s
newAppState
           , EventState n -> NextAction
forall n. EventState n -> NextAction
nextAction EventState n
eState
           , RenderState n
nextRS { rsScrollRequests = esScrollRequests eState
                    , renderCache = applyInvalidations (cacheInvalidateRequests eState) $
                                    renderCache nextRS
                    , requestedVisibleNames_ = requestedVisibleNames eState
                    }
           , [Extent n]
nextExts
           , EventState n -> VtyContext
forall n. EventState n -> VtyContext
vtyContext EventState n
eState
           )

applyInvalidations :: (Ord n) => S.Set (CacheInvalidateRequest n) -> M.Map n v -> M.Map n v
applyInvalidations :: forall n v.
Ord n =>
Set (CacheInvalidateRequest n) -> Map n v -> Map n v
applyInvalidations Set (CacheInvalidateRequest n)
ns Map n v
cache =
    if CacheInvalidateRequest n
forall n. CacheInvalidateRequest n
InvalidateEntire CacheInvalidateRequest n -> Set (CacheInvalidateRequest n) -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set (CacheInvalidateRequest n)
ns
    then Map n v
forall a. Monoid a => a
mempty
    else ((Map n v -> Map n v)
 -> (Map n v -> Map n v) -> Map n v -> Map n v)
-> (Map n v -> Map n v)
-> [Map n v -> Map n v]
-> Map n v
-> Map n v
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Map n v -> Map n v) -> (Map n v -> Map n v) -> Map n v -> Map n v
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Map n v -> Map n v
forall a. a -> a
id (CacheInvalidateRequest n -> Map n v -> Map n v
forall {k} {a}.
Ord k =>
CacheInvalidateRequest k -> Map k a -> Map k a
mkFunc (CacheInvalidateRequest n -> Map n v -> Map n v)
-> [CacheInvalidateRequest n] -> [Map n v -> Map n v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (CacheInvalidateRequest n) -> [CacheInvalidateRequest n]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Set (CacheInvalidateRequest n)
ns) Map n v
cache
    where
        mkFunc :: CacheInvalidateRequest k -> Map k a -> Map k a
mkFunc CacheInvalidateRequest k
InvalidateEntire = Map k a -> Map k a -> Map k a
forall a b. a -> b -> a
const Map k a
forall a. Monoid a => a
mempty
        mkFunc (InvalidateSingle k
n) = k -> Map k a -> Map k a
forall k a. Ord k => k -> Map k a -> Map k a
M.delete k
n

-- | Given a viewport name, get the viewport's size and offset
-- information from the most recent rendering. Returns 'Nothing' if
-- no such state could be found, either because the name was invalid
-- or because no rendering has occurred (e.g. in an 'appStartEvent'
-- handler). An important consequence of this behavior is that if this
-- function is called before a viewport is rendered for the first
-- time, no state will be found because the renderer only knows about
-- viewports it has rendered in the most recent rendering. As a result,
-- if you need to make viewport transformations before they are drawn
-- for the first time, you may need to use 'viewportScroll' and its
-- associated functions without relying on this function. Those
-- functions queue up scrolling requests that can be made in advance of
-- the next rendering to affect the viewport.
lookupViewport :: (Ord n) => n -> EventM n s (Maybe Viewport)
lookupViewport :: forall n s. Ord n => n -> EventM n s (Maybe Viewport)
lookupViewport n
n = ReaderT
  (EventRO n) (StateT s (StateT (EventState n) IO)) (Maybe Viewport)
-> EventM n s (Maybe Viewport)
forall n s a.
ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) a
-> EventM n s a
EventM (ReaderT
   (EventRO n) (StateT s (StateT (EventState n) IO)) (Maybe Viewport)
 -> EventM n s (Maybe Viewport))
-> ReaderT
     (EventRO n) (StateT s (StateT (EventState n) IO)) (Maybe Viewport)
-> EventM n s (Maybe Viewport)
forall a b. (a -> b) -> a -> b
$ (EventRO n -> Maybe Viewport)
-> ReaderT
     (EventRO n) (StateT s (StateT (EventState n) IO)) (Maybe Viewport)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (n -> Map n Viewport -> Maybe Viewport
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup n
n (Map n Viewport -> Maybe Viewport)
-> (EventRO n -> Map n Viewport) -> EventRO n -> Maybe Viewport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventRO n -> Map n Viewport
forall n. EventRO n -> Map n Viewport
eventViewportMap)

-- | Did the specified mouse coordinates (column, row) intersect the
-- specified extent?
clickedExtent :: (Int, Int) -> Extent n -> Bool
clickedExtent :: forall n. (Int, Int) -> Extent n -> Bool
clickedExtent (Int
c, Int
r) (Extent n
_ (Location (Int
lc, Int
lr)) (Int
w, Int
h)) =
   Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lc Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Int
lc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w) Bool -> Bool -> Bool
&&
   Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lr Bool -> Bool -> Bool
&& Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Int
lr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
h)

-- | Given a resource name, get the most recent rendering extent for the
-- name (if any).
lookupExtent :: (Eq n) => n -> EventM n s (Maybe (Extent n))
lookupExtent :: forall n s. Eq n => n -> EventM n s (Maybe (Extent n))
lookupExtent n
n = ReaderT
  (EventRO n)
  (StateT s (StateT (EventState n) IO))
  (Maybe (Extent n))
-> EventM n s (Maybe (Extent n))
forall n s a.
ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) a
-> EventM n s a
EventM (ReaderT
   (EventRO n)
   (StateT s (StateT (EventState n) IO))
   (Maybe (Extent n))
 -> EventM n s (Maybe (Extent n)))
-> ReaderT
     (EventRO n)
     (StateT s (StateT (EventState n) IO))
     (Maybe (Extent n))
-> EventM n s (Maybe (Extent n))
forall a b. (a -> b) -> a -> b
$ (EventRO n -> Maybe (Extent n))
-> ReaderT
     (EventRO n)
     (StateT s (StateT (EventState n) IO))
     (Maybe (Extent n))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((Extent n -> Bool) -> [Extent n] -> Maybe (Extent n)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Extent n -> Bool
f ([Extent n] -> Maybe (Extent n))
-> (EventRO n -> [Extent n]) -> EventRO n -> Maybe (Extent n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventRO n -> [Extent n]
forall n. EventRO n -> [Extent n]
latestExtents)
    where
        f :: Extent n -> Bool
f (Extent n
n' Location
_ (Int, Int)
_) = n
n n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
n'

-- | Given a mouse click location, return the extents intersected by the
-- click. The returned extents are sorted such that the first extent in
-- the list is the most specific extent and the last extent is the most
-- generic (top-level). So if two extents A and B both intersected the
-- mouse click but A contains B, then they would be returned [B, A].
findClickedExtents :: (Int, Int) -> EventM n s [Extent n]
findClickedExtents :: forall n s. (Int, Int) -> EventM n s [Extent n]
findClickedExtents (Int, Int)
pos = ReaderT
  (EventRO n) (StateT s (StateT (EventState n) IO)) [Extent n]
-> EventM n s [Extent n]
forall n s a.
ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) a
-> EventM n s a
EventM (ReaderT
   (EventRO n) (StateT s (StateT (EventState n) IO)) [Extent n]
 -> EventM n s [Extent n])
-> ReaderT
     (EventRO n) (StateT s (StateT (EventState n) IO)) [Extent n]
-> EventM n s [Extent n]
forall a b. (a -> b) -> a -> b
$ (EventRO n -> [Extent n])
-> ReaderT
     (EventRO n) (StateT s (StateT (EventState n) IO)) [Extent n]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((Int, Int) -> [Extent n] -> [Extent n]
forall n. (Int, Int) -> [Extent n] -> [Extent n]
findClickedExtents_ (Int, Int)
pos ([Extent n] -> [Extent n])
-> (EventRO n -> [Extent n]) -> EventRO n -> [Extent n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventRO n -> [Extent n]
forall n. EventRO n -> [Extent n]
latestExtents)

findClickedExtents_ :: (Int, Int) -> [Extent n] -> [Extent n]
findClickedExtents_ :: forall n. (Int, Int) -> [Extent n] -> [Extent n]
findClickedExtents_ (Int, Int)
pos = [Extent n] -> [Extent n]
forall a. [a] -> [a]
reverse ([Extent n] -> [Extent n])
-> ([Extent n] -> [Extent n]) -> [Extent n] -> [Extent n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Extent n -> Bool) -> [Extent n] -> [Extent n]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int, Int) -> Extent n -> Bool
forall n. (Int, Int) -> Extent n -> Bool
clickedExtent (Int, Int)
pos)

-- | Get the Vty handle currently in use.
getVtyHandle :: EventM n s Vty
getVtyHandle :: forall n s. EventM n s Vty
getVtyHandle = VtyContext -> Vty
vtyContextHandle (VtyContext -> Vty) -> EventM n s VtyContext -> EventM n s Vty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EventM n s VtyContext
forall n s. EventM n s VtyContext
getVtyContext

setVtyContext :: VtyContext -> EventM n s ()
setVtyContext :: forall n s. VtyContext -> EventM n s ()
setVtyContext VtyContext
ctx =
    ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
-> EventM n s ()
forall n s a.
ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) a
-> EventM n s a
EventM (ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
 -> EventM n s ())
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
-> EventM n s ()
forall a b. (a -> b) -> a -> b
$ StateT s (StateT (EventState n) IO) ()
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT (EventRO n) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT s (StateT (EventState n) IO) ()
 -> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ())
-> StateT s (StateT (EventState n) IO) ()
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
forall a b. (a -> b) -> a -> b
$ StateT (EventState n) IO ()
-> StateT s (StateT (EventState n) IO) ()
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (EventState n) IO ()
 -> StateT s (StateT (EventState n) IO) ())
-> StateT (EventState n) IO ()
-> StateT s (StateT (EventState n) IO) ()
forall a b. (a -> b) -> a -> b
$ (EventState n -> EventState n) -> StateT (EventState n) IO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((EventState n -> EventState n) -> StateT (EventState n) IO ())
-> (EventState n -> EventState n) -> StateT (EventState n) IO ()
forall a b. (a -> b) -> a -> b
$ \EventState n
s -> EventState n
s { vtyContext = ctx }

-- | Invalidate the rendering cache entry with the specified resource
-- name.
invalidateCacheEntry :: (Ord n) => n -> EventM n s ()
invalidateCacheEntry :: forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry n
n = ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
-> EventM n s ()
forall n s a.
ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) a
-> EventM n s a
EventM (ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
 -> EventM n s ())
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
-> EventM n s ()
forall a b. (a -> b) -> a -> b
$ do
    StateT s (StateT (EventState n) IO) ()
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT (EventRO n) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT s (StateT (EventState n) IO) ()
 -> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ())
-> StateT s (StateT (EventState n) IO) ()
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
forall a b. (a -> b) -> a -> b
$ StateT (EventState n) IO ()
-> StateT s (StateT (EventState n) IO) ()
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (EventState n) IO ()
 -> StateT s (StateT (EventState n) IO) ())
-> StateT (EventState n) IO ()
-> StateT s (StateT (EventState n) IO) ()
forall a b. (a -> b) -> a -> b
$ (EventState n -> EventState n) -> StateT (EventState n) IO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EventState n
s -> EventState n
s { cacheInvalidateRequests = S.insert (InvalidateSingle n) $ cacheInvalidateRequests s })

-- | Invalidate the entire rendering cache.
invalidateCache :: (Ord n) => EventM n s ()
invalidateCache :: forall n s. Ord n => EventM n s ()
invalidateCache = ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
-> EventM n s ()
forall n s a.
ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) a
-> EventM n s a
EventM (ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
 -> EventM n s ())
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
-> EventM n s ()
forall a b. (a -> b) -> a -> b
$ do
    StateT s (StateT (EventState n) IO) ()
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT (EventRO n) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT s (StateT (EventState n) IO) ()
 -> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ())
-> StateT s (StateT (EventState n) IO) ()
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
forall a b. (a -> b) -> a -> b
$ StateT (EventState n) IO ()
-> StateT s (StateT (EventState n) IO) ()
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (EventState n) IO ()
 -> StateT s (StateT (EventState n) IO) ())
-> StateT (EventState n) IO ()
-> StateT s (StateT (EventState n) IO) ()
forall a b. (a -> b) -> a -> b
$ (EventState n -> EventState n) -> StateT (EventState n) IO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EventState n
s -> EventState n
s { cacheInvalidateRequests = S.insert InvalidateEntire $ cacheInvalidateRequests s })

getRenderState :: EventM n s (RenderState n)
getRenderState :: forall n s. EventM n s (RenderState n)
getRenderState = ReaderT
  (EventRO n) (StateT s (StateT (EventState n) IO)) (RenderState n)
-> EventM n s (RenderState n)
forall n s a.
ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) a
-> EventM n s a
EventM (ReaderT
   (EventRO n) (StateT s (StateT (EventState n) IO)) (RenderState n)
 -> EventM n s (RenderState n))
-> ReaderT
     (EventRO n) (StateT s (StateT (EventState n) IO)) (RenderState n)
-> EventM n s (RenderState n)
forall a b. (a -> b) -> a -> b
$ (EventRO n -> RenderState n)
-> ReaderT
     (EventRO n) (StateT s (StateT (EventState n) IO)) (RenderState n)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks EventRO n -> RenderState n
forall n. EventRO n -> RenderState n
oldState

resetRenderState :: RenderState n -> RenderState n
resetRenderState :: forall n. RenderState n -> RenderState n
resetRenderState RenderState n
s =
    RenderState n
s RenderState n -> (RenderState n -> RenderState n) -> RenderState n
forall a b. a -> (a -> b) -> b
& (Set n -> Identity (Set n))
-> RenderState n -> Identity (RenderState n)
forall n (f :: * -> *).
Functor f =>
(Set n -> f (Set n)) -> RenderState n -> f (RenderState n)
observedNamesL ((Set n -> Identity (Set n))
 -> RenderState n -> Identity (RenderState n))
-> Set n -> RenderState n -> RenderState n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set n
forall a. Set a
S.empty
      RenderState n -> (RenderState n -> RenderState n) -> RenderState n
forall a b. a -> (a -> b) -> b
& ([n] -> Identity [n]) -> RenderState n -> Identity (RenderState n)
forall n (f :: * -> *).
Functor f =>
([n] -> f [n]) -> RenderState n -> f (RenderState n)
clickableNamesL (([n] -> Identity [n])
 -> RenderState n -> Identity (RenderState n))
-> [n] -> RenderState n -> RenderState n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [n]
forall a. Monoid a => a
mempty

renderApp :: (Ord n) => VtyContext -> App s e n -> s -> RenderState n -> IO (RenderState n, [Extent n])
renderApp :: forall n s e.
Ord n =>
VtyContext
-> App s e n
-> s
-> RenderState n
-> IO (RenderState n, [Extent n])
renderApp VtyContext
vtyCtx App s e n
app s
appState RenderState n
rs = do
    (Int, Int)
sz <- Output -> IO (Int, Int)
displayBounds (Output -> IO (Int, Int)) -> Output -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ Vty -> Output
outputIface (Vty -> Output) -> Vty -> Output
forall a b. (a -> b) -> a -> b
$ VtyContext -> Vty
vtyContextHandle VtyContext
vtyCtx
    let (RenderState n
newRS, Picture
pic, Maybe (CursorLocation n)
theCursor, [Extent n]
exts) = AttrMap
-> [Widget n]
-> (Int, Int)
-> ([CursorLocation n] -> Maybe (CursorLocation n))
-> RenderState n
-> (RenderState n, Picture, Maybe (CursorLocation n), [Extent n])
forall n.
Ord n =>
AttrMap
-> [Widget n]
-> (Int, Int)
-> ([CursorLocation n] -> Maybe (CursorLocation n))
-> RenderState n
-> (RenderState n, Picture, Maybe (CursorLocation n), [Extent n])
renderFinal (App s e n -> s -> AttrMap
forall s e n. App s e n -> s -> AttrMap
appAttrMap App s e n
app s
appState)
                                        (App s e n -> s -> [Widget n]
forall s e n. App s e n -> s -> [Widget n]
appDraw App s e n
app s
appState)
                                        (Int, Int)
sz
                                        (App s e n -> s -> [CursorLocation n] -> Maybe (CursorLocation n)
forall s e n.
App s e n -> s -> [CursorLocation n] -> Maybe (CursorLocation n)
appChooseCursor App s e n
app s
appState)
                                        RenderState n
rs
        picWithCursor :: Picture
picWithCursor = case Maybe (CursorLocation n)
theCursor of
            Maybe (CursorLocation n)
Nothing -> Picture
pic { picCursor = NoCursor }
            Just CursorLocation n
cloc -> Picture
pic { picCursor = (if cursorLocationVisible cloc
                                            then AbsoluteCursor
                                            else PositionOnly True)
                                           (cloc^.locationColumnL)
                                           (cloc^.locationRowL)
                             }

    Vty -> Picture -> IO ()
update (VtyContext -> Vty
vtyContextHandle VtyContext
vtyCtx) Picture
picWithCursor

    (RenderState n, [Extent n]) -> IO (RenderState n, [Extent n])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RenderState n
newRS, [Extent n]
exts)

-- | Ignore all requested cursor positions returned by the rendering
-- process. This is a convenience function useful as an
-- 'appChooseCursor' value when a simple application has no need to
-- position the cursor.
neverShowCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n)
neverShowCursor :: forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
neverShowCursor = ([CursorLocation n] -> Maybe (CursorLocation n))
-> s -> [CursorLocation n] -> Maybe (CursorLocation n)
forall a b. a -> b -> a
const (([CursorLocation n] -> Maybe (CursorLocation n))
 -> s -> [CursorLocation n] -> Maybe (CursorLocation n))
-> ([CursorLocation n] -> Maybe (CursorLocation n))
-> s
-> [CursorLocation n]
-> Maybe (CursorLocation n)
forall a b. (a -> b) -> a -> b
$ Maybe (CursorLocation n)
-> [CursorLocation n] -> Maybe (CursorLocation n)
forall a b. a -> b -> a
const Maybe (CursorLocation n)
forall a. Maybe a
Nothing

-- | Always show the first cursor, if any, returned by the rendering
-- process. This is a convenience function useful as an
-- 'appChooseCursor' value when a simple program has zero or more
-- widgets that advertise a cursor position.
showFirstCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n)
showFirstCursor :: forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
showFirstCursor = ([CursorLocation n] -> Maybe (CursorLocation n))
-> s -> [CursorLocation n] -> Maybe (CursorLocation n)
forall a b. a -> b -> a
const [CursorLocation n] -> Maybe (CursorLocation n)
forall a. [a] -> Maybe a
listToMaybe

-- | Show the cursor with the specified resource name, if such a cursor
-- location has been reported.
showCursorNamed :: (Eq n) => n -> [CursorLocation n] -> Maybe (CursorLocation n)
showCursorNamed :: forall n.
Eq n =>
n -> [CursorLocation n] -> Maybe (CursorLocation n)
showCursorNamed n
name [CursorLocation n]
locs =
    let matches :: CursorLocation n -> Bool
matches CursorLocation n
l = CursorLocation n
lCursorLocation n
-> Getting (Maybe n) (CursorLocation n) (Maybe n) -> Maybe n
forall s a. s -> Getting a s a -> a
^.Getting (Maybe n) (CursorLocation n) (Maybe n)
forall n1 n2 (f :: * -> *).
Functor f =>
(Maybe n1 -> f (Maybe n2))
-> CursorLocation n1 -> f (CursorLocation n2)
cursorLocationNameL Maybe n -> Maybe n -> Bool
forall a. Eq a => a -> a -> Bool
== n -> Maybe n
forall a. a -> Maybe a
Just n
name
    in (CursorLocation n -> Bool)
-> [CursorLocation n] -> Maybe (CursorLocation n)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find CursorLocation n -> Bool
matches [CursorLocation n]
locs

-- | A viewport scrolling handle for managing the scroll state of
-- viewports.
data ViewportScroll n =
    ViewportScroll { forall n. ViewportScroll n -> n
viewportName :: n
                   -- ^ The name of the viewport to be controlled by
                   -- this scrolling handle.
                   , forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
hScrollPage :: forall s. Direction -> EventM n s ()
                   -- ^ Scroll the viewport horizontally by one page in
                   -- the specified direction.
                   , forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
hScrollBy :: forall s. Int -> EventM n s ()
                   -- ^ Scroll the viewport horizontally by the
                   -- specified number of rows or columns depending on
                   -- the orientation of the viewport.
                   , forall n. ViewportScroll n -> forall s. EventM n s ()
hScrollToBeginning :: forall s. EventM n s ()
                   -- ^ Scroll horizontally to the beginning of the
                   -- viewport.
                   , forall n. ViewportScroll n -> forall s. EventM n s ()
hScrollToEnd :: forall s. EventM n s ()
                   -- ^ Scroll horizontally to the end of the viewport.
                   , forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage :: forall s. Direction -> EventM n s ()
                   -- ^ Scroll the viewport vertically by one page in
                   -- the specified direction.
                   , forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy :: forall s. Int -> EventM n s ()
                   -- ^ Scroll the viewport vertically by the specified
                   -- number of rows or columns depending on the
                   -- orientation of the viewport.
                   , forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToBeginning :: forall s. EventM n s ()
                   -- ^ Scroll vertically to the beginning of the viewport.
                   , forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToEnd :: forall s. EventM n s ()
                   -- ^ Scroll vertically to the end of the viewport.
                   , forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
setTop :: forall s. Int -> EventM n s ()
                   -- ^ Set the top row offset of the viewport.
                   , forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
setLeft :: forall s. Int -> EventM n s ()
                   -- ^ Set the left column offset of the viewport.
                   }

addScrollRequest :: (n, ScrollRequest) -> EventM n s ()
addScrollRequest :: forall n s. (n, ScrollRequest) -> EventM n s ()
addScrollRequest (n, ScrollRequest)
req = ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
-> EventM n s ()
forall n s a.
ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) a
-> EventM n s a
EventM (ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
 -> EventM n s ())
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
-> EventM n s ()
forall a b. (a -> b) -> a -> b
$ do
    StateT s (StateT (EventState n) IO) ()
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT (EventRO n) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT s (StateT (EventState n) IO) ()
 -> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ())
-> StateT s (StateT (EventState n) IO) ()
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
forall a b. (a -> b) -> a -> b
$ StateT (EventState n) IO ()
-> StateT s (StateT (EventState n) IO) ()
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (EventState n) IO ()
 -> StateT s (StateT (EventState n) IO) ())
-> StateT (EventState n) IO ()
-> StateT s (StateT (EventState n) IO) ()
forall a b. (a -> b) -> a -> b
$ (EventState n -> EventState n) -> StateT (EventState n) IO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EventState n
s -> EventState n
s { esScrollRequests = req : esScrollRequests s })

-- | Build a viewport scroller for the viewport with the specified name.
viewportScroll :: n -> ViewportScroll n
viewportScroll :: forall n. n -> ViewportScroll n
viewportScroll n
n =
    ViewportScroll { viewportName :: n
viewportName       = n
n
                   , hScrollPage :: forall s. Direction -> EventM n s ()
hScrollPage        = \Direction
dir -> (n, ScrollRequest) -> EventM n s ()
forall n s. (n, ScrollRequest) -> EventM n s ()
addScrollRequest (n
n, Direction -> ScrollRequest
HScrollPage Direction
dir)
                   , hScrollBy :: forall s. Int -> EventM n s ()
hScrollBy          = \Int
i ->   (n, ScrollRequest) -> EventM n s ()
forall n s. (n, ScrollRequest) -> EventM n s ()
addScrollRequest (n
n, Int -> ScrollRequest
HScrollBy Int
i)
                   , hScrollToBeginning :: forall s. EventM n s ()
hScrollToBeginning =         (n, ScrollRequest) -> EventM n s ()
forall n s. (n, ScrollRequest) -> EventM n s ()
addScrollRequest (n
n, ScrollRequest
HScrollToBeginning)
                   , hScrollToEnd :: forall s. EventM n s ()
hScrollToEnd       =         (n, ScrollRequest) -> EventM n s ()
forall n s. (n, ScrollRequest) -> EventM n s ()
addScrollRequest (n
n, ScrollRequest
HScrollToEnd)
                   , vScrollPage :: forall s. Direction -> EventM n s ()
vScrollPage        = \Direction
dir -> (n, ScrollRequest) -> EventM n s ()
forall n s. (n, ScrollRequest) -> EventM n s ()
addScrollRequest (n
n, Direction -> ScrollRequest
VScrollPage Direction
dir)
                   , vScrollBy :: forall s. Int -> EventM n s ()
vScrollBy          = \Int
i ->   (n, ScrollRequest) -> EventM n s ()
forall n s. (n, ScrollRequest) -> EventM n s ()
addScrollRequest (n
n, Int -> ScrollRequest
VScrollBy Int
i)
                   , vScrollToBeginning :: forall s. EventM n s ()
vScrollToBeginning =         (n, ScrollRequest) -> EventM n s ()
forall n s. (n, ScrollRequest) -> EventM n s ()
addScrollRequest (n
n, ScrollRequest
VScrollToBeginning)
                   , vScrollToEnd :: forall s. EventM n s ()
vScrollToEnd       =         (n, ScrollRequest) -> EventM n s ()
forall n s. (n, ScrollRequest) -> EventM n s ()
addScrollRequest (n
n, ScrollRequest
VScrollToEnd)
                   , setTop :: forall s. Int -> EventM n s ()
setTop             = \Int
i ->   (n, ScrollRequest) -> EventM n s ()
forall n s. (n, ScrollRequest) -> EventM n s ()
addScrollRequest (n
n, Int -> ScrollRequest
SetTop Int
i)
                   , setLeft :: forall s. Int -> EventM n s ()
setLeft            = \Int
i ->   (n, ScrollRequest) -> EventM n s ()
forall n s. (n, ScrollRequest) -> EventM n s ()
addScrollRequest (n
n, Int -> ScrollRequest
SetLeft Int
i)
                   }

-- | Continue running the event loop with the specified application
-- state without redrawing the screen. This is faster than 'continue'
-- because it skips the redraw, but the drawback is that you need to
-- be really sure that you don't want a screen redraw. If your state
-- changed in a way that needs to be reflected on the screen, just don't
-- call this; 'EventM' blocks default to triggering redraws when they
-- finish executing. This function is for cases where you know that you
-- did something that won't have an impact on the screen state and you
-- want to save on redraw cost.
continueWithoutRedraw :: EventM n s ()
continueWithoutRedraw :: forall n s. EventM n s ()
continueWithoutRedraw =
    ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
-> EventM n s ()
forall n s a.
ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) a
-> EventM n s a
EventM (ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
 -> EventM n s ())
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
-> EventM n s ()
forall a b. (a -> b) -> a -> b
$ StateT s (StateT (EventState n) IO) ()
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT (EventRO n) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT s (StateT (EventState n) IO) ()
 -> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ())
-> StateT s (StateT (EventState n) IO) ()
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
forall a b. (a -> b) -> a -> b
$ StateT (EventState n) IO ()
-> StateT s (StateT (EventState n) IO) ()
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (EventState n) IO ()
 -> StateT s (StateT (EventState n) IO) ())
-> StateT (EventState n) IO ()
-> StateT s (StateT (EventState n) IO) ()
forall a b. (a -> b) -> a -> b
$ (EventState n -> EventState n) -> StateT (EventState n) IO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((EventState n -> EventState n) -> StateT (EventState n) IO ())
-> (EventState n -> EventState n) -> StateT (EventState n) IO ()
forall a b. (a -> b) -> a -> b
$ \EventState n
es -> EventState n
es { nextAction = ContinueWithoutRedraw }

-- | Halt the event loop and return the specified application state as
-- the final state value.
halt :: EventM n s ()
halt :: forall n s. EventM n s ()
halt =
    ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
-> EventM n s ()
forall n s a.
ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) a
-> EventM n s a
EventM (ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
 -> EventM n s ())
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
-> EventM n s ()
forall a b. (a -> b) -> a -> b
$ StateT s (StateT (EventState n) IO) ()
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT (EventRO n) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT s (StateT (EventState n) IO) ()
 -> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ())
-> StateT s (StateT (EventState n) IO) ()
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
forall a b. (a -> b) -> a -> b
$ StateT (EventState n) IO ()
-> StateT s (StateT (EventState n) IO) ()
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (EventState n) IO ()
 -> StateT s (StateT (EventState n) IO) ())
-> StateT (EventState n) IO ()
-> StateT s (StateT (EventState n) IO) ()
forall a b. (a -> b) -> a -> b
$ (EventState n -> EventState n) -> StateT (EventState n) IO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((EventState n -> EventState n) -> StateT (EventState n) IO ())
-> (EventState n -> EventState n) -> StateT (EventState n) IO ()
forall a b. (a -> b) -> a -> b
$ \EventState n
es -> EventState n
es { nextAction = Halt }

-- | Suspend the event loop, save the terminal state, and run the
-- specified action. When it returns an application state value, restore
-- the terminal state, empty the rendering cache, update the application
-- state with the returned state, and continue execution of the event
-- handler that called this.
--
-- Note that any changes made to the terminal's input state are ignored
-- when Brick resumes execution and are not preserved in the final
-- terminal input state after the Brick application returns the terminal
-- to the user.
suspendAndResume :: (Ord n) => IO s -> EventM n s ()
suspendAndResume :: forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume IO s
act = IO s -> EventM n s s
forall n a s. Ord n => IO a -> EventM n s a
suspendAndResume' IO s
act EventM n s s -> (s -> EventM n s ()) -> EventM n s ()
forall a b. EventM n s a -> (a -> EventM n s b) -> EventM n s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> EventM n s ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put

-- | Suspend the event loop, save the terminal state, and run the
-- specified action. When it completes, restore the terminal state,
-- empty the rendering cache, return the result, and continue execution
-- of the event handler that called this.
--
-- Note that any changes made to the terminal's input state are ignored
-- when Brick resumes execution and are not preserved in the final
-- terminal input state after the Brick application returns the terminal
-- to the user.
suspendAndResume' :: (Ord n) => IO a -> EventM n s a
suspendAndResume' :: forall n a s. Ord n => IO a -> EventM n s a
suspendAndResume' IO a
act = do
    VtyContext
ctx <- EventM n s VtyContext
forall n s. EventM n s VtyContext
getVtyContext
    IO () -> EventM n s ()
forall a. IO a -> EventM n s a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM n s ()) -> IO () -> EventM n s ()
forall a b. (a -> b) -> a -> b
$ VtyContext -> IO ()
shutdownVtyContext VtyContext
ctx
    a
result <- IO a -> EventM n s a
forall a. IO a -> EventM n s a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
act
    VtyContext -> EventM n s ()
forall n s. VtyContext -> EventM n s ()
setVtyContext (VtyContext -> EventM n s ())
-> EventM n s VtyContext -> EventM n s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (IO VtyContext -> EventM n s VtyContext
forall a. IO a -> EventM n s a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VtyContext -> EventM n s VtyContext)
-> IO VtyContext -> EventM n s VtyContext
forall a b. (a -> b) -> a -> b
$ VtyContext -> IO VtyContext
newVtyContextFrom VtyContext
ctx)
    EventM n s ()
forall n s. Ord n => EventM n s ()
invalidateCache
    a -> EventM n s a
forall a. a -> EventM n s a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

-- | Request that the specified UI element be made visible on the
-- next rendering. This is provided to allow event handlers to make
-- visibility requests in the same way that the 'visible' function does
-- at rendering time.
makeVisible :: (Ord n) => n -> EventM n s ()
makeVisible :: forall n s. Ord n => n -> EventM n s ()
makeVisible n
n = ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
-> EventM n s ()
forall n s a.
ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) a
-> EventM n s a
EventM (ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
 -> EventM n s ())
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
-> EventM n s ()
forall a b. (a -> b) -> a -> b
$ do
    StateT s (StateT (EventState n) IO) ()
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT (EventRO n) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT s (StateT (EventState n) IO) ()
 -> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ())
-> StateT s (StateT (EventState n) IO) ()
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) ()
forall a b. (a -> b) -> a -> b
$ StateT (EventState n) IO ()
-> StateT s (StateT (EventState n) IO) ()
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (EventState n) IO ()
 -> StateT s (StateT (EventState n) IO) ())
-> StateT (EventState n) IO ()
-> StateT s (StateT (EventState n) IO) ()
forall a b. (a -> b) -> a -> b
$ (EventState n -> EventState n) -> StateT (EventState n) IO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EventState n
s -> EventState n
s { requestedVisibleNames = S.insert n $ requestedVisibleNames s })