{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE FlexibleContexts #-} module Internal.GridTabularList ( runMain , theList ) where import Brick.Widgets.TabularList.Grid hiding (sizes, contents) -- 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 -- 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 SongCell = StringCell String | TimeCell Int deriving Generic data Name = TheList deriving (Eq, Ord, Show) type LibraryList = GridTabularList Name Song SongCell Int String type LibraryRenderers = GridRenderers Name Song SongCell Int String type LibraryContents = GridContents Name Song SongCell Int String type LibraryEventHandler = LibraryRenderers -> Event -> EventM Name LibraryList () songs :: Seq Song songs = S.fromList $ map (\n -> Song ("Artist " <> show n) ("Title " <> show n) ("Album " <> show n) ("Composer " <> show n) ("Genre " <> show n) n) [1..1000] sizes :: GridSizes Int sizes = GridSizes { row = S.fromList [12, 11, 11, 14, 11, 7] , rowHdr = Just $ VisibleRowHeaders $ \_ rowHs -> (+2) $ maximum $ map (length . show) rowHs , colHdr = Just 1 } contents :: LibraryContents contents = let getCell s 0 = Just $ StringCell $ s ^. #artist getCell s 1 = Just $ StringCell $ s ^. #title getCell s 2 = Just $ StringCell $ s ^. #album getCell s 3 = Just $ StringCell $ s ^. #composer getCell s 4 = Just $ StringCell $ s ^. #genre getCell s 5 = Just $ TimeCell $ s ^. #time getCell _ _ = Nothing getColumnHeader 0 = Just "Artist" getColumnHeader 1 = Just "Title" getColumnHeader 2 = Just "Album" getColumnHeader 3 = Just "Composer" getColumnHeader 4 = Just "Genre" getColumnHeader 5 = Just "Time" getColumnHeader _ = Nothing getRowHeader _ n = Just (n+1) in GridContents { cell = getCell , rowHdr = Just getRowHeader , colHdr = Just getColumnHeader } data AppState = AppState { libList :: LibraryList , libRenderers :: LibraryRenderers , listWidth :: Int } deriving Generic handleLibEvent :: LibraryEventHandler -> BrickEvent Name () -> EventM Name AppState () handleLibEvent eh e = do s <- get case e of VtyEvent (EvKey KEsc []) -> halt VtyEvent (EvKey (KChar 'q') []) -> halt VtyEvent (EvKey (KChar 'c') []) -> zoom (#libRenderers . #drawColHdr) $ modify $ \case Nothing -> Just dch Just _ -> Nothing VtyEvent (EvKey (KChar 'r') []) -> zoom (#libRenderers . #drawRowHdr) $ modify $ \case Nothing -> Just drh Just _ -> Nothing VtyEvent (EvKey (KChar '-') []) -> zoom #listWidth $ modify $ max 1 . subtract 1 VtyEvent (EvKey (KChar '=') []) -> zoom #listWidth $ modify (+1) VtyEvent e -> zoom #libList $ eh (s ^. #libRenderers) e _ -> return () drawUi :: [String] -> AppState -> [Widget Name] drawUi msgs s = let theList = renderGridTabularList (s ^. #libRenderers) True (s ^. #libList) in [vCenter $ vBox $ hCenter (padLeftRight 2 $ 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" getApp :: [String] -> LibraryEventHandler -> App AppState () Name getApp msgs eh = App { appDraw = drawUi msgs , appChooseCursor = neverShowCursor , appHandleEvent = handleLibEvent eh , appStartEvent = return () , appAttrMap = const $ attrMap defAttr [ (colSelectedAttr, black `on` white) , (columnHdrAttr, fg blue) , (rowHdrAttr, fg red)] } drh lf wd (Position i f) row = \case Nothing -> fill ' ' Just rh -> let attrFn = if f then id else withAttr rowHdrAttr in attrFn $ padRight (Pad $ if wd > 0 then 0 else 1) $ padLeft Max (str $ show rh) dch lf wd (Position i f) = \case Nothing -> fill ' ' Just ch -> withAttr columnHdrAttr $ padRight (Pad $ if wd > 0 then 0 else 1) $ padRight Max (str ch) renderers :: LibraryRenderers renderers = GridRenderers { drawCell = \lf wd gc song mc -> let attrFn = if gc ^. #row % #selected && gc ^. #col % #selected then withAttr colSelectedAttr else id in attrFn $ case mc of Nothing -> fill ' ' Just (StringCell s) -> padRight (Pad $ if wd > 0 then 0 else 1) $ padRight Max (str s) Just (TimeCell time) -> let (min, sec) = time `divMod` 60 time' = case min of 0 -> show sec _ -> show min <> ":" <> show sec in padRight (Pad $ if wd > 0 then 0 else 1) $ padRight Max $ str time' , drawRowHdr = Just drh , drawColHdr = Just dch -- This is the same as Nothing. , drawColHdrRowHdr = Just $ \_ _ -> fill ' ' } theList :: LibraryList theList = gridTabularList TheList songs 1 sizes contents runMain :: [String] -> LibraryEventHandler -> IO () runMain msgs eh = do let appState = AppState { libList = theList , libRenderers = renderers , listWidth = 39 } void $ defaultMain (getApp msgs eh) appState