{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoFieldSelectors #-}
module Main where
import Brick.Widgets.TabularList.Mixed
-- 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 Data.Vector (Vector)
import qualified Data.Vector as V
-- 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 Name = TheList deriving (Eq, Ord, Show)
data Widths = Widths {
song :: [Width]
, folder :: [Width]
} deriving Generic
data AppState = AppState {
libList :: LibraryList
, libRenderers :: LibraryRenderers
, listWidth :: Int
} deriving Generic
type LibraryList = MixedTabularList Name LibraryEntry Widths
type LibraryRenderers = MixedRenderers Name LibraryEntry Widths Int
libraryEntries :: Seq LibraryEntry
libraryEntries = let
folders = [LibFolder "[.]", LibFolder "[..]"]
songs = map (\n -> LibSong $ Song {
artist = "Artist " <> show n
, title = "Title " <> show n
, album = "Album " <> show n
, time = n
})
[1..998]
in S.fromList $ folders ++ songs
handleLibEvent :: BrickEvent Name () -> EventM Name AppState ()
handleLibEvent e = 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
handleMixedListEvent e
handleMixedListEventVi e
_ -> return ()
drawUi :: AppState -> [Widget Name]
drawUi s = let
theList = renderMixedTabularList (s ^. #libRenderers) True (s ^. #libList)
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+b to go up one page"
, "Press PageDown or Ctrl+f 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" ]
in [vCenter $ vBox $ hCenter (joinBorders $ 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"
dc :: ListFocused -> MixedContext -> LibraryEntry -> Widget n
dc lf (MixedContext (FlatContext _ f) ci) e = let
renderPlainCell s = padRight Max (str s) <+> str " "
in case e of
LibFolder f -> case ci of
0 -> padRight Max $ str $ "Folder: " <> f
_ -> emptyWidget
LibSong (Song {artist, title, album, time}) -> case ci of
0 -> renderPlainCell artist
1 -> renderPlainCell title
2 -> renderPlainCell album
3 -> renderPlainCell $ let
(min, sec) = time `divMod` 60
in case min of
0 -> show sec
_ -> show min <> ":" <> show sec
_ -> emptyWidget
colHdrs :: Vector String
colHdrs = V.fromList ["Artist", "Title", "Album", "Time"]
cWprk :: AvailWidth -> [LibraryEntry] -> Widths
cWprk aW _ = let
artist = max 7 $ (aW * 30) `div` 100
title = max 6 $ (aW * 30) `div` 100
time = 7
album = aW - artist - title - time
in Widths { song = [artist, title, album, time], folder = [aW] }
wpr :: Widths -> LibraryEntry -> [Width]
wpr (Widths {song, folder}) = \case
LibSong _ -> song
LibFolder _ -> folder
rowHdr :: RowHdr Name LibraryEntry Int
rowHdr = RowHdr {
draw = \lf wd f 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)
, width = \_ rh -> (+2) $ maximum $ map (length . show) rh
, toRowHdr = \_ i -> i+1
}
colHdr :: MixedColHdr Name Widths
colHdr = MixedColHdr {
draw = \_ ci -> case colHdrs V.!? ci of
Just ch -> withAttr columnHdrAttr (padRight Max (str ch) <+> str " ") <=> hBorder
Nothing -> emptyWidget
, widths = \Widths {song} -> song
, height = 2
}
main :: IO ()
main = do
let appState = AppState {
libList = mixedTabularList TheList libraryEntries 1 cWprk wpr
, libRenderers = MixedRenderers {
drawCell = dc
, rowHdr = Just rowHdr
, colHdr = Just colHdr
, drawColHdrRowHdr = Just $ \_ _ -> vLimit 1 (fill ' ') <=> hBorder
}
, listWidth = 80
}
app = App {
appDraw = drawUi
, appChooseCursor = neverShowCursor
, appHandleEvent = handleLibEvent
, appStartEvent = return ()
, appAttrMap = const $ attrMap defAttr [ (listSelectedAttr, black `on` white)
, (columnHdrAttr, fg blue)
, (rowHdrAttr, fg red)]
}
void $ defaultMain app appState