clifm-0.5.2.1: src/Widgets/Menu.hs
module Widgets.Menu where
import Commons
import qualified Widgets.Pane as Pane
import qualified Widgets.Tab as Tab
import qualified Widgets.Entry as Entry
import Control.Lens
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 = Main | Selection | Tab | Pane
data Clipboard = CopyBoard {_fromEntry :: Entry.Entry} | CutBoard {_fromEntry :: Entry.Entry} | EmptyBoard
instance Show Clipboard where
show EmptyBoard = " -empty- "
show board = takeFileName $ board ^. fromEntry . Entry.path
-- lenses
clipboard :: Lens' Menu Clipboard
clipboard = lens _clipboard (\menu x -> menu {_clipboard = x})
menuType :: Lens' Menu MenuType
menuType = lens _menuType (\menu x -> menu {_menuType = x})
fromEntry :: Traversal' Clipboard Entry.Entry
fromEntry = filtered (not . isEmpty) . lens _fromEntry (\board x -> board {_fromEntry = x})
-- creation
make :: Menu
make = Menu {_clipboard = EmptyBoard, _menuType = Main}
-- rendering
render :: Menu -> Pane.Pane -> Widget Name
render m = hBox . (views clipboard renderClipboard m :) . views menuType renderButtons m
renderButtons :: MenuType -> Pane.Pane -> [Widget Name]
renderButtons tp pane = map renderButton $ case tp of
Main -> mainButtons
Selection -> backButton : maybe [] selectionButtons (Pane.selectedEntry pane)
Tab -> backButton : views Pane.currentTab tabButtons pane
Pane -> 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 :: Entry.Entry -> [(Widget Name, Maybe String, Name)]
selectionButtons e
| Entry.isDir e = anySelectionButtons ++ [(keybindStr "o" <+> str "pen in new tab", ctrlText 'o', Button {keyBind = KChar 'o', withCtrl = True})]
| otherwise = anySelectionButtons
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.Tab -> [(Widget Name, Maybe String, Name)]
tabButtons tab
| Tab.isDir tab = dirTabButtons ++ entryTabButtons orderType ++ anyTabButtons
| Tab.isSearch tab = entryTabButtons orderType ++ anyTabButtons
| otherwise = anyTabButtons
where (Just orderType) = preview Tab.orderType tab
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 :: Tab.OrderType -> [(Widget Name, Maybe String, Name)]
entryTabButtons orderType = [
(keybindStr "r" <+> str "efresh", Nothing, Button {keyBind = KChar 'r', withCtrl = False}),
(keybindStr "o" <+> str ("rder by " ++ show (Tab.nextOrderType orderType)), 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
-- utility
isEmpty :: Clipboard -> Bool
isEmpty EmptyBoard = True
isEmpty _ = False
isCopy :: Clipboard -> Bool
isCopy CopyBoard {} = True
isCopy _ = False
isCut :: Clipboard -> Bool
isCut CutBoard {} = True
isCut _ = False