MixedTabularList.hs

{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLabels #-}
module Internal.MixedTabularList (
  runMain
)
where

import Brick.Widgets.TabularList.Mixed 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
, time :: Int
} deriving Generic

data LibraryEntry = LibFolder String | LibSong Song deriving Generic

data LibCell = StringCell String | FolderCell String | TimeCell Int deriving Generic

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

type LibraryList = MixedTabularList Name LibraryEntry LibCell Int String
type LibraryRenderers = MixedRenderers Name LibraryEntry LibCell Int String
type LibraryContents = MixedContents LibraryEntry LibCell Int String
type LibraryEventHandler = Event -> EventM Name LibraryList ()

libraryEntries :: Seq LibraryEntry
libraryEntries = let
  folders = [LibFolder "[.]", LibFolder "[..]"]
  songs = map (\n -> LibSong (Song ("Artist " <> show n) ("Title " <> show n) ("Album " <> show n) n)) [1..1000]
  in S.fromList $ folders ++ songs

contents :: LibraryContents
contents = let
  getCell (LibFolder s) 0 = Just $ FolderCell $ "Folder: " <> s
  getCell (LibFolder _) _ = Nothing
  getCell (LibSong s) 0 = Just $ StringCell $ s ^. #artist
  getCell (LibSong s) 1 = Just $ StringCell $ s ^. #title
  getCell (LibSong s) 2 = Just $ StringCell $ s ^. #album
  getCell (LibSong s) 3 = Just $ TimeCell $ s ^. #time
  getCell (LibSong _) _ = Nothing
  getColumnHeader 0 = Just "Artist"
  getColumnHeader 1 = Just "Title"
  getColumnHeader 2 = Just "Album"
  getColumnHeader 3 = Just "Time"
  getColumnHeader _ = Nothing
  getRowHeader _ n = Just (n+1)
  in MixedContents {
    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 = 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 e
  _ -> return ()
  where abc = []

drawUi :: [String] -> AppState -> [Widget Name]
drawUi msgs s = let
  theList = renderMixedTabularList (s ^. #libRenderers) True (s ^. #libList)
  in [vCenter $ vBox $ hCenter (border $ vLimit 15 $ hLimit (s ^. #listWidth) 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"

getApp :: [String] -> LibraryEventHandler -> App AppState () Name
getApp msgs eh = App {
  appDraw = drawUi msgs
, appChooseCursor = neverShowCursor
, appHandleEvent = handleLibEvent eh
, appStartEvent = return ()
, appAttrMap = const $ attrMap defAttr [ (listSelectedAttr, black `on` white)
                                       , (columnHdrAttr, fg blue)
                                       , (rowHdrAttr, fg red)]
}

dch lf ci = \case
  Nothing -> hCenter $ str " "
  Just ch -> withAttr columnHdrAttr $ padRight Max (str ch) <+> str " "

drh lf wd (Position i f) row = \case
  Nothing -> hCenter $ str " "
  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)

renderers :: LibraryRenderers
renderers = MixedRenderers {
  drawCell = \lf (Position i f) row mc -> case mc of
    Nothing -> hCenter $ str " "
    Just (StringCell s) -> padRight Max (str s) <+> str " "
    Just (FolderCell s) -> 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 Max (str time') <+> str " "
, drawRowHdr = Just drh
, drawColHdr = Just dch
-- This is the same as Nothing.
, drawColHdrRowHdr = Just $ \_ _ -> fill ' '
}

runMain :: [String] -> LibraryEventHandler -> IO ()
runMain msgs eh = do
  let sizes = MixedSizes {
        rowHdr = Just $ VisibleRowHeaders $ \_ rowHs -> (+2) $ maximum $ map (length . show) rowHs
      , colSizes = AvailWidth $ \aW -> let
          artist = max 7 $ (aW * 30) `div` 100
          title = max 6 $ (aW * 30) `div` 100
          time = 7
          album = aW - artist - title - time
          songWidths = [artist, title, album, time]
          in ColSizes {
            rowKind = \case
              LibFolder _ -> [aW]
              LibSong _ -> songWidths
          , colHdr = Just (songWidths, 1)
          }
      }
      appState = AppState {
        libList = mixedTabularList TheList libraryEntries 1 sizes contents
      , libRenderers = renderers
      , listWidth = 80
      }
  void $ defaultMain (getApp msgs eh) appState