{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Matterhorn.Draw.ListWindow
( drawListWindow
, WindowPosition(..)
)
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 :: forall n. Int -> Widget n -> Widget n
hLimitWithPadding Int
pad Widget n
contents = Widget
{ hSize :: Size
hSize = Size
Fixed
, vSize :: Size
vSize = (forall n. Widget n -> Size
vSize Widget n
contents)
, render :: RenderM n (Result n)
render =
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall a b. a -> (a -> b) -> b
& forall n. Lens' (Context n) Int
availWidthL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\ Int
n -> Int
n forall a. Num a => a -> a -> a
- (Int
2 forall a. Num a => a -> a -> a
* Int
pad))) 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. Widget n -> Widget n
cropToContext Widget n
contents
}
data WindowPosition =
WindowCenter
| WindowUpperRight
deriving (WindowPosition -> WindowPosition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowPosition -> WindowPosition -> Bool
$c/= :: WindowPosition -> WindowPosition -> Bool
== :: WindowPosition -> WindowPosition -> Bool
$c== :: WindowPosition -> WindowPosition -> Bool
Eq, Int -> WindowPosition -> ShowS
[WindowPosition] -> ShowS
WindowPosition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WindowPosition] -> ShowS
$cshowList :: [WindowPosition] -> ShowS
show :: WindowPosition -> String
$cshow :: WindowPosition -> String
showsPrec :: Int -> WindowPosition -> ShowS
$cshowsPrec :: Int -> WindowPosition -> ShowS
Show)
drawListWindow :: ListWindowState a b
-> (b -> Widget Name)
-> (b -> Widget Name)
-> (b -> Widget Name)
-> (Bool -> a -> Widget Name)
-> Maybe (Widget Name)
-> WindowPosition
-> Int
-> Widget Name
drawListWindow :: forall a b.
ListWindowState a b
-> (b -> Widget Name)
-> (b -> Widget Name)
-> (b -> Widget Name)
-> (Bool -> a -> Widget Name)
-> Maybe (Widget Name)
-> WindowPosition
-> Int
-> Widget Name
drawListWindow ListWindowState a b
st b -> Widget Name
scopeHeader b -> Widget Name
scopeNoResults b -> Widget Name
scopePrompt Bool -> a -> Widget Name
renderItem Maybe (Widget Name)
footer WindowPosition
layerPos Int
maxWinWidth =
forall n. Widget n -> Widget n
positionLayer forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
hLimitWithPadding Int
10 forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
vLimit Int
25 forall a b. (a -> b) -> a -> b
$
forall n. Int -> Widget n -> Widget n
hLimit Int
maxWinWidth forall a b. (a -> b) -> a -> b
$
forall n. Widget n -> Widget n -> Widget n
borderWithLabel Widget Name
title Widget Name
body
where
title :: Widget Name
title = forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr forall a b. (a -> b) -> a -> b
$
forall n. [Widget n] -> Widget n
hBox [ b -> Widget Name
scopeHeader b
scope
, case ListWindowState a b
stforall s a. s -> Getting a s a -> a
^.forall a b. Lens' (ListWindowState a b) (Maybe Int)
listWindowRecordCount of
Maybe Int
Nothing -> forall n. Widget n
emptyWidget
Just Int
c -> forall n. Text -> Widget n
txt Text
" (" forall n. Widget n -> Widget n -> Widget n
<+> forall n. String -> Widget n
str (forall a. Show a => a -> String
show Int
c) forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt Text
")"
]
positionLayer :: Widget n -> Widget n
positionLayer = case WindowPosition
layerPos of
WindowPosition
WindowCenter -> forall n. Widget n -> Widget n
centerLayer
WindowPosition
WindowUpperRight -> forall n. Widget n -> Widget n
upperRightLayer
body :: Widget Name
body = forall n. [Widget n] -> Widget n
vBox [ (forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) Widget Name
promptMsg) forall n. Widget n -> Widget n -> Widget n
<+>
forall n t.
(Ord n, Show n, Monoid t, TextWidth t, GenericTextZipper t) =>
([t] -> Widget n) -> Bool -> Editor t n -> Widget n
renderEditor (forall n. Text -> Widget n
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines) Bool
True (ListWindowState a b
stforall s a. s -> Getting a s a -> a
^.forall a b. Lens' (ListWindowState a b) (Editor Text Name)
listWindowSearchInput)
, forall n. Widget n
cursorPositionBorder
, Widget Name
showResults
, forall a. a -> Maybe a -> a
fromMaybe forall n. Widget n
emptyWidget Maybe (Widget Name)
footer
]
plural :: a -> a
plural a
1 = a
""
plural a
_ = a
"s"
cursorPositionBorder :: Widget n
cursorPositionBorder =
if ListWindowState a b
stforall s a. s -> Getting a s a -> a
^.forall a b. Lens' (ListWindowState a b) Bool
listWindowSearching
then forall n. Widget n -> Widget n
hBorderWithLabel forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"[Searching...]"
else case ListWindowState a b
stforall s a. s -> Getting a s a -> a
^.forall a b. Lens' (ListWindowState a b) (List Name a)
listWindowSearchResultsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
L.listSelectedL of
Maybe Int
Nothing -> forall n. Widget n
hBorder
Just Int
_ ->
let showingFirst :: String
showingFirst = String
"Showing first " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
numSearchResults forall a. Semigroup a => a -> a -> a
<>
String
" result" forall a. Semigroup a => a -> a -> a
<> forall {a} {a}. (Eq a, Num a, IsString a) => a -> a
plural Int
numSearchResults
showingAll :: String
showingAll = String
"Showing all " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
numSearchResults forall a. Semigroup a => a -> a -> a
<>
String
" result" forall a. Semigroup a => a -> a -> a
<> forall {a} {a}. (Eq a, Num a, IsString a) => a -> a
plural Int
numSearchResults
showing :: String
showing = String
"Showing " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
numSearchResults forall a. Semigroup a => a -> a -> a
<>
String
" result" forall a. Semigroup a => a -> a -> a
<> forall {a} {a}. (Eq a, Num a, IsString a) => a -> a
plural Int
numSearchResults
msg :: String
msg = case forall t n. Monoid t => Editor t n -> [t]
getEditContents (ListWindowState a b
stforall s a. s -> Getting a s a -> a
^.forall a b. Lens' (ListWindowState a b) (Editor Text Name)
listWindowSearchInput) of
[Text
""] ->
case ListWindowState a b
stforall s a. s -> Getting a s a -> a
^.forall a b. Lens' (ListWindowState a b) (Maybe Int)
listWindowRecordCount of
Maybe Int
Nothing -> String
showing
Just Int
total -> if Int
numSearchResults forall a. Ord a => a -> a -> Bool
< Int
total
then String
showingFirst
else String
showingAll
[Text]
_ -> String
showing
in forall n. Widget n -> Widget n
hBorderWithLabel forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ String
"[" forall a. Semigroup a => a -> a -> a
<> String
msg forall a. Semigroup a => a -> a -> a
<> String
"]"
scope :: b
scope = ListWindowState a b
stforall s a. s -> Getting a s a -> a
^.forall a b. Lens' (ListWindowState a b) b
listWindowSearchScope
promptMsg :: Widget Name
promptMsg = b -> Widget Name
scopePrompt b
scope
showMessage :: Widget n -> Widget n
showMessage = forall n. Widget n -> Widget n
center forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr
showResults :: Widget Name
showResults
| Int
numSearchResults forall a. Eq a => a -> a -> Bool
== Int
0 = forall n. Widget n -> Widget n
showMessage forall a b. (a -> b) -> a -> b
$ b -> Widget Name
scopeNoResults b
scope
| Bool
otherwise = Widget Name
renderedUserList
renderedUserList :: Widget Name
renderedUserList = 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 (ListWindowState a b
stforall s a. s -> Getting a s a -> a
^.forall a b. Lens' (ListWindowState a b) (List Name a)
listWindowSearchResults)
numSearchResults :: Int
numSearchResults = forall (t :: * -> *) a. Foldable t => t a -> Int
F.length forall a b. (a -> b) -> a -> b
$ ListWindowState a b
stforall s a. s -> Getting a s a -> a
^.forall a b. Lens' (ListWindowState a b) (List Name a)
listWindowSearchResultsforall b c a. (b -> c) -> (a -> b) -> a -> c
.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 :: forall n. Widget n -> Widget n
upperRightLayer Widget a
w =
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (forall n. Widget n -> Size
hSize Widget a
w) (forall n. Widget n -> Size
vSize Widget a
w) forall a b. (a -> b) -> a -> b
$ do
Result a
result <- forall n. Widget n -> RenderM n (Result n)
render Widget a
w
Context a
c <- forall n. RenderM n (Context n)
getContext
let rWidth :: Int
rWidth = Result a
resultforall 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
leftPaddingAmount :: Int
leftPaddingAmount = forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ Context a
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL forall a. Num a => a -> a -> a
- Int
rWidth
paddedImage :: Image
paddedImage = Int -> Image -> Image
translateX Int
leftPaddingAmount forall a b. (a -> b) -> a -> b
$ Result a
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageL
off :: Location
off = (Int, Int) -> Location
Location (Int
leftPaddingAmount, Int
0)
if Int
leftPaddingAmount forall a. Eq a => a -> a -> Bool
== Int
0 then
forall (m :: * -> *) a. Monad m => a -> m a
return Result a
result else
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. Location -> Result n -> Result n
addResultOffset Location
off
forall a b. (a -> b) -> a -> b
$ Result a
result forall a b. a -> (a -> b) -> b
& forall n. Lens' (Result n) Image
imageL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Image
paddedImage