GridTabularList.hs

{-# 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 -> hCenter $ str " "
  Just rh ->
    let attrFn = if f
          then id
          else withAttr rowHdrAttr
        rp = if wd > 0 then 0 else 1
    in attrFn $ padRight (Pad rp) $ padLeft Max (str $ show rh)

dch lf wd (Position i f) = \case
  Nothing -> hCenter $ str " "
  Just ch -> let rp = if wd > 0 then 0 else 1 in
    withAttr columnHdrAttr $ padRight (Pad rp) $ 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 -> hCenter $ str " "
      Just (StringCell s) -> let rp = if wd > 0 then 0 else 1 in
        padRight (Pad rp) $ padRight Max (str s)
      Just (TimeCell time) -> let
        (min, sec) = time `divMod` 60
        time' = case min of
          0 -> show sec
          _ -> show min <> ":" <> show sec
        rp = if wd > 0 then 0 else 1
        in padRight (Pad rp) $ padRight Max $ str time'
, drawRowHdr = Just drh
, drawColHdr = Just dch
}

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