summaryrefslogtreecommitdiff
path: root/programs/CacheDemo.hs
blob: 25817161460a29d18c660dfcef77150113c26cc0 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
{-# LANGUAGE OverloadedStrings #-}
module Main where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif

import Control.Monad (void)
import Data.Monoid ((<>))
import qualified Graphics.Vty as V

import qualified Brick.Types as T
import qualified Brick.Main as M
import qualified Brick.Widgets.Center as C
import Brick.Types
  ( Widget
  , BrickEvent(..)
  )
import Brick.Widgets.Core
  ( vBox
  , padTopBottom
  , withDefAttr
  , cached
  , padBottom
  , str
  )
import Brick (on)
import Brick.Widgets.Center
  ( hCenter
  )
import Brick.AttrMap
  ( AttrName
  , attrMap
  )

data Name = ExpensiveWidget
          deriving (Ord, Show, Eq)

drawUi :: Int -> [Widget Name]
drawUi i = [ui]
    where
        ui = C.vCenter $
             vBox $ hCenter <$>
             [ str "This demo shows how cached widgets behave. The top widget below"
             , str "is cacheable, so once it's rendered, brick re-uses the rendering"
             , str "each time it is drawn. The bottom widget is not cacheable so it is"
             , str "drawn on every request. Brick supports cache invalidation to force"
             , str "a redraw of cached widgets; we can trigger that here with 'i'. Notice"
             , str "how state changes with '+' aren't reflected in the cached widget"
             , str "until the cache is invalidated with 'i'."
             , padTopBottom 1 $
               cached ExpensiveWidget $
               withDefAttr emphAttr $ str $ "This widget is cached (state = " <> show i <> ")"
             , padBottom (T.Pad 1) $
               withDefAttr emphAttr $ str $ "This widget is not cached (state = " <> show i <> ")"
             , hCenter $ str "Press 'i' to invalidate the cache,"
             , str "'+' to change the state value, and"
             , str "'Esc' to quit."
             ]

appEvent :: Int -> BrickEvent Name e -> T.EventM Name (T.Next Int)
appEvent i (VtyEvent (V.EvKey (V.KChar '+') [])) = M.continue $ i + 1
appEvent i (VtyEvent (V.EvKey (V.KChar 'i') [])) = M.invalidateCacheEntry ExpensiveWidget >> M.continue i
appEvent i (VtyEvent (V.EvKey V.KEsc [])) = M.halt i
appEvent i _ = M.continue i

emphAttr :: AttrName
emphAttr = "emphasis"

app :: M.App Int e Name
app =
    M.App { M.appDraw = drawUi
          , M.appStartEvent = return
          , M.appHandleEvent = appEvent
          , M.appAttrMap = const $ attrMap V.defAttr [(emphAttr, V.white `on` V.blue)]
          , M.appChooseCursor = M.neverShowCursor
          }

main :: IO ()
main = void $ M.defaultMain app 0