packages feed

clifm-0.3.1.0: src/Widgets/Menu.hs

module Widgets.Menu where
import Types
import Widgets.Pane
import Widgets.Tab

import Data.Char (toUpper)
import System.FilePath (takeFileName)
import Brick.Widgets.Core ((<+>), str, hLimit, hBox, clickable)
import Brick.Types (Widget)
import Brick.Widgets.Border (borderWithLabel, border)
import Graphics.Vty (Event(EvKey), Key(..), Modifier(MCtrl))

data Menu = Menu {clipboard :: Clipboard, menuType :: MenuType}
data MenuType = MainMenu | SelectionMenu | TabMenu | PaneMenu
data Clipboard = CopyBoard {fromEntry :: Entry} | CutBoard {fromEntry :: Entry} | EmptyBoard

instance Show Clipboard where
  show EmptyBoard = " -empty- "
  show board = takeFileName . entryPath $ fromEntry board

-- creation functions
makeMenu :: Menu
makeMenu = Menu {clipboard = EmptyBoard, menuType = MainMenu}

makeCopyBoard :: Entry -> Clipboard
makeCopyBoard = CopyBoard

makeCutBoard :: Entry -> Clipboard
makeCutBoard = CutBoard

-- rendering functions
renderMenu :: Menu -> Pane -> Widget Name
renderMenu m = hBox . (renderClipboard (clipboard m) :) . renderButtons (menuType m)

renderButtons :: MenuType -> Pane -> [Widget Name]
renderButtons tp pane = map renderButton $ case tp of
  MainMenu -> mainButtons
  SelectionMenu -> (backButton :) . selectionButtons . selectedEntry $ currentTab pane
  TabMenu -> (backButton :) . tabButtons $ currentTab pane
  PaneMenu -> backButton : paneButtons

renderButton :: (Widget Name, Maybe String, Name) -> Widget Name
renderButton (bContent, bLabel, bName) = clickable bName $ case bLabel of
  Just txt -> borderWithLabel (str txt) bContent
  Nothing -> border bContent

mainButtons :: [(Widget Name, Maybe String, Name)]
mainButtons = [
    (str "se" <+> keybindStr "l" <+> str "ection menu", Nothing, Button {keyBind = KChar 'l', withCtrl = False}),
    (str "t" <+> keybindStr "a" <+> str "b menu", Nothing, Button {keyBind = KChar 'a', withCtrl = False}),
    (keybindStr "p" <+> str "ane menu", Nothing, Button {keyBind = KChar 'p', withCtrl = False}),
    (keybindStr "q" <+> str "uit", Nothing, Button {keyBind = KChar 'q', withCtrl = False})
  ]

selectionButtons :: Maybe Entry -> [(Widget Name, Maybe String, Name)]
selectionButtons e = case e of
  Just FileEntry {} -> anySelectionButtons
  Just DirEntry {} -> anySelectionButtons ++ [(keybindStr "o" <+> str "pen in new tab", ctrlText 'o', Button {keyBind = KChar 'o', withCtrl = True})]
  _ -> []

anySelectionButtons :: [(Widget Name, Maybe String, Name)]
anySelectionButtons = [
    (str "cut", ctrlText 'x', Button {keyBind = KChar 'x', withCtrl = True}),
    (str "copy", ctrlText 'c', Button {keyBind = KChar 'c', withCtrl = True}),
    (keybindStr "r" <+> str "ename", ctrlText 'r', Button {keyBind = KChar 'r', withCtrl = True}),
    (keybindStr "d" <+> str "elete", ctrlText 'd', Button {keyBind = KChar 'd', withCtrl = True}),
    (keybindStr "s" <+> str "how info", Nothing, Button {keyBind = KChar 's', withCtrl = False})
  ]

tabButtons :: Tab -> [(Widget Name, Maybe String, Name)]
tabButtons tab = case tab of
  DirTab {entryOrder = order} -> dirTabButtons ++ entryTabButtons order ++ anyTabButtons
  SearchTab {entryOrder = order} -> entryTabButtons order ++ anyTabButtons
  _ -> anyTabButtons

dirTabButtons :: [(Widget Name, Maybe String, Name)]
dirTabButtons = [
    (str "paste", ctrlText 'v', Button {keyBind = KChar 'v', withCtrl = True}),
    (keybindStr "s" <+> str "earch", ctrlText 's', Button {keyBind = KChar 's', withCtrl = True}),
    (keybindStr "m" <+> str "ake dir", Nothing, Button {keyBind = KChar 'm', withCtrl = False}),
    (keybindStr "t" <+> str "ouch file", Nothing, Button {keyBind = KChar 't', withCtrl = False})
  ]

entryTabButtons :: EntryOrder -> [(Widget Name, Maybe String, Name)]
entryTabButtons order = [
    (keybindStr "r" <+> str "efresh", Nothing, Button {keyBind = KChar 'r', withCtrl = False}),
    (keybindStr "o" <+> str ("rder by " ++ (show . nextOrderType $ orderType order)), Nothing, Button {keyBind = KChar 'o', withCtrl = False}),
    (keybindStr "i" <+> str "nvert order", Nothing, Button {keyBind = KChar 'i', withCtrl = False})
  ]

anyTabButtons :: [(Widget Name, Maybe String, Name)]
anyTabButtons = [
    (keybindStr "g" <+> str "o to", Nothing, Button {keyBind = KChar 'g', withCtrl = False}),
    (keybindStr "e" <+> str "mpty tab", Nothing, Button {keyBind = KChar 'e', withCtrl = False}),
    (keybindStr "k" <+> str "ill tab", Nothing, Button {keyBind = KChar 'k', withCtrl = False})
  ]

paneButtons :: [(Widget Name, Maybe String, Name)]
paneButtons = [
    (keybindStr "e" <+> str "mpty pane", ctrlText 'e', Button {keyBind = KChar 'e', withCtrl = True}),
    (keybindStr "k" <+> str "ill pane", ctrlText 'k', Button {keyBind = KChar 'k', withCtrl = True})
  ]

ctrlText :: Char -> Maybe String
ctrlText c = Just $ "C-" ++ [toUpper c]

backButton :: (Widget Name, Maybe String, Name)
backButton = (str "<_", Nothing, Button {keyBind = KBS, withCtrl = False})

renderClipboard :: Clipboard -> Widget Name
renderClipboard = hLimit 24 . borderWithLabel (str "clipboard") . str . show

-- state changing functions
changeMenu :: MenuType -> Menu -> Menu
changeMenu tp menu = menu {menuType = tp}

changeClipboard :: Clipboard -> Menu -> Menu
changeClipboard cb menu = menu {clipboard = cb}