packages feed

clifm-0.4.1.0: src/Widgets/Pane.hs

module Widgets.Pane where
import Commons
import qualified Widgets.Tab as Tab
import qualified Widgets.Entry as Entry

import Control.Monad.IO.Class (liftIO)
import Brick.Widgets.Core (hBox, vBox, vLimit, viewport, clickable)
import Brick.Types (Widget, BrickEvent(..), EventM, ViewportType(..))
import Graphics.Vty (Event(EvKey), Key(..), Modifier(MCtrl))
import Data.Foldable (toList)
import Data.List.PointedList (PointedList, _focus, replace, delete, singleton, insert, insertLeft, moveTo, withFocus, atStart, atEnd)
import Data.List.PointedList.Circular (next, previous)

data Pane = Pane {name :: PaneName, tabZipper :: TabZipper}
type TabZipper = PointedList Tab.Tab

instance Eq Pane where
  Pane {name = p1} == Pane {name = p2} = p1 == p2

-- creation functions
empty :: PaneName -> Pane
empty pName = Pane pName . singleton $ Tab.empty

make :: PaneName -> FilePath -> IO Pane
make pName path = Pane pName . singleton <$> Tab.makeDirTab pName path

-- rendering functions
render :: (Pane, Bool) -> Widget Name
render (pane, hasFocus) = let pName = name pane in vBox [
    vLimit 2 . viewport LabelsRow {pnName = pName} Horizontal . renderLabels pName $ tabZipper pane,
    Tab.renderSeparator $ currentTab pane,
    clickable EntryList {pnName = pName} . Tab.renderContent hasFocus $ currentTab pane
  ]

renderLabels :: PaneName -> TabZipper -> Widget Name
renderLabels pName zipper = hBox . map (clickableLabel pName) $ zip labels [0..]
  where labels = map Tab.renderLabel . toList $ withFocus zipper

clickableLabel :: PaneName -> (Widget Name, Int) -> Widget Name
clickableLabel pName (l, n) = clickable Label {pnName = pName, labelNum = n} l

-- event handling functions
handleEvent :: Event -> Pane -> EventM Name Pane
handleEvent event = case event of
  EvKey (KChar 'k') [] -> updateTabZipper removeTab
  EvKey (KChar 'e') [] -> updateTabZipper (insert Tab.empty)
  EvKey (KChar 'r') [] -> reloadCurrentTab
  EvKey (KChar '\t') [] -> updateTabZipper next
  EvKey KBackTab [] -> updateTabZipper previous
  EvKey KLeft [MCtrl] -> updateTabZipper swapPrev
  EvKey KRight [MCtrl] -> updateTabZipper swapNext
  _ -> updateCurrentTab event

-- state-changing functions
updateTabZipper :: (TabZipper -> TabZipper) -> Pane -> EventM Name Pane
updateTabZipper func pane = return $ pane {tabZipper = func $ tabZipper pane}

reloadCurrentTab :: Pane -> EventM Name Pane
reloadCurrentTab pane = do
  reloaded <- liftIO . Tab.reload (name pane) $ currentTab pane
  updateTabZipper (replace reloaded) pane

updateCurrentTab :: Event -> Pane -> EventM Name Pane
updateCurrentTab event pane = do
  updated <- Tab.handleEvent event $ currentTab pane
  updateTabZipper (replace updated) pane

openDirEntry :: Bool -> Pane -> EventM Name Pane
openDirEntry inNew pane = case selectedEntry pane of
  Just Entry.Dir {Entry.path = path} -> do
    loaded <- liftIO $ Tab.makeDirTab (name pane) path
    updateTabZipper (if inNew then previous . insert loaded else replace loaded) pane
  _ -> return pane

replaceCurrentTab :: Tab.Tab -> Pane -> EventM Name Pane
replaceCurrentTab tab = updateTabZipper (replace tab)

moveToNthTab :: Int -> Pane -> EventM Name Pane
moveToNthTab n = updateTabZipper (moveToNth n)

-- tab and tabZipper utility functions
selectedEntry :: Pane -> Maybe Entry.Entry
selectedEntry = Tab.selectedEntry . currentTab

moveTabToRow :: Int -> Pane -> EventM Name Pane
moveTabToRow row pane = updateTabZipper (replace (Tab.moveToRow row $ currentTab pane)) pane

currentTab :: Pane -> Tab.Tab
currentTab = _focus . tabZipper

removeTab :: TabZipper -> TabZipper
removeTab zipper = case delete zipper of
  Just newZipper -> newZipper
  _ -> singleton Tab.empty

moveToNth :: Int -> TabZipper -> TabZipper
moveToNth n zipper = case moveTo n zipper of
  Just newZipper -> newZipper
  _ -> zipper

swapPrev :: TabZipper -> TabZipper
swapPrev zipper
  | atStart zipper && atEnd zipper = zipper
  | atStart zipper = insert (_focus zipper) . previous $ removeTab zipper
  | atEnd zipper = insertLeft (_focus zipper) $ removeTab zipper
  | otherwise = insertLeft (_focus zipper) . previous $ removeTab zipper

swapNext :: TabZipper -> TabZipper
swapNext zipper
  | atStart zipper && atEnd zipper = zipper
  | atEnd zipper = insertLeft (_focus zipper) . next $ removeTab zipper
  | otherwise = insert (_focus zipper) $ removeTab zipper