diff --git a/app/Main.hs b/app/Main.hs index e83b9a7..661bcd2 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -5,43 +5,15 @@ module Main where import Brick import Control.Monad import qualified Data.Text.IO as T -import qualified Graphics.Vty as Vty import Options.Applicative +import Profold.App import Profold.Options import Profold.ParseProfFile -import Profold.UiState data UiName = UiViewport deriving (Show, Eq, Ord) -myAppDraw :: UiState -> [Widget UiName] -myAppDraw s = [renderUiState UiViewport s] - -myHandleEvent :: UiState -> BrickEvent n e -> EventM n (Next UiState) -myHandleEvent s (VtyEvent (Vty.EvKey Vty.KEsc _)) = halt s -myHandleEvent s (VtyEvent (Vty.EvKey Vty.KUp _)) = continue $ moveFocusUp s -myHandleEvent s (VtyEvent (Vty.EvKey Vty.KDown _)) = continue $ moveFocusDown s -myHandleEvent s (VtyEvent (Vty.EvKey (Vty.KChar 'q') _)) = halt s -myHandleEvent s (VtyEvent (Vty.EvKey (Vty.KChar 'k') _)) = continue $ moveFocusUp s -myHandleEvent s (VtyEvent (Vty.EvKey (Vty.KChar 'j') _)) = continue $ moveFocusDown s -myHandleEvent s (VtyEvent (Vty.EvKey (Vty.KChar '\t') _)) = continue $ toggleFold s -myHandleEvent s _ = continue s - -myAttrMap :: AttrMap -myAttrMap = attrMap Vty.defAttr - [ ("focused", Vty.defAttr `Vty.withStyle` Vty.reverseVideo) - ] - -myApp :: App UiState () UiName -myApp = App - { appDraw = myAppDraw - , appChooseCursor = neverShowCursor - , appHandleEvent = myHandleEvent - , appStartEvent = pure - , appAttrMap = const myAttrMap - } - main :: IO () main = do opts <- execParser options diff --git a/src/Profold/App.hs b/src/Profold/App.hs new file mode 100644 index 0000000..ba77921 --- /dev/null +++ b/src/Profold/App.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Profold.App + ( UiState + , newUiState + , myApp + ) where + +import Brick +import Brick.Widgets.List +import qualified Data.Text as T +import qualified Data.Vector as V +import qualified Graphics.Vty as Vty + +import Profold.LineNode + +data UiName = UiList + deriving (Show, Eq, Ord) + +data UiState = UiState + { uiInfo :: [T.Text] + , uiTree :: LineNode + , uiList :: List UiName (Path, LineNode) + } deriving (Show) + +newUiState :: [T.Text] -> LineNode -> UiState +newUiState info ln = UiState info ln $ list UiList (flatten ln) 1 + +toggleFold :: UiState -> UiState +toggleFold s = case listSelectedElement (uiList s) of + Nothing -> s + Just (i, (path, _)) -> + let newTree = modify toggleIfHasChildren path $ uiTree s + newList = listReplace (flatten newTree) (Just i) (uiList s) + in s {uiTree = newTree, uiList = newList} + where + toggleIfHasChildren ln + | V.null $ lineChildren ln = ln + | otherwise = ln {lineFolded = not $ lineFolded ln} + +renderLine :: Bool -> (Path, LineNode) -> Widget UiName +renderLine focused (_, ln) + | focused = visible $ withDefAttr "focused" widget + | otherwise = widget + where + prefix + | V.null $ lineChildren ln = " " + | lineFolded ln = "+" + | otherwise = "-" + widget = padRight Max $ str prefix <+> txt (lineText ln) + +renderUiState :: UiState -> Widget UiName +renderUiState s = + let info = vBox $ map (\t -> str " " <+> txt t) $ uiInfo s + in info <=> renderList renderLine True (uiList s) + +{- The actual App -} + +myAppDraw :: UiState -> [Widget UiName] +myAppDraw s = [renderUiState s] + +myHandleEvent :: UiState -> BrickEvent UiName e -> EventM UiName (Next UiState) +myHandleEvent s (VtyEvent (Vty.EvKey Vty.KEsc _)) = halt s +myHandleEvent s (VtyEvent (Vty.EvKey (Vty.KChar 'q') _)) = halt s +myHandleEvent s (VtyEvent (Vty.EvKey (Vty.KChar '\t') _)) = continue $ toggleFold s +myHandleEvent s (VtyEvent e) = do + newList <- handleListEventVi handleListEvent e (uiList s) + continue s{uiList = newList} +myHandleEvent s _ = continue s + +myAttrMap :: AttrMap +myAttrMap = attrMap Vty.defAttr + [ ("focused", Vty.defAttr `Vty.withStyle` Vty.reverseVideo) + ] + +myApp :: App UiState () UiName +myApp = App + { appDraw = myAppDraw + , appChooseCursor = neverShowCursor + , appHandleEvent = myHandleEvent + , appStartEvent = pure + , appAttrMap = const myAttrMap + } diff --git a/src/Profold/UiState.hs b/src/Profold/UiState.hs deleted file mode 100644 index cc634d4..0000000 --- a/src/Profold/UiState.hs +++ /dev/null @@ -1,73 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Profold.UiState - ( UiState - , newUiState - -- * Modifying - , moveFocusUp - , moveFocusDown - , toggleFold - -- * Drawing - , renderUiState - ) where - -import Brick -import Data.Maybe -import qualified Data.Text as T -import qualified Data.Vector as V - -import Profold.LineNode -import Profold.Util - -data UiState = UiState - { uiInfo :: [T.Text] - , uiTree :: LineNode - , uiFocused :: Path - } deriving (Show) - -newUiState :: [T.Text] -> LineNode -> UiState -newUiState info ln = UiState info ln [] - -moveFocusUp :: UiState -> UiState -moveFocusUp s = - fromMaybe s $ do - prev <- - fst <$> findSurrounding (\a -> fst a == uiFocused s) $ - flatten $ uiTree s - pure s {uiFocused = fst prev} - -moveFocusDown :: UiState -> UiState -moveFocusDown s = - fromMaybe s $ do - prev <- - snd <$> findSurrounding (\a -> fst a == uiFocused s) $ - flatten $ uiTree s - pure s {uiFocused = fst prev} - -toggleFold :: UiState -> UiState -toggleFold s = - s {uiTree = modify toggleFoldIfHasChildren (uiFocused s) (uiTree s)} - where - toggleFoldIfHasChildren ln - | V.null $ lineChildren ln = ln - | otherwise = ln {lineFolded = not $ lineFolded ln} - -wrapFocused :: Bool -> Widget n -> Widget n -wrapFocused False = withDefAttr "unfocused" -wrapFocused True = visible . withDefAttr "focused" - -renderLine :: Bool -> LineNode -> Widget n -renderLine focused ln = - let prefix - | V.null $ lineChildren ln = " " - | lineFolded ln = "+" - | otherwise = "-" - in wrapFocused focused $ padRight Max $ str prefix <+> txt (lineText ln) - -renderUiState :: (Show n, Ord n) => n -> UiState -> Widget n -renderUiState n s = - let info = vBox $ map txt $ uiInfo s - flat = V.toList $ flatten $ uiTree s - focused = uiFocused s - rendered = map (\(p, ln) -> renderLine (p == focused) ln) flat - in info <=> viewport n Vertical (vBox rendered)