{-# 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 :: Int -> Widget n -> Widget n
hLimitWithPadding Int
pad Widget n
contents = Widget :: forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget
{ hSize :: Size
hSize = Size
Fixed
, vSize :: Size
vSize = (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
contents)
, render :: RenderM n (Result n)
render =
(Context -> Context)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> Context -> Identity Context
Lens' Context Int
availWidthL ((Int -> Identity Int) -> Context -> Identity Context)
-> (Int -> Int) -> Context -> Context
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\ Int
n -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
pad))) (RenderM n (Result n) -> RenderM n (Result n))
-> RenderM n (Result n) -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Widget n -> Widget n
forall n. Widget n -> Widget n
cropToContext Widget n
contents
}
data OverlayPosition =
OverlayCenter
| OverlayUpperRight
deriving (OverlayPosition -> OverlayPosition -> Bool
(OverlayPosition -> OverlayPosition -> Bool)
-> (OverlayPosition -> OverlayPosition -> Bool)
-> Eq OverlayPosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OverlayPosition -> OverlayPosition -> Bool
$c/= :: OverlayPosition -> OverlayPosition -> Bool
== :: OverlayPosition -> OverlayPosition -> Bool
$c== :: OverlayPosition -> OverlayPosition -> Bool
Eq, Int -> OverlayPosition -> ShowS
[OverlayPosition] -> ShowS
OverlayPosition -> String
(Int -> OverlayPosition -> ShowS)
-> (OverlayPosition -> String)
-> ([OverlayPosition] -> ShowS)
-> Show OverlayPosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OverlayPosition] -> ShowS
$cshowList :: [OverlayPosition] -> ShowS
show :: OverlayPosition -> String
$cshow :: OverlayPosition -> String
showsPrec :: Int -> OverlayPosition -> ShowS
$cshowsPrec :: Int -> OverlayPosition -> ShowS
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 :: ListOverlayState a b
-> (b -> Widget Name)
-> (b -> Widget Name)
-> (b -> Widget Name)
-> (Bool -> a -> Widget Name)
-> Maybe (Widget Name)
-> OverlayPosition
-> Int
-> Widget Name
drawListOverlay ListOverlayState a b
st b -> Widget Name
scopeHeader b -> Widget Name
scopeNoResults b -> Widget Name
scopePrompt Bool -> a -> Widget Name
renderItem Maybe (Widget Name)
footer OverlayPosition
layerPos Int
maxWinWidth =
Widget Name -> Widget Name
forall n. Widget n -> Widget n
positionLayer (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimitWithPadding Int
10 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
25 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit Int
maxWinWidth (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
borderWithLabel Widget Name
title Widget Name
body
where
title :: Widget Name
title = AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
[Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox [ b -> Widget Name
scopeHeader b
scope
, case ListOverlayState a b
stListOverlayState a b
-> Getting (Maybe Int) (ListOverlayState a b) (Maybe Int)
-> Maybe Int
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Int) (ListOverlayState a b) (Maybe Int)
forall a b. Lens' (ListOverlayState a b) (Maybe Int)
listOverlayRecordCount of
Maybe Int
Nothing -> Widget Name
forall n. Widget n
emptyWidget
Just Int
c -> Text -> Widget Name
forall n. Text -> Widget n
txt Text
" (" Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget Name
forall n. String -> Widget n
str (Int -> String
forall a. Show a => a -> String
show Int
c) Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget Name
forall n. Text -> Widget n
txt Text
")"
]
positionLayer :: Widget n -> Widget n
positionLayer = case OverlayPosition
layerPos of
OverlayPosition
OverlayCenter -> Widget n -> Widget n
forall n. Widget n -> Widget n
centerLayer
OverlayPosition
OverlayUpperRight -> Widget n -> Widget n
forall n. Widget n -> Widget n
upperRightLayer
body :: Widget Name
body = [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox [ (Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) Widget Name
promptMsg) Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+>
([Text] -> Widget Name) -> Bool -> Editor Text Name -> Widget Name
forall n t.
(Ord n, Show n, Monoid t, TextWidth t, GenericTextZipper t) =>
([t] -> Widget n) -> Bool -> Editor t n -> Widget n
renderEditor (Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> ([Text] -> Text) -> [Text] -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines) Bool
True (ListOverlayState a b
stListOverlayState a b
-> Getting
(Editor Text Name) (ListOverlayState a b) (Editor Text Name)
-> Editor Text Name
forall s a. s -> Getting a s a -> a
^.Getting
(Editor Text Name) (ListOverlayState a b) (Editor Text Name)
forall a b. Lens' (ListOverlayState a b) (Editor Text Name)
listOverlaySearchInput)
, Widget Name
forall n. Widget n
cursorPositionBorder
, Widget Name
showResults
, Widget Name -> Maybe (Widget Name) -> Widget Name
forall a. a -> Maybe a -> a
fromMaybe Widget Name
forall n. Widget n
emptyWidget Maybe (Widget Name)
footer
]
plural :: a -> p
plural a
1 = p
""
plural a
_ = p
"s"
cursorPositionBorder :: Widget n
cursorPositionBorder =
if ListOverlayState a b
stListOverlayState a b
-> Getting Bool (ListOverlayState a b) Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool (ListOverlayState a b) Bool
forall a b. Lens' (ListOverlayState a b) Bool
listOverlaySearching
then Widget n -> Widget n
forall n. Widget n -> Widget n
hBorderWithLabel (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
"[Searching...]"
else case ListOverlayState a b
stListOverlayState a b
-> Getting (Maybe Int) (ListOverlayState a b) (Maybe Int)
-> Maybe Int
forall s a. s -> Getting a s a -> a
^.(List Name a -> Const (Maybe Int) (List Name a))
-> ListOverlayState a b -> Const (Maybe Int) (ListOverlayState a b)
forall a b. Lens' (ListOverlayState a b) (List Name a)
listOverlaySearchResults((List Name a -> Const (Maybe Int) (List Name a))
-> ListOverlayState a b
-> Const (Maybe Int) (ListOverlayState a b))
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
-> List Name a -> Const (Maybe Int) (List Name a))
-> Getting (Maybe Int) (ListOverlayState a b) (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Int -> Const (Maybe Int) (Maybe Int))
-> List Name a -> Const (Maybe Int) (List Name a)
forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
L.listSelectedL of
Maybe Int
Nothing -> Widget n
forall n. Widget n
hBorder
Just Int
_ ->
let showingFirst :: String
showingFirst = String
"Showing first " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
numSearchResults String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
" result" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a p. (Eq a, Num a, IsString p) => a -> p
plural Int
numSearchResults
showingAll :: String
showingAll = String
"Showing all " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
numSearchResults String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
" result" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a p. (Eq a, Num a, IsString p) => a -> p
plural Int
numSearchResults
showing :: String
showing = String
"Showing " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
numSearchResults String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
" result" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a p. (Eq a, Num a, IsString p) => a -> p
plural Int
numSearchResults
msg :: String
msg = case Editor Text Name -> [Text]
forall t n. Monoid t => Editor t n -> [t]
getEditContents (ListOverlayState a b
stListOverlayState a b
-> Getting
(Editor Text Name) (ListOverlayState a b) (Editor Text Name)
-> Editor Text Name
forall s a. s -> Getting a s a -> a
^.Getting
(Editor Text Name) (ListOverlayState a b) (Editor Text Name)
forall a b. Lens' (ListOverlayState a b) (Editor Text Name)
listOverlaySearchInput) of
[Text
""] ->
case ListOverlayState a b
stListOverlayState a b
-> Getting (Maybe Int) (ListOverlayState a b) (Maybe Int)
-> Maybe Int
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Int) (ListOverlayState a b) (Maybe Int)
forall a b. Lens' (ListOverlayState a b) (Maybe Int)
listOverlayRecordCount of
Maybe Int
Nothing -> String
showing
Just Int
total -> if Int
numSearchResults Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
total
then String
showingFirst
else String
showingAll
[Text]
_ -> String
showing
in Widget n -> Widget n
forall n. Widget n -> Widget n
hBorderWithLabel (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ String
"[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]"
scope :: b
scope = ListOverlayState a b
stListOverlayState a b -> Getting b (ListOverlayState a b) b -> b
forall s a. s -> Getting a s a -> a
^.Getting b (ListOverlayState a b) b
forall a b. Lens' (ListOverlayState a b) b
listOverlaySearchScope
promptMsg :: Widget Name
promptMsg = b -> Widget Name
scopePrompt b
scope
showMessage :: Widget n -> Widget n
showMessage = Widget n -> Widget n
forall n. Widget n -> Widget n
center (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr
showResults :: Widget Name
showResults
| Int
numSearchResults Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Widget Name -> Widget Name
forall n. Widget n -> Widget n
showMessage (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ b -> Widget Name
scopeNoResults b
scope
| Bool
otherwise = Widget Name
renderedUserList
renderedUserList :: Widget Name
renderedUserList = (Bool -> a -> Widget Name) -> Bool -> List Name a -> Widget Name
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
L.renderList Bool -> a -> Widget Name
renderItem Bool
True (ListOverlayState a b
stListOverlayState a b
-> Getting (List Name a) (ListOverlayState a b) (List Name a)
-> List Name a
forall s a. s -> Getting a s a -> a
^.Getting (List Name a) (ListOverlayState a b) (List Name a)
forall a b. Lens' (ListOverlayState a b) (List Name a)
listOverlaySearchResults)
numSearchResults :: Int
numSearchResults = Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length (Vector a -> Int) -> Vector a -> Int
forall a b. (a -> b) -> a -> b
$ ListOverlayState a b
stListOverlayState a b
-> Getting (Vector a) (ListOverlayState a b) (Vector a) -> Vector a
forall s a. s -> Getting a s a -> a
^.(List Name a -> Const (Vector a) (List Name a))
-> ListOverlayState a b -> Const (Vector a) (ListOverlayState a b)
forall a b. Lens' (ListOverlayState a b) (List Name a)
listOverlaySearchResults((List Name a -> Const (Vector a) (List Name a))
-> ListOverlayState a b -> Const (Vector a) (ListOverlayState a b))
-> ((Vector a -> Const (Vector a) (Vector a))
-> List Name a -> Const (Vector a) (List Name a))
-> Getting (Vector a) (ListOverlayState a b) (Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vector a -> Const (Vector a) (Vector a))
-> List Name a -> Const (Vector a) (List Name a)
forall n (t1 :: * -> *) e1 (t2 :: * -> *) e2.
Lens (GenericList n t1 e1) (GenericList n t2 e2) (t1 e1) (t2 e2)
L.listElementsL
upperRightLayer :: Widget a -> Widget a
upperRightLayer :: Widget a -> Widget a
upperRightLayer Widget a
w =
Size -> Size -> RenderM a (Result a) -> Widget a
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget a -> Size
forall n. Widget n -> Size
hSize Widget a
w) (Widget a -> Size
forall n. Widget n -> Size
vSize Widget a
w) (RenderM a (Result a) -> Widget a)
-> RenderM a (Result a) -> Widget a
forall a b. (a -> b) -> a -> b
$ do
Result a
result <- Widget a -> RenderM a (Result a)
forall n. Widget n -> RenderM n (Result n)
render Widget a
w
Context
c <- RenderM a Context
forall n. RenderM n Context
getContext
let rWidth :: Int
rWidth = Result a
resultResult a -> Getting Int (Result a) Int -> Int
forall s a. s -> Getting a s a -> a
^.(Image -> Const Int Image) -> Result a -> Const Int (Result a)
forall n. Lens' (Result n) Image
imageL((Image -> Const Int Image) -> Result a -> Const Int (Result a))
-> ((Int -> Const Int Int) -> Image -> Const Int Image)
-> Getting Int (Result a) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Image -> Int) -> SimpleGetter Image Int
forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
imageWidth
leftPaddingAmount :: Int
leftPaddingAmount = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availWidthL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rWidth
paddedImage :: Image
paddedImage = Int -> Image -> Image
translateX Int
leftPaddingAmount (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$ Result a
resultResult a -> Getting Image (Result a) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result a) Image
forall n. Lens' (Result n) Image
imageL
off :: Location
off = (Int, Int) -> Location
Location (Int
leftPaddingAmount, Int
0)
if Int
leftPaddingAmount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then
Result a -> RenderM a (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return Result a
result else
Result a -> RenderM a (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result a -> RenderM a (Result a))
-> Result a -> RenderM a (Result a)
forall a b. (a -> b) -> a -> b
$ Location -> Result a -> Result a
forall n. Location -> Result n -> Result n
addResultOffset Location
off
(Result a -> Result a) -> Result a -> Result a
forall a b. (a -> b) -> a -> b
$ Result a
result Result a -> (Result a -> Result a) -> Result a
forall a b. a -> (a -> b) -> b
& (Image -> Identity Image) -> Result a -> Identity (Result a)
forall n. Lens' (Result n) Image
imageL ((Image -> Identity Image) -> Result a -> Identity (Result a))
-> Image -> Result a -> Result a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Image
paddedImage