Begin UI restructure

This commit is contained in:
Joscha 2018-09-27 16:41:43 +00:00
parent 5de27b195b
commit d8e0e1a867
5 changed files with 112 additions and 31 deletions

View file

@ -6,10 +6,8 @@ import qualified Brick as B
import TaskMachine.Options import TaskMachine.Options
import TaskMachine.UI import TaskMachine.UI
import TaskMachine.UI.TaskList
main :: IO() main :: IO()
main = do main = do
o <- parseOptions o <- parseOptions
state <- loadTasks (startUIState o) void $ B.defaultMain myApp (startUIState o)
void $ B.defaultMain myApp state

View file

@ -14,6 +14,7 @@ module TaskMachine.LTask
, toTask , toTask
, fromTasks , fromTasks
, toTasks , toTasks
, modifyLTask
, sortLTasks , sortLTasks
, loadLTasks , loadLTasks
, saveLTasks , saveLTasks
@ -47,6 +48,9 @@ fromTasks = zipWith LTask (map Old [1..])
toTasks :: [LTask] -> [Task] toTasks :: [LTask] -> [Task]
toTasks = map toTask . sortLTasks toTasks = map toTask . sortLTasks
modifyLTask :: (Task -> Task) -> LTask -> LTask
modifyLTask f (LTask pos task) = LTask pos (f task)
sortLTasks :: [LTask] -> [LTask] sortLTasks :: [LTask] -> [LTask]
sortLTasks = sortBy (compare `on` lPosition) sortLTasks = sortBy (compare `on` lPosition)

View file

@ -16,13 +16,41 @@ import TaskMachine.UI.TaskList
import TaskMachine.UI.TopBar import TaskMachine.UI.TopBar
import TaskMachine.UI.Types import TaskMachine.UI.Types
{- Rendering -}
drawBaseLayer :: UIState -> B.Widget RName 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 :: UIState -> [B.Widget RName]
drawUIState s@UIState{errorPopup=Just p} = [renderPopupOk p, drawBaseLayer s] drawUIState s@UIState{errorPopup=Just p} = [renderPopupOk p, drawBaseLayer s]
drawUIState s = [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) updateUIState :: UIState -> B.BrickEvent RName () -> B.EventM RName (B.Next UIState)
-- Closing error popup -- Closing error popup
updateUIState s@UIState{errorPopup=Just _} (B.VtyEvent (VTY.EvKey VTY.KEnter [])) = B.continue s{errorPopup=Nothing} 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.KChar '\t') [])) = B.continue $ bigFocusNext s
placeholderUpdate s (B.VtyEvent (VTY.EvKey VTY.KBackTab [])) = B.continue $ bigFocusPrev s placeholderUpdate s (B.VtyEvent (VTY.EvKey VTY.KBackTab [])) = B.continue $ bigFocusPrev s
placeholderUpdate s _ = B.continue s placeholderUpdate s _ = B.continue s
-}
{- Starting the app -} {- Starting the app -}
@ -60,6 +89,5 @@ startUIState o = UIState
{ options = o { options = o
, focus = B.focusRing [BRTaskList, BRNewTask, BRTopBar] , focus = B.focusRing [BRTaskList, BRNewTask, BRTopBar]
, errorPopup = Nothing , errorPopup = Nothing
, taskList = newTaskList V.empty , tasks = taskList RTaskList V.empty
, invisibleTasks = V.empty
} }

View file

@ -1,25 +1,67 @@
{-# LANGUAGE OverloadedStrings #-} module TaskMachine.UI.TaskList
( TaskList
module TaskMachine.UI.TaskList where , taskList
, renderTaskList
, taskListElements
, taskListFilter
, taskListSelectedElement
, taskListModify
) where
--import Data.Void --import Data.Void
import qualified Brick as B import qualified Brick as B
import qualified Brick.Widgets.List as B import qualified Brick.Widgets.List as B
import qualified Data.Vector as V import qualified Data.Vector as V
import qualified Brick.Focus as B --import qualified Brick.Focus as B
import qualified Brick.Widgets.Edit as B --import qualified Brick.Widgets.Edit as B
--import qualified Data.Text.Zipper as T --import qualified Data.Text.Zipper as T
--import qualified Graphics.Vty as VTY --import qualified Graphics.Vty as VTY
--import Text.Megaparsec --import Text.Megaparsec
import TaskMachine.LTask import TaskMachine.LTask
import TaskMachine.Options
import TaskMachine.Task import TaskMachine.Task
import TaskMachine.UI.Types
import TaskMachine.UI.Task 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 -} {- Managing the tasks -}
allTasks :: UIState -> V.Vector LTask allTasks :: UIState -> V.Vector LTask
@ -68,8 +110,12 @@ renderTaskList s =
{- Updating state -} {- Updating state -}
taskListBehavior :: UIState -> VTY.Event -> NewState
taskListBehavior = undefined
updateTaskList :: UIState -> B.BrickEvent RName () -> B.EventM RName (B.Next UIState) updateTaskList :: UIState -> B.BrickEvent RName () -> B.EventM RName (B.Next UIState)
updateTaskList = undefined updateTaskList = undefined
-}
{- {-
widgetPriority :: B.AttrName -> Maybe Priority -> B.Widget n widgetPriority :: B.AttrName -> Maybe Priority -> B.Widget n

View file

@ -15,23 +15,26 @@ module TaskMachine.UI.Types
--, handlePopupEvent --, handlePopupEvent
-- * UI state -- * UI state
, UIState(..) , UIState(..)
, NewState
, bigFocusNext, bigFocusPrev , bigFocusNext, bigFocusPrev
--, smallFocusNext, smallFocusPrev --, smallFocusNext, smallFocusPrev
, defaultTheme , defaultTheme
) where ) where
import qualified Brick as B
import qualified Brick.Focus as B import qualified Brick.Focus as B
import qualified Brick.Themes as B import qualified Brick.Themes as B
import qualified Brick.Widgets.Dialog as B import qualified Brick.Widgets.Dialog as B
import qualified Brick.Widgets.Edit as B import qualified Brick.Widgets.Edit as B
import qualified Brick.Widgets.List as B import qualified Brick.Widgets.List as B
import qualified Data.Vector as V
import qualified Graphics.Vty as VTY import qualified Graphics.Vty as VTY
--import qualified Data.Vector as V
import TaskMachine.LTask --import TaskMachine.LTask
import TaskMachine.Options import TaskMachine.Options
import TaskMachine.UI.Popup import TaskMachine.UI.Popup
import TaskMachine.UI.Task import TaskMachine.UI.Task
import TaskMachine.UI.TaskList
-- | Resource names -- | Resource names
data RName data RName
@ -78,13 +81,15 @@ handlePopupEvent e (Popup dialog widget) = Popup <$> B.handleDialogEvent e dialo
data UIState = UIState data UIState = UIState
{ options :: Options -- includes todo file and other config { options :: Options -- includes todo file and other config
, focus :: B.FocusRing BigRing -- focus on the top, middle or bottom part , focus :: B.FocusRing BigRing -- focus on the top, middle or bottom part
-- popups
, errorPopup :: Maybe (PopupOk RName) , errorPopup :: Maybe (PopupOk RName)
-- tasks -- tasks
, taskList :: B.List RName LTask , tasks :: TaskList RName
, invisibleTasks :: V.Vector LTask
} }
type NewState = B.EventM RName (B.Next UIState)