{-# LANGUAGE OverloadedStrings, NamedFieldPuns, ConstraintKinds #-}
module Brick.Widgets.HelpMessage
( HelpWidget
, Title
, KeyBindings(..)
, helpWidget
, renderHelpWidget
, helpAttr
, resetHelpWidget
, handleHelpEvent
) where
import Brick
import Brick.Widgets.Border
import Graphics.Vty
import Data.Text (Text)
import Data.List
import Lens.Micro
type Title = Text
newtype KeyBindings = KeyBindings [(Title, [(Text, Text)])]
data HelpWidget n = HelpWidget
{ forall n. HelpWidget n -> KeyBindings
keyBindings :: KeyBindings
, forall n. HelpWidget n -> n
name :: n
}
type Name n = (Ord n, Show n)
helpWidget :: n -> KeyBindings -> HelpWidget n
helpWidget :: forall n. n -> KeyBindings -> HelpWidget n
helpWidget = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall n. KeyBindings -> n -> HelpWidget n
HelpWidget
renderHelpWidget :: Name n => HelpWidget n -> Widget n
renderHelpWidget :: forall n. Name n => HelpWidget n -> Widget n
renderHelpWidget HelpWidget{KeyBindings
keyBindings :: KeyBindings
keyBindings :: forall n. HelpWidget n -> KeyBindings
keyBindings, n
name :: n
name :: forall n. HelpWidget n -> n
name} =
forall n. Widget n -> Widget n
center forall a b. (a -> b) -> a -> b
$ forall n. Name n => n -> KeyBindings -> Widget n
renderHelpWidget' n
name KeyBindings
keyBindings
center :: Widget n -> Widget n
center :: forall n. Widget n -> Widget n
center Widget n
w = forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ do
Context n
c <- forall n. RenderM n (Context n)
getContext
Result n
res <- forall n. Widget n -> RenderM n (Result n)
render Widget n
w
let rWidth :: Int
rWidth = Result n
resforall 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
rHeight :: Int
rHeight = Result n
resforall 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
x :: Int
x = (Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL forall a. Integral a => a -> a -> a
`div` Int
2) forall a. Num a => a -> a -> a
- (Int
rWidth forall a. Integral a => a -> a -> a
`div` Int
2)
y :: Int
y = (Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availHeightL forall a. Integral a => a -> a -> a
`div` Int
2) forall a. Num a => a -> a -> a
- (Int
rHeight forall a. Integral a => a -> a -> a
`div` Int
2)
forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. Location -> Widget n -> Widget n
translateBy ((Int, Int) -> Location
Location (Int
x,Int
y)) forall a b. (a -> b) -> a -> b
$ forall n. Image -> Widget n
raw (Result n
resforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageL)
renderHelpWidget' :: Name n => n -> KeyBindings -> Widget n
renderHelpWidget' :: forall n. Name n => n -> KeyBindings -> Widget n
renderHelpWidget' n
name (KeyBindings [(Text, [(Text, Text)])]
bindings) = forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ do
Context n
c <- 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. Int -> Widget n -> Widget n
hLimit (forall a. Ord a => a -> a -> a
min Int
80 forall a b. (a -> b) -> a -> b
$ Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL) forall a b. (a -> b) -> a -> b
$
forall n. Int -> Widget n -> Widget n
vLimit (forall a. Ord a => a -> a -> a
min Int
30 forall a b. (a -> b) -> a -> b
$ Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availHeightL) forall a b. (a -> b) -> a -> b
$
forall n. Widget n -> Widget n -> Widget n
borderWithLabel (forall n. Text -> Widget n
txt Text
"Help") forall a b. (a -> b) -> a -> b
$
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport n
name ViewportType
Vertical forall a b. (a -> b) -> a -> b
$
forall n. [Widget n] -> Widget n
vBox forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse (forall n. Text -> Widget n
txt Text
" ") forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall n. Text -> [(Text, Text)] -> Widget n
section) [(Text, [(Text, Text)])]
bindings
scroller :: HelpWidget n -> ViewportScroll n
scroller :: forall n. HelpWidget n -> ViewportScroll n
scroller HelpWidget{n
name :: n
name :: forall n. HelpWidget n -> n
name} = forall n. n -> ViewportScroll n
viewportScroll n
name
handleHelpEvent :: Event -> EventM n (HelpWidget n) ()
handleHelpEvent :: forall n. Event -> EventM n (HelpWidget n) ()
handleHelpEvent (EvKey Key
k [Modifier]
_) = case Key
k of
KChar Char
'j' -> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall n. HelpWidget n -> ViewportScroll n
scroller forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ViewportScroll n
s -> forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll n
s Int
1
Key
KDown -> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall n. HelpWidget n -> ViewportScroll n
scroller forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ViewportScroll n
s -> forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll n
s Int
1
KChar Char
'k' -> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall n. HelpWidget n -> ViewportScroll n
scroller forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ViewportScroll n
s -> forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll n
s (-Int
1)
Key
KUp -> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall n. HelpWidget n -> ViewportScroll n
scroller forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ViewportScroll n
s -> forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll n
s (-Int
1)
KChar Char
'g' -> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall n. HelpWidget n -> ViewportScroll n
scroller forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ViewportScroll n
s -> forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToBeginning ViewportScroll n
s
Key
KHome -> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall n. HelpWidget n -> ViewportScroll n
scroller forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ViewportScroll n
s -> forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToBeginning ViewportScroll n
s
KChar Char
'G' -> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall n. HelpWidget n -> ViewportScroll n
scroller forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ViewportScroll n
s -> forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToEnd ViewportScroll n
s
Key
KEnd -> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall n. HelpWidget n -> ViewportScroll n
scroller forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ViewportScroll n
s -> forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToEnd ViewportScroll n
s
Key
KPageUp -> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall n. HelpWidget n -> ViewportScroll n
scroller forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ViewportScroll n
s -> forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage ViewportScroll n
s Direction
Up
Key
KPageDown -> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall n. HelpWidget n -> ViewportScroll n
scroller forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ViewportScroll n
s -> forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage ViewportScroll n
s Direction
Down
Key
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
handleHelpEvent Event
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
resetHelpWidget :: HelpWidget n -> EventM n s ()
resetHelpWidget :: forall n s. HelpWidget n -> EventM n s ()
resetHelpWidget HelpWidget n
x = forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToBeginning (forall n. HelpWidget n -> ViewportScroll n
scroller HelpWidget n
x)
key :: Text -> Text -> Widget n
key :: forall n. Text -> Text -> Widget n
key Text
k Text
h = forall n. AttrName -> Widget n -> Widget n
withAttr (AttrName
helpAttr forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"key") (forall n. Text -> Widget n
txt (Text
" " forall a. Semigroup a => a -> a -> a
<> Text
k))
forall n. Widget n -> Widget n -> Widget n
<+> forall n. Padding -> Widget n -> Widget n
padLeft Padding
Max (forall n. AttrName -> Widget n -> Widget n
withAttr (AttrName
helpAttr forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"description") (forall n. Text -> Widget n
txt Text
h))
helpAttr :: AttrName
helpAttr :: AttrName
helpAttr = String -> AttrName
attrName String
"help"
section :: Title -> [(Text, Text)] -> Widget n
section :: forall n. Text -> [(Text, Text)] -> Widget n
section Text
title [(Text, Text)]
keys = forall n. AttrName -> Widget n -> Widget n
withAttr (AttrName
helpAttr forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"title") (forall n. Text -> Widget n
txt (Text
title forall a. Semigroup a => a -> a -> a
<> Text
":"))
forall n. Widget n -> Widget n -> Widget n
<=> forall n. [Widget n] -> Widget n
vBox (forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall n. Text -> Text -> Widget n
key) [(Text, Text)]
keys)