brick/programs/TailDemo.hs
2022-07-16 23:10:03 -07:00

153 lines
4.8 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Main where
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>))
#endif
import qualified Data.Text as T
import Control.Monad (void)
import Control.Concurrent
import Lens.Micro.TH
import Lens.Micro.Mtl
import System.Random
import Brick
import Brick.BChan
import Brick.Widgets.Border
import qualified Graphics.Vty as V
data AppState =
AppState { _textAreaHeight :: Int
, _textAreaWidth :: Int
, _textAreaContents :: [T.Text]
}
makeLenses ''AppState
draw :: AppState -> Widget n
draw st =
header st <=> box st
header :: AppState -> Widget n
header st =
padBottom (Pad 1) $
hBox [ padRight (Pad 7) $
(str $ "Max width: " <> show (_textAreaWidth st)) <=>
(str "Left(-)/Right(+)")
, (str $ "Max height: " <> show (_textAreaHeight st)) <=>
(str "Down(-)/Up(+)")
]
box :: AppState -> Widget n
box st =
border $
hLimit (_textAreaWidth st) $
vLimit (_textAreaHeight st) $
(renderBottomUp (txtWrap <$> _textAreaContents st))
-- | Given a list of widgets, draw them bottom-up in a vertical
-- arrangement, i.e., the first widget in this list will appear at the
-- bottom of the rendering area. Rendering stops when the rendering area
-- is full, i.e., items that cannot be rendered are never evaluated or
-- drawn.
renderBottomUp :: [Widget n] -> Widget n
renderBottomUp ws =
Widget Greedy Greedy $ do
let go _ [] = return V.emptyImage
go remainingHeight (c:cs) = do
cResult <- render c
let img = image cResult
newRemainingHeight = remainingHeight - V.imageHeight img
if newRemainingHeight == 0
then return img
else if newRemainingHeight < 0
then return $ V.cropTop remainingHeight img
else do
rest <- go newRemainingHeight cs
return $ V.vertCat [rest, img]
ctx <- getContext
img <- go (availHeight ctx) ws
render $ fill ' ' <=> raw img
textLines :: [T.Text]
textLines =
[ "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut"
, "labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco"
, "laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit"
, "in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat"
, "cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum."
]
handleEvent :: BrickEvent n CustomEvent -> EventM n AppState ()
handleEvent (AppEvent (NewLine l)) =
textAreaContents %= (l :)
handleEvent (VtyEvent (V.EvKey V.KUp [])) =
textAreaHeight %= (+ 1)
handleEvent (VtyEvent (V.EvKey V.KDown [])) =
textAreaHeight %= max 0 . subtract 1
handleEvent (VtyEvent (V.EvKey V.KRight [])) =
textAreaWidth %= (+ 1)
handleEvent (VtyEvent (V.EvKey V.KLeft [])) =
textAreaWidth %= max 0 . subtract 1
handleEvent (VtyEvent (V.EvKey V.KEsc [])) =
halt
handleEvent _ =
return ()
data CustomEvent =
NewLine T.Text
app :: App AppState CustomEvent ()
app =
App { appDraw = (:[]) . draw
, appChooseCursor = neverShowCursor
, appHandleEvent = handleEvent
, appAttrMap = const $ attrMap V.defAttr []
, appStartEvent = return ()
}
initialState :: AppState
initialState =
AppState { _textAreaHeight = 20
, _textAreaWidth = 40
, _textAreaContents = []
}
-- | Run forever, generating new lines of text for the application
-- window, prefixed with a line number. This function simulates the kind
-- of behavior that you'd get from running 'tail -f' on a file.
generateLines :: BChan CustomEvent -> IO ()
generateLines chan = go (1::Integer)
where
go lineNum = do
-- Wait a random amount of time (in milliseconds)
let delayOptions = [500, 1000, 2000]
delay <- randomVal delayOptions
threadDelay $ delay * 1000
-- Choose a random line of text from our collection
l <- randomVal textLines
-- Send it to the application to be added to the UI
writeBChan chan $ NewLine $ (T.pack $ "Line " <> show lineNum <> " - ") <> l
go $ lineNum + 1
randomVal :: [a] -> IO a
randomVal as = do
idx <- randomRIO (0, length as - 1)
return $ as !! idx
main :: IO ()
main = do
cfg <- V.standardIOConfig
vty <- V.mkVty cfg
chan <- newBChan 10
-- Run thread to simulate incoming data
void $ forkIO $ generateLines chan
void $ customMain vty (V.mkVty cfg) (Just chan) app initialState