Begin UI restructure
This commit is contained in:
Joscha
parent
5de27b195b
commit
d8e0e1a867
5 changed files with 112 additions and 31 deletions
|
|
@ -2,14 +2,12 @@ module Main where
|
|||
|
||||
import Control.Monad
|
||||
|
||||
import qualified Brick as B
|
||||
import qualified Brick as B
|
||||
|
||||
import TaskMachine.Options
|
||||
import TaskMachine.UI
|
||||
import TaskMachine.UI.TaskList
|
||||
|
||||
main :: IO()
|
||||
main = do
|
||||
o <- parseOptions
|
||||
state <- loadTasks (startUIState o)
|
||||
void $ B.defaultMain myApp state
|
||||
void $ B.defaultMain myApp (startUIState o)
|
||||
|
|
|
|||
|
|
@ -14,6 +14,7 @@ module TaskMachine.LTask
|
|||
, toTask
|
||||
, fromTasks
|
||||
, toTasks
|
||||
, modifyLTask
|
||||
, sortLTasks
|
||||
, loadLTasks
|
||||
, saveLTasks
|
||||
|
|
@ -47,6 +48,9 @@ fromTasks = zipWith LTask (map Old [1..])
|
|||
toTasks :: [LTask] -> [Task]
|
||||
toTasks = map toTask . sortLTasks
|
||||
|
||||
modifyLTask :: (Task -> Task) -> LTask -> LTask
|
||||
modifyLTask f (LTask pos task) = LTask pos (f task)
|
||||
|
||||
sortLTasks :: [LTask] -> [LTask]
|
||||
sortLTasks = sortBy (compare `on` lPosition)
|
||||
|
||||
|
|
|
|||
|
|
@ -16,13 +16,41 @@ import TaskMachine.UI.TaskList
|
|||
import TaskMachine.UI.TopBar
|
||||
import TaskMachine.UI.Types
|
||||
|
||||
{- Rendering -}
|
||||
|
||||
drawBaseLayer :: UIState -> B.Widget RName
|
||||
drawBaseLayer s = B.vBox [placeholderTopBar, renderTaskList s, placeholderNewTask]
|
||||
drawBaseLayer s = B.vBox [placeholderTopBar, renderTaskList True (tasks s), placeholderNewTask]
|
||||
|
||||
drawUIState :: UIState -> [B.Widget RName]
|
||||
drawUIState s@UIState{errorPopup=Just p} = [renderPopupOk p, drawBaseLayer s]
|
||||
drawUIState s = [drawBaseLayer s]
|
||||
|
||||
{- Updating the state -}
|
||||
|
||||
rootBehavior :: UIState -> VTY.Event -> NewState
|
||||
rootBehavior s _ = B.continue s
|
||||
|
||||
closeBehavior :: (UIState -> VTY.Event -> NewState) -> UIState -> VTY.Event -> NewState
|
||||
closeBehavior _ s (VTY.EvKey VTY.KEsc []) = B.halt s
|
||||
closeBehavior _ s (VTY.EvKey (VTY.KChar 'q') []) = B.halt s
|
||||
closeBehavior f s e = f s e -- wrapper around another behavior
|
||||
|
||||
{-
|
||||
focusBehavior :: (UIState -> VTY.Event -> Result) -> UIState -> VTY.Event -> Result
|
||||
focusBehavior _ s (VTY.EvKey (VTY.KChar '\t') []) = B.continue $ bigFocusNext s
|
||||
focusBehavior _ s (VTY.EvKey VTY.KBackTab []) = B.continue $ bigFocusPrev s
|
||||
focusBehavior f s e = f s e -- wrapper around another behavior
|
||||
-}
|
||||
|
||||
selectBehavior :: UIState -> VTY.Event -> NewState
|
||||
selectBehavior s@UIState{errorPopup=Just popup} e = undefined popup s e
|
||||
selectBehavior s e = closeBehavior rootBehavior s e
|
||||
|
||||
updateUIState :: UIState -> B.BrickEvent RName () -> NewState
|
||||
updateUIState s (B.VtyEvent e) = selectBehavior s e
|
||||
updateUIState s _ = B.continue s
|
||||
|
||||
{-
|
||||
updateUIState :: UIState -> B.BrickEvent RName () -> B.EventM RName (B.Next UIState)
|
||||
-- Closing error popup
|
||||
updateUIState s@UIState{errorPopup=Just _} (B.VtyEvent (VTY.EvKey VTY.KEnter [])) = B.continue s{errorPopup=Nothing}
|
||||
|
|
@ -43,6 +71,7 @@ placeholderUpdate s (B.VtyEvent (VTY.EvKey VTY.KEsc [])) = B.halt s
|
|||
placeholderUpdate s (B.VtyEvent (VTY.EvKey (VTY.KChar '\t') [])) = B.continue $ bigFocusNext s
|
||||
placeholderUpdate s (B.VtyEvent (VTY.EvKey VTY.KBackTab [])) = B.continue $ bigFocusPrev s
|
||||
placeholderUpdate s _ = B.continue s
|
||||
-}
|
||||
|
||||
{- Starting the app -}
|
||||
|
||||
|
|
@ -60,6 +89,5 @@ startUIState o = UIState
|
|||
{ options = o
|
||||
, focus = B.focusRing [BRTaskList, BRNewTask, BRTopBar]
|
||||
, errorPopup = Nothing
|
||||
, taskList = newTaskList V.empty
|
||||
, invisibleTasks = V.empty
|
||||
, tasks = taskList RTaskList V.empty
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,25 +1,67 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module TaskMachine.UI.TaskList where
|
||||
module TaskMachine.UI.TaskList
|
||||
( TaskList
|
||||
, taskList
|
||||
, renderTaskList
|
||||
, taskListElements
|
||||
, taskListFilter
|
||||
, taskListSelectedElement
|
||||
, taskListModify
|
||||
) where
|
||||
|
||||
--import Data.Void
|
||||
|
||||
import qualified Brick as B
|
||||
import qualified Brick.Widgets.List as B
|
||||
import qualified Data.Vector as V
|
||||
import qualified Brick.Focus as B
|
||||
import qualified Brick.Widgets.Edit as B
|
||||
import qualified Brick as B
|
||||
import qualified Brick.Widgets.List as B
|
||||
import qualified Data.Vector as V
|
||||
--import qualified Brick.Focus as B
|
||||
--import qualified Brick.Widgets.Edit as B
|
||||
--import qualified Data.Text.Zipper as T
|
||||
--import qualified Graphics.Vty as VTY
|
||||
--import Text.Megaparsec
|
||||
|
||||
import TaskMachine.LTask
|
||||
import TaskMachine.Options
|
||||
import TaskMachine.Task
|
||||
import TaskMachine.UI.Types
|
||||
import TaskMachine.UI.Task
|
||||
import TaskMachine.UI.Popup
|
||||
--import TaskMachine.Options
|
||||
--import TaskMachine.UI.Popup
|
||||
--import TaskMachine.UI.Types
|
||||
|
||||
data TaskList n = TaskList
|
||||
{ visibleTasks :: B.List n LTask
|
||||
, invisibleTasks :: V.Vector LTask
|
||||
} deriving (Show)
|
||||
|
||||
newList :: n -> V.Vector LTask -> B.List n LTask
|
||||
newList name ltasks = B.list name ltasks 1
|
||||
|
||||
taskList :: n -> V.Vector LTask -> TaskList n
|
||||
taskList name ltasks = TaskList{visibleTasks=newList name ltasks, invisibleTasks=V.empty}
|
||||
|
||||
-- TODO: render while editing
|
||||
renderTaskList :: (Ord n, Show n) => Bool -> TaskList n -> B.Widget n
|
||||
renderTaskList focus tl = B.renderList (const $ renderTask . toTask) focus (visibleTasks tl)
|
||||
|
||||
{- Managing tasks -}
|
||||
|
||||
taskListElements :: TaskList n -> V.Vector LTask
|
||||
taskListElements tl = B.listElements (visibleTasks tl) <> invisibleTasks tl
|
||||
|
||||
taskListFilter :: (Task -> Bool) -> TaskList n -> TaskList n
|
||||
taskListFilter f tl =
|
||||
let (yes, no) = V.partition (f . toTask) $ taskListElements tl
|
||||
name = B.listName (visibleTasks tl)
|
||||
list = newList name yes
|
||||
in TaskList{visibleTasks=list, invisibleTasks=no}
|
||||
|
||||
taskListSelectedElement :: TaskList n -> Maybe Task
|
||||
taskListSelectedElement tl = toTask . snd <$> B.listSelectedElement (visibleTasks tl)
|
||||
|
||||
taskListModify :: (Task -> Task) -> TaskList n -> TaskList n
|
||||
taskListModify f tl =
|
||||
let list = B.listModify (modifyLTask f) (visibleTasks tl)
|
||||
in tl{visibleTasks=list}
|
||||
|
||||
{-
|
||||
{- Managing the tasks -}
|
||||
|
||||
allTasks :: UIState -> V.Vector LTask
|
||||
|
|
@ -68,8 +110,12 @@ renderTaskList s =
|
|||
|
||||
{- Updating state -}
|
||||
|
||||
taskListBehavior :: UIState -> VTY.Event -> NewState
|
||||
taskListBehavior = undefined
|
||||
|
||||
updateTaskList :: UIState -> B.BrickEvent RName () -> B.EventM RName (B.Next UIState)
|
||||
updateTaskList = undefined
|
||||
-}
|
||||
|
||||
{-
|
||||
widgetPriority :: B.AttrName -> Maybe Priority -> B.Widget n
|
||||
|
|
|
|||
|
|
@ -15,23 +15,26 @@ module TaskMachine.UI.Types
|
|||
--, handlePopupEvent
|
||||
-- * UI state
|
||||
, UIState(..)
|
||||
, NewState
|
||||
, bigFocusNext, bigFocusPrev
|
||||
--, smallFocusNext, smallFocusPrev
|
||||
, defaultTheme
|
||||
) where
|
||||
|
||||
import qualified Brick.Focus as B
|
||||
import qualified Brick.Themes as B
|
||||
import qualified Brick.Widgets.Dialog as B
|
||||
import qualified Brick.Widgets.Edit as B
|
||||
import qualified Brick.Widgets.List as B
|
||||
import qualified Data.Vector as V
|
||||
import qualified Graphics.Vty as VTY
|
||||
import qualified Brick as B
|
||||
import qualified Brick.Focus as B
|
||||
import qualified Brick.Themes as B
|
||||
import qualified Brick.Widgets.Dialog as B
|
||||
import qualified Brick.Widgets.Edit as B
|
||||
import qualified Brick.Widgets.List as B
|
||||
import qualified Graphics.Vty as VTY
|
||||
--import qualified Data.Vector as V
|
||||
|
||||
import TaskMachine.LTask
|
||||
--import TaskMachine.LTask
|
||||
import TaskMachine.Options
|
||||
import TaskMachine.UI.Popup
|
||||
import TaskMachine.UI.Task
|
||||
import TaskMachine.UI.TaskList
|
||||
|
||||
-- | Resource names
|
||||
data RName
|
||||
|
|
@ -76,15 +79,17 @@ handlePopupEvent e (Popup dialog widget) = Popup <$> B.handleDialogEvent e dialo
|
|||
{- UI state -}
|
||||
|
||||
data UIState = UIState
|
||||
{ options :: Options -- includes todo file and other config
|
||||
, focus :: B.FocusRing BigRing -- focus on the top, middle or bottom part
|
||||
, errorPopup :: Maybe (PopupOk RName)
|
||||
{ options :: Options -- includes todo file and other config
|
||||
, focus :: B.FocusRing BigRing -- focus on the top, middle or bottom part
|
||||
|
||||
-- popups
|
||||
, errorPopup :: Maybe (PopupOk RName)
|
||||
|
||||
-- tasks
|
||||
, taskList :: B.List RName LTask
|
||||
, invisibleTasks :: V.Vector LTask
|
||||
, tasks :: TaskList RName
|
||||
}
|
||||
|
||||
type NewState = B.EventM RName (B.Next UIState)
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue