-- | Basic types used by this library.
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Brick.Types
  ( -- * The Widget type
    Widget(..)

    -- * Location types and lenses
  , Location(..)
  , locL
  , TerminalLocation(..)
  , CursorLocation(..)
  , cursorLocationL
  , cursorLocationNameL

  -- * Viewports
  , Viewport(..)
  , ViewportType(..)
  , vpSize
  , vpTop
  , vpLeft
  , vpContentSize
  , VScrollBarOrientation(..)
  , HScrollBarOrientation(..)
  , ScrollbarRenderer(..)
  , ClickableScrollbarElement(..)

  -- * Event-handling types and functions
  , EventM
  , BrickEvent(..)
  , nestEventM
  , nestEventM'

  -- * Rendering infrastructure
  , RenderM
  , getContext

  -- ** The rendering context
  , Context(ctxAttrName, availWidth, availHeight, windowWidth, windowHeight, ctxBorderStyle, ctxAttrMap, ctxDynBorders)
  , attrL
  , availWidthL
  , availHeightL
  , windowWidthL
  , windowHeightL
  , ctxVScrollBarOrientationL
  , ctxVScrollBarRendererL
  , ctxHScrollBarOrientationL
  , ctxHScrollBarRendererL
  , ctxAttrMapL
  , ctxAttrNameL
  , ctxBorderStyleL
  , ctxDynBordersL

  -- ** Rendering results
  , Result(..)
  , emptyResult
  , lookupAttrName
  , Extent(..)

  -- ** Rendering result lenses
  , imageL
  , cursorsL
  , visibilityRequestsL
  , extentsL

  -- ** Visibility requests
  , VisibilityRequest(..)
  , vrPositionL
  , vrSizeL

  -- * Making lenses
  , suffixLenses
  , suffixLensesWith

  -- * Dynamic borders
  , bordersL
  , DynBorder(..)
  , dbStyleL, dbAttrL, dbSegmentsL
  , BorderSegment(..)
  , bsAcceptL, bsOfferL, bsDrawL
  , Edges(..)
  , eTopL, eBottomL, eRightL, eLeftL

  -- * Miscellaneous
  , Size(..)
  , Direction(..)

  -- * Renderer internals (for benchmarking)
  , RenderState

  -- * Re-exports for convenience
  , get
  , gets
  , put
  , modify
  , zoom
  )
where

import Lens.Micro (_1, _2, to, (^.))
import Lens.Micro.Type (Getting)
import Lens.Micro.Mtl (zoom)
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail (MonadFail)
#endif
import Control.Monad.State.Strict
import Control.Monad.Reader
import Graphics.Vty (Attr)

import Brick.Types.TH
import Brick.Types.Internal
import Brick.Types.EventM
import Brick.AttrMap (AttrName, attrMapLookup)

-- | Given a state value and an 'EventM' that mutates that state, run
-- the specified action and return resulting modified state.
nestEventM' :: a
           -- ^ The initial state to use in the nested action.
            -> EventM n a b
            -- ^ The action to run.
            -> EventM n s a
nestEventM' :: a -> EventM n a b -> EventM n s a
nestEventM' a
s EventM n a b
act = (a, b) -> a
forall a b. (a, b) -> a
fst ((a, b) -> a) -> EventM n s (a, b) -> EventM n s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> EventM n a b -> EventM n s (a, b)
forall a n b s. a -> EventM n a b -> EventM n s (a, b)
nestEventM a
s EventM n a b
act

-- | Given a state value and an 'EventM' that mutates that state, run
-- the specified action and return both the resulting modified state and
-- the result of the action itself.
nestEventM :: a
           -- ^ The initial state to use in the nested action.
           -> EventM n a b
           -- ^ The action to run.
           -> EventM n s (a, b)
nestEventM :: a -> EventM n a b -> EventM n s (a, b)
nestEventM a
s' EventM n a b
act = do
    EventRO n
ro <- ReaderT
  (EventRO n) (StateT s (StateT (EventState n) IO)) (EventRO n)
-> EventM n s (EventRO 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)) (EventRO n)
forall r (m :: * -> *). MonadReader r m => m r
ask
    EventState n
es <- ReaderT
  (EventRO n) (StateT s (StateT (EventState n) IO)) (EventState n)
-> EventM n s (EventState 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)) (EventState n)
 -> EventM n s (EventState n))
-> ReaderT
     (EventRO n) (StateT s (StateT (EventState n) IO)) (EventState n)
-> EventM n s (EventState n)
forall a b. (a -> b) -> a -> b
$ StateT s (StateT (EventState n) IO) (EventState n)
-> ReaderT
     (EventRO n) (StateT s (StateT (EventState n) IO)) (EventState n)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT s (StateT (EventState n) IO) (EventState n)
 -> ReaderT
      (EventRO n) (StateT s (StateT (EventState n) IO)) (EventState n))
-> StateT s (StateT (EventState n) IO) (EventState n)
-> ReaderT
     (EventRO n) (StateT s (StateT (EventState n) IO)) (EventState n)
forall a b. (a -> b) -> a -> b
$ StateT (EventState n) IO (EventState n)
-> StateT s (StateT (EventState n) IO) (EventState n)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT (EventState n) IO (EventState n)
forall s (m :: * -> *). MonadState s m => m s
get
    VtyContext
vtyCtx <- EventM n s VtyContext
forall n s. EventM n s VtyContext
getVtyContext
    let stInner :: EventState n
stInner = ES :: forall n.
[(n, ScrollRequest)]
-> Set (CacheInvalidateRequest n)
-> Set n
-> NextAction
-> VtyContext
-> EventState n
ES { nextAction :: NextAction
nextAction = NextAction
Continue
                     , esScrollRequests :: [(n, ScrollRequest)]
esScrollRequests = EventState n -> [(n, ScrollRequest)]
forall n. EventState n -> [(n, ScrollRequest)]
esScrollRequests EventState n
es
                     , cacheInvalidateRequests :: Set (CacheInvalidateRequest n)
cacheInvalidateRequests = EventState n -> Set (CacheInvalidateRequest n)
forall n. EventState n -> Set (CacheInvalidateRequest n)
cacheInvalidateRequests EventState n
es
                     , requestedVisibleNames :: Set n
requestedVisibleNames = EventState n -> Set n
forall n. EventState n -> Set n
requestedVisibleNames EventState n
es
                     , vtyContext :: VtyContext
vtyContext = VtyContext
vtyCtx
                     }
    ((b
actResult, a
newSt), EventState n
stInnerFinal) <- IO ((b, a), EventState n) -> EventM n s ((b, a), EventState n)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ((b, a), EventState n) -> EventM n s ((b, a), EventState n))
-> IO ((b, a), EventState n) -> EventM n s ((b, a), EventState n)
forall a b. (a -> b) -> a -> b
$ StateT (EventState n) IO (b, a)
-> EventState n -> IO ((b, a), EventState n)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (StateT a (StateT (EventState n) IO) b
-> a -> StateT (EventState n) IO (b, a)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ReaderT (EventRO n) (StateT a (StateT (EventState n) IO)) b
-> EventRO n -> StateT a (StateT (EventState n) IO) b
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (EventM n a b
-> ReaderT (EventRO n) (StateT a (StateT (EventState n) IO)) b
forall n s a.
EventM n s a
-> ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) a
runEventM EventM n a b
act) EventRO n
ro) a
s') EventState n
stInner

    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 (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 (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
st -> EventState n
st { nextAction :: NextAction
nextAction = EventState n -> NextAction
forall n. EventState n -> NextAction
nextAction EventState n
stInnerFinal
                  , esScrollRequests :: [(n, ScrollRequest)]
esScrollRequests = EventState n -> [(n, ScrollRequest)]
forall n. EventState n -> [(n, ScrollRequest)]
esScrollRequests EventState n
stInnerFinal
                  , cacheInvalidateRequests :: Set (CacheInvalidateRequest n)
cacheInvalidateRequests = EventState n -> Set (CacheInvalidateRequest n)
forall n. EventState n -> Set (CacheInvalidateRequest n)
cacheInvalidateRequests EventState n
stInnerFinal
                  , requestedVisibleNames :: Set n
requestedVisibleNames = EventState n -> Set n
forall n. EventState n -> Set n
requestedVisibleNames EventState n
stInnerFinal
                  , vtyContext :: VtyContext
vtyContext = EventState n -> VtyContext
forall n. EventState n -> VtyContext
vtyContext EventState n
stInnerFinal
                  }
    (a, b) -> EventM n s (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
newSt, b
actResult)

-- | The rendering context's current drawing attribute.
attrL :: forall r n. Getting r (Context n) Attr
attrL :: Getting r (Context n) Attr
attrL = (Context n -> Attr) -> SimpleGetter (Context n) Attr
forall s a. (s -> a) -> SimpleGetter s a
to (\Context n
c -> AttrName -> AttrMap -> Attr
attrMapLookup (Context n
cContext n -> Getting AttrName (Context n) AttrName -> AttrName
forall s a. s -> Getting a s a -> a
^.Getting AttrName (Context n) AttrName
forall n. Lens' (Context n) AttrName
ctxAttrNameL) (Context n
cContext n -> Getting AttrMap (Context n) AttrMap -> AttrMap
forall s a. s -> Getting a s a -> a
^.Getting AttrMap (Context n) AttrMap
forall n. Lens' (Context n) AttrMap
ctxAttrMapL))

instance TerminalLocation (CursorLocation n) where
    locationColumnL :: (Int -> f Int) -> CursorLocation n -> f (CursorLocation n)
locationColumnL = (Location -> f Location)
-> CursorLocation n -> f (CursorLocation n)
forall n. Lens' (CursorLocation n) Location
cursorLocationL((Location -> f Location)
 -> CursorLocation n -> f (CursorLocation n))
-> ((Int -> f Int) -> Location -> f Location)
-> (Int -> f Int)
-> CursorLocation n
-> f (CursorLocation n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> f Int) -> Location -> f Location
forall s t a b. Field1 s t a b => Lens s t a b
_1
    locationColumn :: CursorLocation n -> Int
locationColumn = Location -> Int
forall a. TerminalLocation a => a -> Int
locationColumn (Location -> Int)
-> (CursorLocation n -> Location) -> CursorLocation n -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CursorLocation n -> Location
forall n. CursorLocation n -> Location
cursorLocation
    locationRowL :: (Int -> f Int) -> CursorLocation n -> f (CursorLocation n)
locationRowL = (Location -> f Location)
-> CursorLocation n -> f (CursorLocation n)
forall n. Lens' (CursorLocation n) Location
cursorLocationL((Location -> f Location)
 -> CursorLocation n -> f (CursorLocation n))
-> ((Int -> f Int) -> Location -> f Location)
-> (Int -> f Int)
-> CursorLocation n
-> f (CursorLocation n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> f Int) -> Location -> f Location
forall s t a b. Field2 s t a b => Lens s t a b
_2
    locationRow :: CursorLocation n -> Int
locationRow = Location -> Int
forall a. TerminalLocation a => a -> Int
locationRow (Location -> Int)
-> (CursorLocation n -> Location) -> CursorLocation n -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CursorLocation n -> Location
forall n. CursorLocation n -> Location
cursorLocation

-- | Given an attribute name, obtain the attribute for the attribute
-- name by consulting the context's attribute map.
lookupAttrName :: AttrName -> RenderM n Attr
lookupAttrName :: AttrName -> RenderM n Attr
lookupAttrName AttrName
n = do
    Context n
c <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
    Attr -> RenderM n Attr
forall (m :: * -> *) a. Monad m => a -> m a
return (Attr -> RenderM n Attr) -> Attr -> RenderM n Attr
forall a b. (a -> b) -> a -> b
$ AttrName -> AttrMap -> Attr
attrMapLookup AttrName
n (Context n
cContext n -> Getting AttrMap (Context n) AttrMap -> AttrMap
forall s a. s -> Getting a s a -> a
^.Getting AttrMap (Context n) AttrMap
forall n. Lens' (Context n) AttrMap
ctxAttrMapL)