packages feed

clifm-0.5.2.1: src/Widgets/Pane.hs

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

import Control.Lens
import Data.Maybe (fromMaybe)
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, 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

-- lenses 
name :: Lens' Pane PaneName
name = lens _name (\pane x -> pane {_name = x})

tabZipper :: Lens' Pane TabZipper
tabZipper = lens _tabZipper (\pane x -> pane {_tabZipper = x})

currentTab :: Lens' Pane Tab.Tab
currentTab = tabZipper.focus

entries :: Traversal' Pane Entry.Entry
entries = tabZipper.traverse.Tab.entries

-- creation
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
render :: (Pane, Bool) -> Widget Name
render (pane, hasFocus) = let pName = view name pane in vBox [
    vLimit 2 . viewport LabelsRow {pnName = pName} Horizontal $ views tabZipper (renderLabels pName) pane,
    views currentTab Tab.renderSeparator pane,
    clickable EntryList {pnName = pName} $ views currentTab (Tab.renderContent hasFocus) 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
handleEvent :: Event -> Pane -> EventM Name Pane
handleEvent event = case event of
  EvKey (KChar 'k') [] -> return . over tabZipper removeTab
  EvKey (KChar 'e') [] -> return . over tabZipper (insert Tab.empty)
  EvKey (KChar 'r') [] -> reloadCurrentTab
  EvKey (KChar '\t') [] -> return . over tabZipper next
  EvKey KBackTab [] -> return . over tabZipper previous
  EvKey KLeft [MCtrl] -> return . over tabZipper swapPrev
  EvKey KRight [MCtrl] -> return . over tabZipper swapNext
  _ -> currentTab (Tab.handleEvent event)

-- state-changing
reloadCurrentTab :: Pane -> EventM Name Pane
reloadCurrentTab pane = currentTab (liftIO . Tab.reload (view name pane)) pane

openDirEntry :: Bool -> Pane -> EventM Name Pane
openDirEntry inNew pane = case selectedEntry pane of
  Just entry -> if not $ Entry.isDir entry then return pane else do
    loaded <- liftIO $ Tab.makeDirTab (view name pane) $ view Entry.path entry
    return $ over tabZipper (if inNew then previous . insert loaded else replace loaded) pane
  _ -> return pane

moveToNth :: Int -> Pane -> Pane
moveToNth n = over tabZipper (\z -> fromMaybe z $ moveTo n z)

-- utility
selectedEntry :: Pane -> Maybe Entry.Entry
selectedEntry = Tab.selectedEntry . view currentTab

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

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