{-# LANGUAGE OverloadedStrings #-}
-- | This module provides border widgets: vertical borders, horizontal
-- borders, and a box border wrapper widget. All functions in this
-- module use the rendering context's active 'BorderStyle'; to change
-- the 'BorderStyle', use 'withBorderStyle'.
module Brick.Widgets.Border
  ( -- * Border wrapper
    border
  , borderWithLabel

  -- * Horizontal border
  , hBorder
  , hBorderWithLabel

  -- * Vertical border
  , vBorder

  -- * Drawing single border elements
  , borderElem

  -- * Attribute names
  , borderAttr
  , hBorderAttr
  , vBorderAttr

  -- * Utility
  , joinableBorder
  )
where

#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>))
#endif
import Lens.Micro ((^.), (&), (.~), to)
import Graphics.Vty (imageHeight, imageWidth)

import Brick.AttrMap
import Brick.Types
import Brick.Widgets.Core
import Brick.Widgets.Border.Style (BorderStyle(..))
import Brick.Widgets.Internal (renderDynBorder)
import Data.IMap (Run(..))
import qualified Brick.BorderMap as BM

-- | The top-level border attribute name.
borderAttr :: AttrName
borderAttr :: AttrName
borderAttr = String -> AttrName
attrName String
"border"

-- | The horizontal border attribute name. Inherits from 'borderAttr'.
hBorderAttr :: AttrName
hBorderAttr :: AttrName
hBorderAttr = AttrName
borderAttr forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"horizontal"

-- | The vertical border attribute name. Inherits from 'borderAttr'.
vBorderAttr :: AttrName
vBorderAttr :: AttrName
vBorderAttr = AttrName
borderAttr forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"vertical"

-- | Draw the specified border element using the active border style
-- using 'borderAttr'.
--
-- Does not participate in dynamic borders (due to the difficulty of
-- introspecting on the first argument); consider using 'joinableBorder'
-- instead.
borderElem :: (BorderStyle -> Char) -> Widget n
borderElem :: forall n. (BorderStyle -> Char) -> Widget n
borderElem BorderStyle -> Char
f =
    forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ do
      BorderStyle
bs <- forall n. Context n -> BorderStyle
ctxBorderStyle forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall n. RenderM n (Context n)
getContext
      forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
borderAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str [BorderStyle -> Char
f BorderStyle
bs]

-- | Put a border around the specified widget.
border :: Widget n -> Widget n
border :: forall n. Widget n -> Widget n
border = forall n. Maybe (Widget n) -> Widget n -> Widget n
border_ forall a. Maybe a
Nothing

-- | Put a border around the specified widget with the specified label
-- widget placed in the middle of the top horizontal border.
--
-- Note that a border will wrap its child widget as tightly as possible,
-- which means that if the child widget is narrower than the label
-- widget, the label widget will be truncated. If you want to avoid
-- this behavior, add a 'fill' or other space-filling wrapper to the
-- bordered widget so that it takes up enough room to make the border
-- horizontally able to avoid truncating the label.
borderWithLabel :: Widget n
                -- ^ The label widget
                -> Widget n
                -- ^ The widget to put a border around
                -> Widget n
borderWithLabel :: forall n. Widget n -> Widget n -> Widget n
borderWithLabel Widget n
label = forall n. Maybe (Widget n) -> Widget n -> Widget n
border_ (forall a. a -> Maybe a
Just Widget n
label)

border_ :: Maybe (Widget n) -> Widget n -> Widget n
border_ :: forall n. Maybe (Widget n) -> Widget n -> Widget n
border_ Maybe (Widget n)
label Widget n
wrapped =
    forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (forall n. Widget n -> Size
hSize Widget n
wrapped) (forall n. Widget n -> Size
vSize Widget n
wrapped) forall a b. (a -> b) -> a -> b
$ do
      Context n
c <- forall n. RenderM n (Context n)
getContext

      Result n
middleResult <- forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
hLimit (Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL forall a. Num a => a -> a -> a
- Int
2)
                             forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
vLimit (Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availHeightL forall a. Num a => a -> a -> a
- Int
2)
                             forall a b. (a -> b) -> a -> b
$ Widget n
wrapped

      let tl :: Widget n
tl = forall n. Edges Bool -> Widget n
joinableBorder (forall a. a -> a -> a -> a -> Edges a
Edges Bool
False Bool
True Bool
False Bool
True)
          tr :: Widget n
tr = forall n. Edges Bool -> Widget n
joinableBorder (forall a. a -> a -> a -> a -> Edges a
Edges Bool
False Bool
True Bool
True Bool
False)
          bl :: Widget n
bl = forall n. Edges Bool -> Widget n
joinableBorder (forall a. a -> a -> a -> a -> Edges a
Edges Bool
True Bool
False Bool
False Bool
True)
          br :: Widget n
br = forall n. Edges Bool -> Widget n
joinableBorder (forall a. a -> a -> a -> a -> Edges a
Edges Bool
True Bool
False Bool
True Bool
False)
          top :: Widget n
top = forall {n}. Widget n
tl forall n. Widget n -> Widget n -> Widget n
<+> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {n}. Widget n
hBorder forall n. Widget n -> Widget n
hBorderWithLabel Maybe (Widget n)
label forall n. Widget n -> Widget n -> Widget n
<+> forall {n}. Widget n
tr
          bottom :: Widget n
bottom = forall {n}. Widget n
bl forall n. Widget n -> Widget n -> Widget n
<+> forall {n}. Widget n
hBorder forall n. Widget n -> Widget n -> Widget n
<+> forall {n}. Widget n
br
          middle :: Widget n
middle = forall {n}. Widget n
vBorder forall n. Widget n -> Widget n -> Widget n
<+> (forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Result n
middleResult) forall n. Widget n -> Widget n -> Widget n
<+> forall {n}. Widget n
vBorder
          total :: Widget n
total = Widget n
top forall n. Widget n -> Widget n -> Widget n
<=> Widget n
middle forall n. Widget n -> Widget n -> Widget n
<=> forall {n}. Widget n
bottom

      forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
hLimit (Result n
middleResultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
imageWidth forall a. Num a => a -> a -> a
+ Int
2)
             forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
vLimit (Result n
middleResultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
imageHeight forall a. Num a => a -> a -> a
+ Int
2)
             forall a b. (a -> b) -> a -> b
$ Widget n
total

-- | A horizontal border. Fills all horizontal space. Draws using
-- 'hBorderAttr'.
hBorder :: Widget n
hBorder :: forall {n}. Widget n
hBorder =
    forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
borderAttr forall a b. (a -> b) -> a -> b
$ forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Fixed forall a b. (a -> b) -> a -> b
$ do
      Context n
ctx <- forall n. RenderM n (Context n)
getContext
      let bs :: BorderStyle
bs = forall n. Context n -> BorderStyle
ctxBorderStyle Context n
ctx
          w :: Int
w = forall n. Context n -> Int
availWidth Context n
ctx
      DynBorder
db <- forall n. Edges Bool -> RenderM n DynBorder
dynBorderFromDirections (forall a. a -> a -> a -> a -> Edges a
Edges Bool
False Bool
False Bool
True Bool
True)
      let dynBorders :: BorderMap DynBorder
dynBorders = forall a. Location -> Run a -> BorderMap a -> BorderMap a
BM.insertH forall a. Monoid a => a
mempty (forall a. Int -> a -> Run a
Run Int
w DynBorder
db)
                     forall a b. (a -> b) -> a -> b
$ forall a. Edges Int -> BorderMap a
BM.emptyCoordinates (forall a. a -> a -> a -> a -> Edges a
Edges Int
0 Int
0 Int
0 (Int
wforall a. Num a => a -> a -> a
-Int
1))
      forall n.
BorderMap DynBorder -> RenderM n (Result n) -> RenderM n (Result n)
setDynBorders BorderMap DynBorder
dynBorders forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
hBorderAttr
                               forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
vLimit Int
1 forall a b. (a -> b) -> a -> b
$ forall n. Char -> Widget n
fill (BorderStyle -> Char
bsHorizontal BorderStyle
bs)

-- | A horizontal border with a label placed in the center of the
-- border. Fills all horizontal space.
hBorderWithLabel :: Widget n
                 -- ^ The label widget
                 -> Widget n
hBorderWithLabel :: forall n. Widget n -> Widget n
hBorderWithLabel Widget n
label =
    forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Fixed forall a b. (a -> b) -> a -> b
$ do
      Result n
res <- forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
vLimit Int
1 Widget n
label
      forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
hBox [forall {n}. Widget n
hBorder, forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (forall (m :: * -> *) a. Monad m => a -> m a
return Result n
res), forall {n}. Widget n
hBorder]

-- | A vertical border. Fills all vertical space. Draws using
-- 'vBorderAttr'.
vBorder :: Widget n
vBorder :: forall {n}. Widget n
vBorder =
    forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
borderAttr forall a b. (a -> b) -> a -> b
$ forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Greedy forall a b. (a -> b) -> a -> b
$ do
      Context n
ctx <- forall n. RenderM n (Context n)
getContext
      let bs :: BorderStyle
bs = forall n. Context n -> BorderStyle
ctxBorderStyle Context n
ctx
          h :: Int
h = forall n. Context n -> Int
availHeight Context n
ctx
      DynBorder
db <- forall n. Edges Bool -> RenderM n DynBorder
dynBorderFromDirections (forall a. a -> a -> a -> a -> Edges a
Edges Bool
True Bool
True Bool
False Bool
False)
      let dynBorders :: BorderMap DynBorder
dynBorders = forall a. Location -> Run a -> BorderMap a -> BorderMap a
BM.insertV forall a. Monoid a => a
mempty (forall a. Int -> a -> Run a
Run Int
h DynBorder
db)
                     forall a b. (a -> b) -> a -> b
$ forall a. Edges Int -> BorderMap a
BM.emptyCoordinates (forall a. a -> a -> a -> a -> Edges a
Edges Int
0 (Int
hforall a. Num a => a -> a -> a
-Int
1) Int
0 Int
0)
      forall n.
BorderMap DynBorder -> RenderM n (Result n) -> RenderM n (Result n)
setDynBorders BorderMap DynBorder
dynBorders forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
vBorderAttr
                               forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
hLimit Int
1 forall a b. (a -> b) -> a -> b
$ forall n. Char -> Widget n
fill (BorderStyle -> Char
bsVertical BorderStyle
bs)

-- | Initialize a 'DynBorder'. It will be 'bsDraw'n and 'bsOffer'ing
-- in the given directions to begin with, and accept join offers from
-- all directions. We consult the context to choose the 'dbStyle' and
-- 'dbAttr'.
--
-- This is likely to be useful only for custom widgets that need more
-- complicated dynamic border behavior than 'border', 'vBorder', or
-- 'hBorder' offer.
dynBorderFromDirections :: Edges Bool -> RenderM n DynBorder
dynBorderFromDirections :: forall n. Edges Bool -> RenderM n DynBorder
dynBorderFromDirections Edges Bool
dirs = do
    Context n
ctx <- forall n. RenderM n (Context n)
getContext
    forall (m :: * -> *) a. Monad m => a -> m a
return DynBorder
        { dbStyle :: BorderStyle
dbStyle = forall n. Context n -> BorderStyle
ctxBorderStyle Context n
ctx
        , dbAttr :: Attr
dbAttr = AttrName -> AttrMap -> Attr
attrMapLookup (forall n. Context n -> AttrName
ctxAttrName Context n
ctx) (forall n. Context n -> AttrMap
ctxAttrMap Context n
ctx)
        , dbSegments :: Edges BorderSegment
dbSegments = (\Bool
draw -> Bool -> Bool -> Bool -> BorderSegment
BorderSegment Bool
True Bool
draw Bool
draw) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Edges Bool
dirs
        }

-- | Replace the 'Result'\'s dynamic borders with the given one,
-- provided the context says to use dynamic borders at all.
setDynBorders :: BM.BorderMap DynBorder -> RenderM n (Result n) -> RenderM n (Result n)
setDynBorders :: forall n.
BorderMap DynBorder -> RenderM n (Result n) -> RenderM n (Result n)
setDynBorders BorderMap DynBorder
newBorders RenderM n (Result n)
act = do
    Bool
dyn <- forall n. Context n -> Bool
ctxDynBorders forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall n. RenderM n (Context n)
getContext
    Result n
res <- RenderM n (Result n)
act
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
dyn
        then Result n
res forall a b. a -> (a -> b) -> b
& forall n. Lens' (Result n) (BorderMap DynBorder)
bordersL forall s t a b. ASetter s t a b -> b -> s -> t
.~ BorderMap DynBorder
newBorders
        else Result n
res

-- | A single-character dynamic border that will react to neighboring
-- borders, initially connecting in the given directions.
joinableBorder :: Edges Bool -> Widget n
joinableBorder :: forall n. Edges Bool -> Widget n
joinableBorder Edges Bool
dirs = forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
borderAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ do
    DynBorder
db <- forall n. Edges Bool -> RenderM n DynBorder
dynBorderFromDirections Edges Bool
dirs
    forall n.
BorderMap DynBorder -> RenderM n (Result n) -> RenderM n (Result n)
setDynBorders
        (forall a. Location -> a -> BorderMap a
BM.singleton forall a. Monoid a => a
mempty DynBorder
db)
        (forall n. Widget n -> RenderM n (Result n)
render (forall n. Image -> Widget n
raw (DynBorder -> Image
renderDynBorder DynBorder
db)))