{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE NoFieldSelectors #-}
module Main where
import Brick.Widgets.TabularList.Grid
-- base
import GHC.Generics (Generic)
import Control.Monad (void)
-- Third party libraries
import Optics.Core
import Data.Sequence (Seq)
import qualified Data.Sequence as S
import qualified Data.Vector as V
import Data.Vector (Vector)
-- brick
import Brick.Main
import Brick.AttrMap
import Brick.Types
import Brick.Widgets.Core
import Brick.Widgets.Center
import Brick.Widgets.Border
import Brick.Util
import Brick.Widgets.List
import Brick.Widgets.Border.Style
import Graphics.Vty (defAttr, Event(..), Key(..), Modifier(..), black, white, blue, red)
data Song = Song {
artist :: String
, title :: String
, album :: String
, composer :: String
, genre :: String
, time :: Int
} deriving (Generic)
data Name = TheList deriving (Eq, Ord, Show)
data AppState = AppState {
libList :: LibraryList
, libRenderers :: LibraryRenderers
, listWidth :: Int
} deriving Generic
type LibraryList = GridTabularList Name Song
type LibraryRenderers = GridRenderers Name Song
songs :: Seq Song
songs = S.fromList $
map (\n -> Song {
artist = "Artist " <> show n
, title = "Title " <> show n
, album = "Album " <> show n
, composer = "Composer " <> show n
, genre = "Genre " <> show n
, time = n
})
[1..1000]
handleLibEvent :: BrickEvent Name () -> EventM Name AppState ()
handleLibEvent e = do
s <- get
let r = s ^. #libRenderers
case e of
VtyEvent (EvKey KEsc []) -> halt
VtyEvent (EvKey (KChar 'q') []) -> halt
VtyEvent (EvKey (KChar 'r') []) -> zoom (#libRenderers . #rowHdr) $ modify $ \case
Nothing -> Just rowHdr
Just _ -> Nothing
VtyEvent (EvKey (KChar 'c') []) -> zoom (#libRenderers . #colHdr) $ modify $ \case
Nothing -> Just colHdr
Just _ -> Nothing
VtyEvent (EvKey (KChar '-') []) -> zoom #listWidth $ modify $ max 1 . subtract 1
VtyEvent (EvKey (KChar '=') []) -> zoom #listWidth $ modify (+1)
VtyEvent e -> zoom #libList $ do
handleGridListEvent r e
handleGridListEventVi r e
_ -> return ()
drawUi :: AppState -> [Widget Name]
drawUi s = let
msgs = [ "Press Up arrow or k to go up one item"
, "Press Down arrow or j to go down one item"
, "Press PageUp or Ctrl+f to go up one page"
, "Press PageDown or Ctrl+b to go down one page"
, "Press Home or g to go to the beginning"
, "Press End or G to go to the end"
, "Press Ctrl+u to go up half page"
, "Press Ctrl+d to go down half page"
, " "
, "Press Left arrow or h to go left by one column"
, "Press Right arrow or l to go right by one column"
, "Press Ctrl+Home or H to go to the first column"
, "Press Ctrl+End or L to go to the last column"
, "Press Ctrl+PageUp or Alt+h or Backspace to go left by one page of columns"
, "Press Ctrl+PageDown or Alt+l to go right by one page of columns" ]
theList = renderGridTabularList (s ^. #libRenderers) (LstFcs True) (s ^. #libList)
in [vCenter $ vBox $ hCenter (padLeftRight 2 $ joinBorders $ border $ hLimit (s ^. #listWidth) $ vLimit 15 theList)
: hCenter (str "Press Esc or q to exit" )
: hCenter (str "Press c to toggle column headers")
: hCenter (str "Press r to toggle row headaers")
: hCenter (str "Press - to shorten the list and = to widen the list")
: hCenter (str " ")
: map (hCenter . str) msgs]
columnHdrAttr :: AttrName
columnHdrAttr = attrName "columnHeader"
rowHdrAttr :: AttrName
rowHdrAttr = attrName "rowHeader"
colSelectedAttr :: AttrName
colSelectedAttr = attrName "selectedColumn"
rowHdr :: RowHdr Name Song
rowHdr = RowHdr {
draw = \_ (WdthD wd) (RowHdrCtxt (Sel s)) r -> let
attrFn = if s
then id
else withAttr rowHdrAttr
in attrFn $ padRight (Pad $ if wd > 0 then 0 else 1) $ padLeft Max (str $ show r)
, width = \_ rs -> RowHdrW $ (+2) $ maximum $ map (length . show) rs
, toRH = \_ (Ix i) -> i+1
}
colHdrs :: Vector String
colHdrs = V.fromList ["Artist", "Title", "Album", "Composer", "Genre", "Time"]
colHdr :: GridColHdr Name
colHdr = GridColHdr {
draw = \_ (WdthD wd) (GColC (Ix ci) _) -> let
renderColH = withAttr columnHdrAttr . padRight (Pad $ if wd > 0 then 0 else 1) . padRight Max . str
in case colHdrs V.!? ci of
Just ch -> renderColH ch <=> hBorder
Nothing -> emptyWidget
, height = ColHdrH 2
}
renderers :: LibraryRenderers
renderers = GridRenderers {
cell = \_ (WdthD wd) (GrdCtxt (GRowC _ (Sel rs)) (GColC (Ix ci) (Sel cs))) s -> let
attrFn = if rs && cs
then withAttr colSelectedAttr
else id
renderCell s = padRight (Pad $ if wd > 0 then 0 else 1) (padRight Max $ str s)
in attrFn $ case ci of
0 -> renderCell $ s ^. #artist
1 -> renderCell $ s ^. #title
2 -> renderCell $ s ^. #album
3 -> renderCell $ s ^. #composer
4 -> renderCell $ s ^. #genre
5 -> let
(min, sec) = (s ^. #time) `divMod` 60
in renderCell $ case min of
0 -> show sec
_ -> show min <> ":" <> show sec
_ -> fill ' '
, rowHdr = Just rowHdr
, colHdr = Just colHdr
, colHdrRowHdr = Just $ ColHdrRowHdr $ \_ _ -> vLimit 1 (fill ' ') <=> hBorder
}
theList :: LibraryList
theList = gridTabularList TheList songs (LstItmH 1) $ S.fromList $ fmap ColW [12, 11, 11, 14, 11, 7]
main :: IO ()
main = do
let appState = AppState {
libList = theList
, libRenderers = renderers
, listWidth = 39
}
app = App {
appDraw = drawUi
, appChooseCursor = neverShowCursor
, appHandleEvent = handleLibEvent
, appStartEvent = return ()
, appAttrMap = const $ attrMap defAttr [ (colSelectedAttr, black `on` white)
, (columnHdrAttr, fg blue)
, (rowHdrAttr, fg red)]
}
void $ defaultMain app appState