    {-# 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

      -- * Utility
      , joinableBorder
      )
    where

    #if !MIN_VERSION_base(4,8,0)
    import Control.Applicative ((<$>))
    #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 = "border"

    -- | 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 f =
        Widget Fixed Fixed $ do
          bs <- ctxBorderStyle <$> getContext
          render $ withAttr borderAttr $ str [f bs]

    -- | Put a border around the specified widget.
    border :: Widget n -> Widget n
    border = border_ 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 label = border_ (Just label)

    border_ :: Maybe (Widget n) -> Widget n -> Widget n
    border_ label wrapped =
        Widget (hSize wrapped) (vSize wrapped) $ do
          c <- getContext

          middleResult <- render $ hLimit (c^.availWidthL - 2)
                                 $ vLimit (c^.availHeightL - 2)
                                 $ wrapped

          let tl = joinableBorder (Edges False True False True)
              tr = joinableBorder (Edges False True True False)
              bl = joinableBorder (Edges True False False True)
              br = joinableBorder (Edges True False True False)
              top = tl <+> maybe hBorder hBorderWithLabel label <+> tr
              bottom = bl <+> hBorder <+> br
              middle = vBorder <+> (Widget Fixed Fixed $ return middleResult) <+> vBorder
              total = top <=> middle <=> bottom

          render $ hLimit (middleResult^.imageL.to imageWidth + 2)
                 $ vLimit (middleResult^.imageL.to imageHeight + 2)
                 $ total

    -- | A horizontal border.  Fills all horizontal space.
    hBorder :: Widget n
    hBorder =
        withAttr borderAttr $ Widget Greedy Fixed $ do
          ctx <- getContext
          let bs = ctxBorderStyle ctx
              w = availWidth ctx
          db <- dynBorderFromDirections (Edges False False True True)
          let dynBorders = BM.insertH mempty (Run w db)
                         $ BM.emptyCoordinates (Edges 0 0 0 (w-1))
          setDynBorders dynBorders $ render $ vLimit 1 $ fill (bsHorizontal 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 label =
        Widget Greedy Fixed $ do
          res <- render $ vLimit 1 label
          render $ hBox [hBorder, Widget Fixed Fixed (return res), hBorder]

    -- | A vertical border.  Fills all vertical space.
    vBorder :: Widget n
    vBorder =
        withAttr borderAttr $ Widget Fixed Greedy $ do
          ctx <- getContext
          let bs = ctxBorderStyle ctx
              h = availHeight ctx
          db <- dynBorderFromDirections (Edges True True False False)
          let dynBorders = BM.insertV mempty (Run h db)
                         $ BM.emptyCoordinates (Edges 0 (h-1) 0 0)
          setDynBorders dynBorders $ render $ hLimit 1 $ fill (bsVertical 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 dirs = do
        ctx <- getContext
        return DynBorder
            { dbStyle = ctxBorderStyle ctx
            , dbAttr = attrMapLookup (ctxAttrName ctx) (ctxAttrMap ctx)
            , dbSegments = (\draw -> BorderSegment True draw draw) <$> 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 newBorders act = do
        dyn <- ctxDynBorders <$> getContext
        res <- act
        return $ if dyn
            then res & bordersL .~ newBorders
            else res

    -- | A single-character dynamic border that will react to neighboring
    -- borders, initially connecting in the given directions.
    joinableBorder :: Edges Bool -> Widget n
    joinableBorder dirs = withAttr borderAttr . Widget Fixed Fixed $ do
        db <- dynBorderFromDirections dirs
        setDynBorders
            (BM.singleton mempty db)
            (render (raw (renderDynBorder db)))