{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Matterhorn.Draw.ListOverlay
( drawListOverlay
, OverlayPosition(..)
)
where
import Prelude ()
import Matterhorn.Prelude
import Brick
import Brick.Widgets.Border
import Brick.Widgets.Center
import Brick.Widgets.Edit
import qualified Brick.Widgets.List as L
import Control.Monad.Trans.Reader ( withReaderT )
import qualified Data.Foldable as F
import qualified Data.Text as T
import Graphics.Vty ( imageWidth, translateX)
import Lens.Micro.Platform ( (%~), (.~), to )
import Matterhorn.Themes
import Matterhorn.Types
hLimitWithPadding :: Int -> Widget n -> Widget n
hLimitWithPadding pad contents = Widget
{ hSize = Fixed
, vSize = (vSize contents)
, render =
withReaderT (& availWidthL %~ (\ n -> n - (2 * pad))) $ render $ cropToContext contents
}
data OverlayPosition =
OverlayCenter
| OverlayUpperRight
deriving (Eq, Show)
drawListOverlay :: ListOverlayState a b
-> (b -> Widget Name)
-> (b -> Widget Name)
-> (b -> Widget Name)
-> (Bool -> a -> Widget Name)
-> Maybe (Widget Name)
-> OverlayPosition
-> Int
-> Widget Name
drawListOverlay st scopeHeader scopeNoResults scopePrompt renderItem footer layerPos maxWinWidth =
positionLayer $ hLimitWithPadding 10 $ vLimit 25 $
hLimit maxWinWidth $
borderWithLabel title body
where
title = withDefAttr clientEmphAttr $
hBox [ scopeHeader scope
, case st^.listOverlayRecordCount of
Nothing -> emptyWidget
Just c -> txt " (" <+> str (show c) <+> txt ")"
]
positionLayer = case layerPos of
OverlayCenter -> centerLayer
OverlayUpperRight -> upperRightLayer
body = vBox [ (padRight (Pad 1) promptMsg) <+>
renderEditor (txt . T.unlines) True (st^.listOverlaySearchInput)
, cursorPositionBorder
, showResults
, fromMaybe emptyWidget footer
]
plural 1 = ""
plural _ = "s"
cursorPositionBorder =
if st^.listOverlaySearching
then hBorderWithLabel $ txt "[Searching...]"
else case st^.listOverlaySearchResults.L.listSelectedL of
Nothing -> hBorder
Just _ ->
let showingFirst = "Showing first " <> show numSearchResults <>
" result" <> plural numSearchResults
showingAll = "Showing all " <> show numSearchResults <>
" result" <> plural numSearchResults
showing = "Showing " <> show numSearchResults <>
" result" <> plural numSearchResults
msg = case getEditContents (st^.listOverlaySearchInput) of
[""] ->
case st^.listOverlayRecordCount of
Nothing -> showing
Just total -> if numSearchResults < total
then showingFirst
else showingAll
_ -> showing
in hBorderWithLabel $ str $ "[" <> msg <> "]"
scope = st^.listOverlaySearchScope
promptMsg = scopePrompt scope
showMessage = center . withDefAttr clientEmphAttr
showResults
| numSearchResults == 0 = showMessage $ scopeNoResults scope
| otherwise = renderedUserList
renderedUserList = L.renderList renderItem True (st^.listOverlaySearchResults)
numSearchResults = F.length $ st^.listOverlaySearchResults.L.listElementsL
upperRightLayer :: Widget a -> Widget a
upperRightLayer w =
Widget (hSize w) (vSize w) $ do
result <- render w
c <- getContext
let rWidth = result^.imageL.to imageWidth
leftPaddingAmount = max 0 $ c^.availWidthL - rWidth
paddedImage = translateX leftPaddingAmount $ result^.imageL
off = Location (leftPaddingAmount, 0)
if leftPaddingAmount == 0 then
return result else
return $ addResultOffset off
$ result & imageL .~ paddedImage