-- | Basic types used by this library.
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# 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

  -- * Event-handling types
  , EventM(..)
  , Next
  , BrickEvent(..)
  , handleEventLensed

  -- * Rendering infrastructure
  , RenderM
  , getContext

  -- ** The rendering context
  , Context(ctxAttrName, availWidth, availHeight, windowWidth, windowHeight, ctxBorderStyle, ctxAttrMap, ctxDynBorders)
  , attrL
  , availWidthL
  , availHeightL
  , windowWidthL
  , windowHeightL
  , 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

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

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

  -- * Renderer internals (for benchmarking)
  , RenderState
  )
where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
import Data.Monoid (Monoid(..))
#endif

import Lens.Micro (_1, _2, to, (^.), (&), (.~), Lens')
import Lens.Micro.Type (Getting)
import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail (MonadFail)
#endif
import Control.Monad.Trans.State.Lazy
import Control.Monad.Trans.Reader
import Graphics.Vty (Attr)
import Control.Monad.IO.Class

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

-- | The type of padding.
data Padding = Pad Int
             -- ^ Pad by the specified number of rows or columns.
             | Max
             -- ^ Pad up to the number of available rows or columns.

-- | A convenience function for handling events intended for values
-- that are targets of lenses in your application state. This function
-- obtains the target value of the specified lens, invokes 'handleEvent'
-- on it, and stores the resulting transformed value back in the state
-- using the lens.
handleEventLensed :: a
                  -- ^ The state value.
                  -> Lens' a b
                  -- ^ The lens to use to extract and store the target
                  -- of the event.
                  -> (e -> b -> EventM n b)
                  -- ^ The event handler.
                  -> e
                  -- ^ The event to handle.
                  -> EventM n a
handleEventLensed :: a -> Lens' a b -> (e -> b -> EventM n b) -> e -> EventM n a
handleEventLensed a
v Lens' a b
target e -> b -> EventM n b
handleEvent e
ev = do
    b
newB <- e -> b -> EventM n b
handleEvent e
ev (a
va -> Getting b a b -> b
forall s a. s -> Getting a s a -> a
^.Getting b a b
Lens' a b
target)
    a -> EventM n a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> EventM n a) -> a -> EventM n a
forall a b. (a -> b) -> a -> b
$ a
v a -> (a -> a) -> a
forall a b. a -> (a -> b) -> b
& (b -> Identity b) -> a -> Identity a
Lens' a b
target ((b -> Identity b) -> a -> Identity a) -> b -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ b
newB

-- | The monad in which event handlers run. Although it may be tempting
-- to dig into the reader value yourself, just use
-- 'Brick.Main.lookupViewport'.
newtype EventM n a =
    EventM { EventM n a -> ReaderT (EventRO n) (StateT (EventState n) IO) a
runEventM :: ReaderT (EventRO n) (StateT (EventState n) IO) a
           }
           deriving ( a -> EventM n b -> EventM n a
(a -> b) -> EventM n a -> EventM n b
(forall a b. (a -> b) -> EventM n a -> EventM n b)
-> (forall a b. a -> EventM n b -> EventM n a)
-> Functor (EventM n)
forall a b. a -> EventM n b -> EventM n a
forall a b. (a -> b) -> EventM n a -> EventM n b
forall n a b. a -> EventM n b -> EventM n a
forall n a b. (a -> b) -> EventM n a -> EventM n b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> EventM n b -> EventM n a
$c<$ :: forall n a b. a -> EventM n b -> EventM n a
fmap :: (a -> b) -> EventM n a -> EventM n b
$cfmap :: forall n a b. (a -> b) -> EventM n a -> EventM n b
Functor, Functor (EventM n)
a -> EventM n a
Functor (EventM n)
-> (forall a. a -> EventM n a)
-> (forall a b. EventM n (a -> b) -> EventM n a -> EventM n b)
-> (forall a b c.
    (a -> b -> c) -> EventM n a -> EventM n b -> EventM n c)
-> (forall a b. EventM n a -> EventM n b -> EventM n b)
-> (forall a b. EventM n a -> EventM n b -> EventM n a)
-> Applicative (EventM n)
EventM n a -> EventM n b -> EventM n b
EventM n a -> EventM n b -> EventM n a
EventM n (a -> b) -> EventM n a -> EventM n b
(a -> b -> c) -> EventM n a -> EventM n b -> EventM n c
forall n. Functor (EventM n)
forall a. a -> EventM n a
forall n a. a -> EventM n a
forall a b. EventM n a -> EventM n b -> EventM n a
forall a b. EventM n a -> EventM n b -> EventM n b
forall a b. EventM n (a -> b) -> EventM n a -> EventM n b
forall n a b. EventM n a -> EventM n b -> EventM n a
forall n a b. EventM n a -> EventM n b -> EventM n b
forall n a b. EventM n (a -> b) -> EventM n a -> EventM n b
forall a b c.
(a -> b -> c) -> EventM n a -> EventM n b -> EventM n c
forall n a b c.
(a -> b -> c) -> EventM n a -> EventM n b -> EventM n c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: EventM n a -> EventM n b -> EventM n a
$c<* :: forall n a b. EventM n a -> EventM n b -> EventM n a
*> :: EventM n a -> EventM n b -> EventM n b
$c*> :: forall n a b. EventM n a -> EventM n b -> EventM n b
liftA2 :: (a -> b -> c) -> EventM n a -> EventM n b -> EventM n c
$cliftA2 :: forall n a b c.
(a -> b -> c) -> EventM n a -> EventM n b -> EventM n c
<*> :: EventM n (a -> b) -> EventM n a -> EventM n b
$c<*> :: forall n a b. EventM n (a -> b) -> EventM n a -> EventM n b
pure :: a -> EventM n a
$cpure :: forall n a. a -> EventM n a
$cp1Applicative :: forall n. Functor (EventM n)
Applicative, Applicative (EventM n)
a -> EventM n a
Applicative (EventM n)
-> (forall a b. EventM n a -> (a -> EventM n b) -> EventM n b)
-> (forall a b. EventM n a -> EventM n b -> EventM n b)
-> (forall a. a -> EventM n a)
-> Monad (EventM n)
EventM n a -> (a -> EventM n b) -> EventM n b
EventM n a -> EventM n b -> EventM n b
forall n. Applicative (EventM n)
forall a. a -> EventM n a
forall n a. a -> EventM n a
forall a b. EventM n a -> EventM n b -> EventM n b
forall a b. EventM n a -> (a -> EventM n b) -> EventM n b
forall n a b. EventM n a -> EventM n b -> EventM n b
forall n a b. EventM n a -> (a -> EventM n b) -> EventM n b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> EventM n a
$creturn :: forall n a. a -> EventM n a
>> :: EventM n a -> EventM n b -> EventM n b
$c>> :: forall n a b. EventM n a -> EventM n b -> EventM n b
>>= :: EventM n a -> (a -> EventM n b) -> EventM n b
$c>>= :: forall n a b. EventM n a -> (a -> EventM n b) -> EventM n b
$cp1Monad :: forall n. Applicative (EventM n)
Monad, Monad (EventM n)
Monad (EventM n)
-> (forall a. IO a -> EventM n a) -> MonadIO (EventM n)
IO a -> EventM n a
forall n. Monad (EventM n)
forall a. IO a -> EventM n a
forall n a. IO a -> EventM n a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> EventM n a
$cliftIO :: forall n a. IO a -> EventM n a
$cp1MonadIO :: forall n. Monad (EventM n)
MonadIO
                    , Monad (EventM n)
e -> EventM n a
Monad (EventM n)
-> (forall e a. Exception e => e -> EventM n a)
-> MonadThrow (EventM n)
forall n. Monad (EventM n)
forall e a. Exception e => e -> EventM n a
forall n e a. Exception e => e -> EventM n a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> EventM n a
$cthrowM :: forall n e a. Exception e => e -> EventM n a
$cp1MonadThrow :: forall n. Monad (EventM n)
MonadThrow, MonadThrow (EventM n)
MonadThrow (EventM n)
-> (forall e a.
    Exception e =>
    EventM n a -> (e -> EventM n a) -> EventM n a)
-> MonadCatch (EventM n)
EventM n a -> (e -> EventM n a) -> EventM n a
forall n. MonadThrow (EventM n)
forall e a.
Exception e =>
EventM n a -> (e -> EventM n a) -> EventM n a
forall n e a.
Exception e =>
EventM n a -> (e -> EventM n a) -> EventM n a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: EventM n a -> (e -> EventM n a) -> EventM n a
$ccatch :: forall n e a.
Exception e =>
EventM n a -> (e -> EventM n a) -> EventM n a
$cp1MonadCatch :: forall n. MonadThrow (EventM n)
MonadCatch, MonadCatch (EventM n)
MonadCatch (EventM n)
-> (forall b.
    ((forall a. EventM n a -> EventM n a) -> EventM n b) -> EventM n b)
-> (forall b.
    ((forall a. EventM n a -> EventM n a) -> EventM n b) -> EventM n b)
-> (forall a b c.
    EventM n a
    -> (a -> ExitCase b -> EventM n c)
    -> (a -> EventM n b)
    -> EventM n (b, c))
-> MonadMask (EventM n)
EventM n a
-> (a -> ExitCase b -> EventM n c)
-> (a -> EventM n b)
-> EventM n (b, c)
((forall a. EventM n a -> EventM n a) -> EventM n b) -> EventM n b
((forall a. EventM n a -> EventM n a) -> EventM n b) -> EventM n b
forall n. MonadCatch (EventM n)
forall b.
((forall a. EventM n a -> EventM n a) -> EventM n b) -> EventM n b
forall n b.
((forall a. EventM n a -> EventM n a) -> EventM n b) -> EventM n b
forall a b c.
EventM n a
-> (a -> ExitCase b -> EventM n c)
-> (a -> EventM n b)
-> EventM n (b, c)
forall n a b c.
EventM n a
-> (a -> ExitCase b -> EventM n c)
-> (a -> EventM n b)
-> EventM n (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: EventM n a
-> (a -> ExitCase b -> EventM n c)
-> (a -> EventM n b)
-> EventM n (b, c)
$cgeneralBracket :: forall n a b c.
EventM n a
-> (a -> ExitCase b -> EventM n c)
-> (a -> EventM n b)
-> EventM n (b, c)
uninterruptibleMask :: ((forall a. EventM n a -> EventM n a) -> EventM n b) -> EventM n b
$cuninterruptibleMask :: forall n b.
((forall a. EventM n a -> EventM n a) -> EventM n b) -> EventM n b
mask :: ((forall a. EventM n a -> EventM n a) -> EventM n b) -> EventM n b
$cmask :: forall n b.
((forall a. EventM n a -> EventM n a) -> EventM n b) -> EventM n b
$cp1MonadMask :: forall n. MonadCatch (EventM n)
MonadMask, Monad (EventM n)
Monad (EventM n)
-> (forall a. String -> EventM n a) -> MonadFail (EventM n)
String -> EventM n a
forall n. Monad (EventM n)
forall a. String -> EventM n a
forall n a. String -> EventM n a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> EventM n a
$cfail :: forall n a. String -> EventM n a
$cp1MonadFail :: forall n. Monad (EventM n)
MonadFail
                    )

-- | Widget size policies. These policies communicate how a widget uses
-- space when being rendered. These policies influence rendering order
-- and space allocation in the box layout algorithm for 'hBox' and
-- 'vBox'.
data Size = Fixed
          -- ^ Widgets advertising this size policy should take up the
          -- same amount of space no matter how much they are given,
          -- i.e. their size depends on their contents alone rather than
          -- on the size of the rendering area.
          | Greedy
          -- ^ Widgets advertising this size policy must take up all the
          -- space they are given.
          deriving (Int -> Size -> ShowS
[Size] -> ShowS
Size -> String
(Int -> Size -> ShowS)
-> (Size -> String) -> ([Size] -> ShowS) -> Show Size
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Size] -> ShowS
$cshowList :: [Size] -> ShowS
show :: Size -> String
$cshow :: Size -> String
showsPrec :: Int -> Size -> ShowS
$cshowsPrec :: Int -> Size -> ShowS
Show, Size -> Size -> Bool
(Size -> Size -> Bool) -> (Size -> Size -> Bool) -> Eq Size
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Size -> Size -> Bool
$c/= :: Size -> Size -> Bool
== :: Size -> Size -> Bool
$c== :: Size -> Size -> Bool
Eq, Eq Size
Eq Size
-> (Size -> Size -> Ordering)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Size)
-> (Size -> Size -> Size)
-> Ord Size
Size -> Size -> Bool
Size -> Size -> Ordering
Size -> Size -> Size
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Size -> Size -> Size
$cmin :: Size -> Size -> Size
max :: Size -> Size -> Size
$cmax :: Size -> Size -> Size
>= :: Size -> Size -> Bool
$c>= :: Size -> Size -> Bool
> :: Size -> Size -> Bool
$c> :: Size -> Size -> Bool
<= :: Size -> Size -> Bool
$c<= :: Size -> Size -> Bool
< :: Size -> Size -> Bool
$c< :: Size -> Size -> Bool
compare :: Size -> Size -> Ordering
$ccompare :: Size -> Size -> Ordering
$cp1Ord :: Eq Size
Ord)

-- | The type of widgets.
data Widget n =
    Widget { Widget n -> Size
hSize :: Size
           -- ^ This widget's horizontal growth policy
           , Widget n -> Size
vSize :: Size
           -- ^ This widget's vertical growth policy
           , Widget n -> RenderM n (Result n)
render :: RenderM n (Result n)
           -- ^ This widget's rendering function
           }

-- | The type of the rendering monad. This monad is used by the
-- library's rendering routines to manage rendering state and
-- communicate rendering parameters to widgets' rendering functions.
type RenderM n a = ReaderT Context (State (RenderState n)) a

-- | Get the current rendering context.
getContext :: RenderM n Context
getContext :: RenderM n Context
getContext = RenderM n Context
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask

suffixLenses ''Context

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