{-# 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
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 :: [ColWidth]
, folder :: [ColWidth]
} 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) (LstFcs 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 -> MixedCtxt -> LibraryEntry -> Widget n
dc _ (MxdCtxt _ (MColC (Ix 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"]
wprk :: WidthsPerRowKind LibraryEntry Widths
wprk = WsPerRK $ \(AvlW 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 = fmap ColW [artist, title, album, time], folder = [ColW aW] }
wpr :: WidthsPerRow LibraryEntry Widths
wpr = WsPerR $ \(Widths {song, folder}) e -> case e of
LibSong _ -> song
LibFolder _ -> folder
rowHdr :: RowHdr Name LibraryEntry Int
rowHdr = RowHdr {
draw = \_ (WdthD wd) (RowHdrCtxt (Sel s)) rh -> let
attrFn = if s
then id
else withAttr rowHdrAttr
in attrFn $ padRight (Pad $ if wd > 0 then 0 else 1) $ padLeft Max (str $ show rh)
, width = \_ rh -> RowHdrW $ (+2) $ maximum $ map (length . show) rh
, toRH = \_ (Ix i) -> i + 1
}
colHdr :: MixedColHdr Name Widths
colHdr = MixedColHdr {
draw = \_ (MColC (Ix ci)) -> case colHdrs V.!? ci of
Just ch -> withAttr columnHdrAttr (padRight Max (str ch) <+> str " ") <=> hBorder
Nothing -> emptyWidget
, widths = \Widths {song} -> song
, height = ColHdrH 2
}
main :: IO ()
main = do
let appState = AppState {
libList = mixedTabularList TheList libraryEntries (LstItmH 1) wprk wpr
, libRenderers = MixedRenderers {
cell = dc
, rowHdr = Just rowHdr
, colHdr = Just colHdr
, colHdrRowHdr = Just $ CHRH $ \_ _ -> 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