packages feed

clifm-0.3.1.0: src/Widgets/Pane.hs

module Widgets.Pane where
import Types
import Widgets.Tab

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 {paneName :: PaneName, tabZipper :: TabZipper}
type TabZipper = PointedList Tab

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

-- creation functions
makePane :: PaneName -> FilePath -> IO Pane
makePane pName path = Pane pName . singleton <$> makeDirTab pName path

makeEmptyPane :: PaneName -> Pane
makeEmptyPane pName = Pane pName . singleton $ makeEmptyTab

-- rendering functions
renderPane :: (Pane, Bool) -> Widget Name
renderPane (pane, hasFocus) = vBox [labels, topSep, content]
  where
    pName = paneName pane
    labels = vLimit 2 . viewport LabelsRow {pnName = pName} Horizontal . renderLabels pName $ tabZipper pane
    topSep = renderPathSeparator $ currentTab pane
    content = clickable EntryList {pnName = pName} . renderContent hasFocus $ currentTab pane

renderLabels :: PaneName -> TabZipper -> Widget Name
renderLabels pName zipper = hBox . map (clickableLabel pName) $ zip labels [0..]
  where labels = map 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
handlePaneEvent :: Event -> Pane -> EventM Name Pane
handlePaneEvent event = case event of
  EvKey (KChar 'k') [] -> updateTabZipper removeTab
  EvKey (KChar 'e') [] -> updateTabZipper (insert makeEmptyTab)
  EvKey (KChar 'r') [] -> reloadCurrentTab
  EvKey (KChar '\t') [] -> updateTabZipper next
  EvKey KBackTab [] -> updateTabZipper previous
  EvKey KLeft [MCtrl] -> updateTabZipper swapWithPrevious
  EvKey KRight [MCtrl] -> updateTabZipper swapWithNext
  _ -> 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 . reload (paneName pane) $ currentTab pane
  updateTabZipper (replace reloaded) pane

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

openSelectedDir :: Bool -> Pane -> EventM Name Pane
openSelectedDir inNew pane = case selectedEntry $ currentTab pane of
  Just DirEntry {entryPath = path} -> do
    loaded <- liftIO $ makeDirTab (paneName pane) path
    let modify = if inNew then insertFixed else replace
    updateTabZipper (modify loaded) pane
  _ -> return pane

-- tab and tabZipper utility functions
moveTabToRow :: Int -> Pane -> EventM Name Pane
moveTabToRow row pane = updateTabZipper (replace (moveToRow row $ currentTab pane)) pane

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

removeTab :: TabZipper -> TabZipper
removeTab zipper = case delete zipper of
  Just newZipper -> newZipper
  _ -> singleton makeEmptyTab

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

insertFixed :: Tab -> TabZipper -> TabZipper
insertFixed tab = previous . insert tab

swapWithPrevious :: TabZipper -> TabZipper
swapWithPrevious 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

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