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

  -- * Event handler functions
  , continue
  , halt
  , suspendAndResume
  , 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
  )
where

import qualified Control.Exception as E
import Lens.Micro ((^.), (&), (.~), (%~), _1, _2)
import Control.Monad (forever)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State
import Control.Monad.Trans.Reader
import Control.Concurrent (forkIO, killThread)
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
import Data.Monoid (mempty)
#endif
import qualified Data.Foldable as F
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
  , mkVty
  , defaultConfig
  , restoreInputState
  , inputIface
  )
import Graphics.Vty.Attributes (defAttr)

import Brick.BChan (BChan, newBChan, readBChan, readBChan2, writeBChan)
import Brick.Types (Widget, 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 { 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.
        , 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.
        , App s e n -> s -> BrickEvent n e -> EventM n (Next s)
appHandleEvent :: s -> BrickEvent n e -> EventM n (Next s)
        -- ^ This function takes the current application state and an
        -- event and returns an action to be taken and a corresponding
        -- transformed application state. Possible options are
        -- 'continue', 'suspendAndResume', and 'halt'.
        , App s e n -> s -> EventM n s
appStartEvent :: s -> 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.
        , 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 returned by a 'halt'
-- operation.
defaultMain :: (Ord n)
            => App s e n
            -- ^ The application.
            -> s
            -- ^ The initial application state.
            -> IO s
defaultMain :: App s e n -> s -> IO s
defaultMain App s e n
app s
st = do
    let builder :: IO Vty
builder = Config -> IO Vty
mkVty Config
defaultConfig
    Vty
initialVty <- IO Vty
builder
    Vty -> IO Vty -> Maybe (BChan e) -> App s e n -> s -> IO s
forall n e s.
Ord n =>
Vty -> IO Vty -> Maybe (BChan e) -> App s e n -> s -> IO s
customMain Vty
initialVty IO Vty
builder Maybe (BChan e)
forall a. Maybe a
Nothing App s e n
app s
st

-- | 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 :: 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 :: Widget n -> App s e n
simpleApp Widget n
w =
    App :: forall s e n.
(s -> [Widget n])
-> (s -> [CursorLocation n] -> Maybe (CursorLocation n))
-> (s -> BrickEvent n e -> EventM n (Next s))
-> (s -> EventM n s)
-> (s -> AttrMap)
-> App s e n
App { appDraw :: s -> [Widget n]
appDraw = [Widget n] -> s -> [Widget n]
forall a b. a -> b -> a
const [Widget n
w]
        , appHandleEvent :: s -> BrickEvent n e -> EventM n (Next s)
appHandleEvent = s -> BrickEvent n e -> EventM n (Next s)
forall s n e. s -> BrickEvent n e -> EventM n (Next s)
resizeOrQuit
        , appStartEvent :: s -> EventM n s
appStartEvent = s -> EventM n s
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 :: s -> BrickEvent n e -> EventM n (Next s)
resizeOrQuit :: s -> BrickEvent n e -> EventM n (Next s)
resizeOrQuit s
s (VtyEvent (EvResize Int
_ Int
_)) = s -> EventM n (Next s)
forall s n. s -> EventM n (Next s)
continue s
s
resizeOrQuit s
s BrickEvent n e
_ = s -> EventM n (Next s)
forall s n. s -> EventM n (Next s)
halt s
s

data InternalNext n a = InternalSuspendAndResume (RenderState n) (IO a)
                      | InternalHalt a

readBrickEvent :: BChan (BrickEvent n e) -> BChan e -> IO (BrickEvent n e)
readBrickEvent :: 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)
           => Vty
           -> BChan (BrickEvent n e)
           -> Maybe (BChan e)
           -> App s e n
           -> RenderState n
           -> s
           -> IO (InternalNext n s)
runWithVty :: Vty
-> BChan (BrickEvent n e)
-> Maybe (BChan e)
-> App s e n
-> RenderState n
-> s
-> IO (InternalNext n s)
runWithVty Vty
vty BChan (BrickEvent n e)
brickChan Maybe (BChan e)
mUserChan App s e n
app RenderState n
initialRS s
initialSt = do
    ThreadId
pid <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Vty -> BChan (BrickEvent n e) -> IO ()
forall n e. Vty -> BChan (BrickEvent n e) -> IO ()
supplyVtyEvents Vty
vty BChan (BrickEvent n e)
brickChan
    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 :: RenderState n -> s -> IO (InternalNext n s)
runInner RenderState n
rs s
st = do
          (Next s
result, RenderState n
newRS) <- Vty
-> IO (BrickEvent n e)
-> App s e n
-> s
-> RenderState n
-> IO (Next s, RenderState n)
forall n e s.
Ord n =>
Vty
-> IO (BrickEvent n e)
-> App s e n
-> s
-> RenderState n
-> IO (Next s, RenderState n)
runVty Vty
vty IO (BrickEvent n e)
readEvent App s e n
app s
st (RenderState n -> RenderState n
forall n. RenderState n -> RenderState n
resetRenderState RenderState n
rs)
          case Next s
result of
              SuspendAndResume IO s
act -> do
                  ThreadId -> IO ()
killThread ThreadId
pid
                  InternalNext n s -> IO (InternalNext n s)
forall (m :: * -> *) a. Monad m => a -> m a
return (InternalNext n s -> IO (InternalNext n s))
-> InternalNext n s -> IO (InternalNext n s)
forall a b. (a -> b) -> a -> b
$ RenderState n -> IO s -> InternalNext n s
forall n a. RenderState n -> IO a -> InternalNext n a
InternalSuspendAndResume RenderState n
newRS IO s
act
              Halt s
s -> do
                  ThreadId -> IO ()
killThread ThreadId
pid
                  InternalNext n s -> IO (InternalNext n s)
forall (m :: * -> *) a. Monad m => a -> m a
return (InternalNext n s -> IO (InternalNext n s))
-> InternalNext n s -> IO (InternalNext n s)
forall a b. (a -> b) -> a -> b
$ s -> InternalNext n s
forall n a. a -> InternalNext n a
InternalHalt s
s
              Continue s
s -> RenderState n -> s -> IO (InternalNext n s)
runInner RenderState n
newRS s
s
    RenderState n -> s -> IO (InternalNext n s)
runInner RenderState n
initialRS 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 :: 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 (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 (m :: * -> *) a. Monad m => a -> m a
return s
s

-- | 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 :: 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
    let run :: Vty -> RenderState n -> s -> BChan (BrickEvent n e) -> IO (s, Vty)
run Vty
vty RenderState n
rs s
st BChan (BrickEvent n e)
brickChan = do
            InternalNext n s
result <- Vty
-> BChan (BrickEvent n e)
-> Maybe (BChan e)
-> App s e n
-> RenderState n
-> s
-> IO (InternalNext n s)
forall n e s.
Ord n =>
Vty
-> BChan (BrickEvent n e)
-> Maybe (BChan e)
-> App s e n
-> RenderState n
-> s
-> IO (InternalNext n s)
runWithVty Vty
vty BChan (BrickEvent n e)
brickChan Maybe (BChan e)
mUserChan App s e n
app RenderState n
rs s
st
                IO (InternalNext n s)
-> (SomeException -> IO (InternalNext n s))
-> IO (InternalNext n s)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` (\(SomeException
e::E.SomeException) -> Vty -> IO ()
shutdown Vty
vty IO () -> IO (InternalNext n s) -> IO (InternalNext n s)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> IO (InternalNext n s)
forall a e. Exception e => e -> a
E.throw SomeException
e)
            case InternalNext n s
result of
                InternalHalt s
s -> (s, Vty) -> IO (s, Vty)
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, Vty
vty)
                InternalSuspendAndResume RenderState n
newRS IO s
action -> do
                    Vty -> IO ()
shutdown Vty
vty
                    s
newAppState <- IO s
action
                    Vty
newVty <- IO Vty
buildVty
                    Vty -> RenderState n -> s -> BChan (BrickEvent n e) -> IO (s, Vty)
run Vty
newVty (RenderState n
newRS { renderCache :: Map n (Result n)
renderCache = Map n (Result n)
forall a. Monoid a => a
mempty }) s
newAppState BChan (BrickEvent n e)
brickChan

    let emptyES :: EventState n
emptyES = [(n, ScrollRequest)]
-> Set (CacheInvalidateRequest n) -> EventState n
forall n.
[(n, ScrollRequest)]
-> Set (CacheInvalidateRequest n) -> EventState n
ES [] Set (CacheInvalidateRequest n)
forall a. Monoid a => a
mempty
        emptyRS :: RenderState n
emptyRS = Map n Viewport
-> [(n, ScrollRequest)]
-> Set n
-> Map n (Result n)
-> [n]
-> RenderState n
forall n.
Map n Viewport
-> [(n, ScrollRequest)]
-> Set n
-> Map n (Result n)
-> [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 (Result n)
forall a. Monoid a => a
mempty [n]
forall a. Monoid a => a
mempty
        eventRO :: EventRO n
eventRO = Map n Viewport -> Vty -> [Extent n] -> RenderState n -> EventRO n
forall n.
Map n Viewport -> Vty -> [Extent n] -> RenderState n -> EventRO n
EventRO Map n Viewport
forall k a. Map k a
M.empty Vty
initialVty [Extent n]
forall a. Monoid a => a
mempty RenderState n
emptyRS

    (s
st, 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 (ReaderT (EventRO n) (StateT (EventState n) IO) s
-> EventRO n -> StateT (EventState n) IO s
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (EventM n s -> ReaderT (EventRO n) (StateT (EventState n) IO) s
forall n a.
EventM n a -> ReaderT (EventRO n) (StateT (EventState n) IO) a
runEventM (App s e n -> s -> EventM n s
forall s e n. App s e n -> s -> EventM n s
appStartEvent App s e n
app s
initialAppState)) EventRO n
eventRO) EventState n
emptyES
    let initialRS :: RenderState n
initialRS = Map n Viewport
-> [(n, ScrollRequest)]
-> Set n
-> Map n (Result n)
-> [n]
-> RenderState n
forall n.
Map n Viewport
-> [(n, ScrollRequest)]
-> Set n
-> Map n (Result n)
-> [n]
-> RenderState n
RS Map n Viewport
forall k a. Map k a
M.empty (EventState n -> [(n, ScrollRequest)]
forall n. EventState n -> [(n, ScrollRequest)]
esScrollRequests EventState n
eState) Set n
forall a. Set a
S.empty Map n (Result n)
forall a. Monoid a => a
mempty []
    BChan (BrickEvent n e)
brickChan <- Int -> IO (BChan (BrickEvent n e))
forall a. Int -> IO (BChan a)
newBChan Int
20
    Vty -> RenderState n -> s -> BChan (BrickEvent n e) -> IO (s, Vty)
run Vty
initialVty RenderState n
initialRS s
st BChan (BrickEvent n e)
brickChan

supplyVtyEvents :: Vty -> BChan (BrickEvent n e) -> IO ()
supplyVtyEvents :: Vty -> BChan (BrickEvent n e) -> IO ()
supplyVtyEvents Vty
vty BChan (BrickEvent n e)
chan =
    IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Event
e <- Vty -> IO Event
nextEvent Vty
vty
        BChan (BrickEvent n e) -> BrickEvent n e -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan (BrickEvent n e)
chan (BrickEvent n e -> IO ()) -> BrickEvent n e -> IO ()
forall a b. (a -> b) -> a -> b
$ Event -> BrickEvent n e
forall n e. Event -> BrickEvent n e
VtyEvent Event
e

runVty :: (Ord n)
       => Vty
       -> IO (BrickEvent n e)
       -> App s e n
       -> s
       -> RenderState n
       -> IO (Next s, RenderState n)
runVty :: Vty
-> IO (BrickEvent n e)
-> App s e n
-> s
-> RenderState n
-> IO (Next s, RenderState n)
runVty Vty
vty IO (BrickEvent n e)
readEvent App s e n
app s
appState RenderState n
rs = do
    (RenderState n
firstRS, [Extent n]
exts) <- Vty
-> App s e n
-> s
-> RenderState n
-> IO (RenderState n, [Extent n])
forall s e n.
Vty
-> App s e n
-> s
-> RenderState n
-> IO (RenderState n, [Extent n])
renderApp Vty
vty App s e n
app s
appState RenderState n
rs
    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') <- Vty
-> App s e n
-> s
-> RenderState n
-> IO (RenderState n, [Extent n])
forall s e n.
Vty
-> App s e n
-> s
-> RenderState n
-> IO (RenderState n, [Extent n])
renderApp Vty
vty 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. Lens' (RenderState n) (Set 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 (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)
_ (Location (Int
oC, Int
oR)):[Extent n]
_) ->
                    -- If the clicked extent was registered as
                    -- clickable, send a click event. Otherwise, just
                    -- send the raw mouse event
                    case n
n n -> [n] -> 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. Lens' (RenderState n) [n]
clickableNamesL of
                        Bool
True -> 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
oC
                                lr :: Int
lr = Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
er Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
oR

                                -- 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
_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
_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 (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)
                        Bool
False -> (BrickEvent n e, RenderState n, [Extent n])
-> IO (BrickEvent n e, RenderState n, [Extent n])
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 (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)
_ (Location (Int
oC, Int
oR)):[Extent n]
_) ->
                    -- If the clicked extent was registered as
                    -- clickable, send a click event. Otherwise, just
                    -- send the raw mouse event
                    case n
n n -> [n] -> 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. Lens' (RenderState n) [n]
clickableNamesL of
                        Bool
True -> 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
oC
                                lr :: Int
lr = Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
er Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
oR
                                -- 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
_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
_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 (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)
                        Bool
False -> (BrickEvent n e, RenderState n, [Extent n])
-> IO (BrickEvent n e, RenderState n, [Extent n])
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 (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 (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) -> EventState n
forall n.
[(n, ScrollRequest)]
-> Set (CacheInvalidateRequest n) -> EventState n
ES [] Set (CacheInvalidateRequest n)
forall a. Monoid a => a
mempty
        eventRO :: EventRO n
eventRO = Map n Viewport -> Vty -> [Extent n] -> RenderState n -> EventRO n
forall n.
Map n Viewport -> Vty -> [Extent n] -> RenderState n -> EventRO n
EventRO (RenderState n -> Map n Viewport
forall n. RenderState n -> Map n Viewport
viewportMap RenderState n
nextRS) Vty
vty [Extent n]
nextExts RenderState n
nextRS

    (Next s
next, EventState n
eState) <- StateT (EventState n) IO (Next s)
-> EventState n -> IO (Next s, EventState n)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ReaderT (EventRO n) (StateT (EventState n) IO) (Next s)
-> EventRO n -> StateT (EventState n) IO (Next s)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (EventM n (Next s)
-> ReaderT (EventRO n) (StateT (EventState n) IO) (Next s)
forall n a.
EventM n a -> ReaderT (EventRO n) (StateT (EventState n) IO) a
runEventM (App s e n -> s -> BrickEvent n e -> EventM n (Next s)
forall s e n. App s e n -> s -> BrickEvent n e -> EventM n (Next s)
appHandleEvent App s e n
app s
appState BrickEvent n e
e'))
                                EventRO n
eventRO) EventState n
emptyES
    (Next s, RenderState n) -> IO (Next s, RenderState n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Next s
next, RenderState n
nextRS { rsScrollRequests :: [(n, ScrollRequest)]
rsScrollRequests = EventState n -> [(n, ScrollRequest)]
forall n. EventState n -> [(n, ScrollRequest)]
esScrollRequests EventState n
eState
                         , renderCache :: Map n (Result n)
renderCache = Set (CacheInvalidateRequest n)
-> Map n (Result n) -> Map n (Result n)
forall n v.
Ord n =>
Set (CacheInvalidateRequest n) -> Map n v -> Map n v
applyInvalidations (EventState n -> Set (CacheInvalidateRequest n)
forall n. EventState n -> Set (CacheInvalidateRequest n)
cacheInvalidateRequests EventState n
eState) (Map n (Result n) -> Map n (Result n))
-> Map n (Result n) -> Map n (Result n)
forall a b. (a -> b) -> a -> b
$
                                         RenderState n -> Map n (Result n)
forall n. RenderState n -> Map n (Result n)
renderCache RenderState n
nextRS
                         })

applyInvalidations :: (Ord n) => S.Set (CacheInvalidateRequest n) -> M.Map n v -> M.Map n v
applyInvalidations :: 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 (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 (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).
lookupViewport :: (Ord n) => n -> EventM n (Maybe Viewport)
lookupViewport :: n -> EventM n (Maybe Viewport)
lookupViewport n
n = ReaderT (EventRO n) (StateT (EventState n) IO) (Maybe Viewport)
-> EventM n (Maybe Viewport)
forall n a.
ReaderT (EventRO n) (StateT (EventState n) IO) a -> EventM n a
EventM (ReaderT (EventRO n) (StateT (EventState n) IO) (Maybe Viewport)
 -> EventM n (Maybe Viewport))
-> ReaderT (EventRO n) (StateT (EventState n) IO) (Maybe Viewport)
-> EventM n (Maybe Viewport)
forall a b. (a -> b) -> a -> b
$ (EventRO n -> Maybe Viewport)
-> ReaderT (EventRO n) (StateT (EventState n) IO) (Maybe Viewport)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r 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 :: (Int, Int) -> Extent n -> Bool
clickedExtent (Int
c, Int
r) (Extent n
_ (Location (Int
lc, Int
lr)) (Int
w, Int
h) Location
_) =
   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 (Maybe (Extent n))
lookupExtent :: n -> EventM n (Maybe (Extent n))
lookupExtent n
n = ReaderT (EventRO n) (StateT (EventState n) IO) (Maybe (Extent n))
-> EventM n (Maybe (Extent n))
forall n a.
ReaderT (EventRO n) (StateT (EventState n) IO) a -> EventM n a
EventM (ReaderT (EventRO n) (StateT (EventState n) IO) (Maybe (Extent n))
 -> EventM n (Maybe (Extent n)))
-> ReaderT
     (EventRO n) (StateT (EventState n) IO) (Maybe (Extent n))
-> EventM n (Maybe (Extent n))
forall a b. (a -> b) -> a -> b
$ (EventRO n -> Maybe (Extent n))
-> ReaderT
     (EventRO n) (StateT (EventState n) IO) (Maybe (Extent n))
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ([Extent n] -> Maybe (Extent n)
forall a. [a] -> Maybe a
listToMaybe ([Extent n] -> Maybe (Extent n))
-> (EventRO n -> [Extent n]) -> EventRO n -> Maybe (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 Extent n -> Bool
f ([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)
    where
        f :: Extent n -> Bool
f (Extent n
n' Location
_ (Int, Int)
_ Location
_) = 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 [Extent n]
findClickedExtents :: (Int, Int) -> EventM n [Extent n]
findClickedExtents (Int, Int)
pos = ReaderT (EventRO n) (StateT (EventState n) IO) [Extent n]
-> EventM n [Extent n]
forall n a.
ReaderT (EventRO n) (StateT (EventState n) IO) a -> EventM n a
EventM (ReaderT (EventRO n) (StateT (EventState n) IO) [Extent n]
 -> EventM n [Extent n])
-> ReaderT (EventRO n) (StateT (EventState n) IO) [Extent n]
-> EventM n [Extent n]
forall a b. (a -> b) -> a -> b
$ (EventRO n -> [Extent n])
-> ReaderT (EventRO n) (StateT (EventState n) IO) [Extent n]
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r 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_ :: (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 Vty
getVtyHandle :: EventM n Vty
getVtyHandle = ReaderT (EventRO n) (StateT (EventState n) IO) Vty -> EventM n Vty
forall n a.
ReaderT (EventRO n) (StateT (EventState n) IO) a -> EventM n a
EventM (ReaderT (EventRO n) (StateT (EventState n) IO) Vty
 -> EventM n Vty)
-> ReaderT (EventRO n) (StateT (EventState n) IO) Vty
-> EventM n Vty
forall a b. (a -> b) -> a -> b
$ (EventRO n -> Vty)
-> ReaderT (EventRO n) (StateT (EventState n) IO) Vty
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks EventRO n -> Vty
forall n. EventRO n -> Vty
eventVtyHandle

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

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

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

resetRenderState :: RenderState n -> RenderState n
resetRenderState :: 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. Lens' (RenderState n) (Set 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. Lens' (RenderState n) [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 :: Vty -> App s e n -> s -> RenderState n -> IO (RenderState n, [Extent n])
renderApp :: Vty
-> App s e n
-> s
-> RenderState n
-> IO (RenderState n, [Extent n])
renderApp Vty
vty 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
vty
    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.
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 :: Cursor
picCursor = Cursor
NoCursor }
            Just CursorLocation n
cloc -> Picture
pic { picCursor :: Cursor
picCursor = Int -> Int -> Cursor
AbsoluteCursor (CursorLocation n
clocCursorLocation n -> Getting Int (CursorLocation n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (CursorLocation n) Int
forall a. TerminalLocation a => Lens' a Int
locationColumnL)
                                                          (CursorLocation n
clocCursorLocation n -> Getting Int (CursorLocation n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (CursorLocation n) Int
forall a. TerminalLocation a => Lens' a Int
locationRowL)
                             }

    Vty -> Picture -> IO ()
update Vty
vty Picture
picWithCursor

    (RenderState n, [Extent n]) -> IO (RenderState n, [Extent n])
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 :: 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 :: 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 :: 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.
Lens (CursorLocation n1) (CursorLocation n2) (Maybe n1) (Maybe 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] -> Maybe (CursorLocation n)
forall a. [a] -> Maybe a
listToMaybe ([CursorLocation n] -> Maybe (CursorLocation n))
-> [CursorLocation n] -> Maybe (CursorLocation n)
forall a b. (a -> b) -> a -> b
$ (CursorLocation n -> Bool)
-> [CursorLocation n] -> [CursorLocation n]
forall a. (a -> Bool) -> [a] -> [a]
filter CursorLocation n -> Bool
matches [CursorLocation n]
locs

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

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

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

-- | Continue running the event loop with the specified application
-- state.
continue :: s -> EventM n (Next s)
continue :: s -> EventM n (Next s)
continue = Next s -> EventM n (Next s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Next s -> EventM n (Next s))
-> (s -> Next s) -> s -> EventM n (Next s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Next s
forall a. a -> Next a
Continue

-- | Halt the event loop and return the specified application state as
-- the final state value.
halt :: s -> EventM n (Next s)
halt :: s -> EventM n (Next s)
halt = Next s -> EventM n (Next s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Next s -> EventM n (Next s))
-> (s -> Next s) -> s -> EventM n (Next s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Next s
forall a. a -> Next a
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, redraw the application
-- from the new state, and resume the event loop.
--
-- 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 :: IO s -> EventM n (Next s)
suspendAndResume :: IO s -> EventM n (Next s)
suspendAndResume = Next s -> EventM n (Next s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Next s -> EventM n (Next s))
-> (IO s -> Next s) -> IO s -> EventM n (Next s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO s -> Next s
forall a. IO a -> Next a
SuspendAndResume