Add back basic UI

app/Main.hs

@@ -1,42 +1,15 @@
 module Main where
 
-{-
-import           Control.Applicative
 import           Control.Monad
 
-import qualified Brick                as B
+import qualified Brick               as B
-import qualified Options.Applicative  as O
 
-import           TaskMachine.LTask
+import           TaskMachine.Options
 import           TaskMachine.UI
-import           TaskMachine.UI.Types
+import           TaskMachine.UI.TaskList
-
-newtype Options = Options
-  { oTodofile :: FilePath
-  } deriving (Show)
-
-opts :: O.Parser Options
-opts = pure Options
-  <*> todofile
-  where
-    todofile = O.strArgument
-      (  O.help "The file containing all your tasks"
-      <> O.metavar "TODOFILE"
-      )
-
-optsInfo :: O.ParserInfo Options
-optsInfo = O.info (opts <**> O.helper) O.fullDesc
-  -- <> O.progDesc "program description"
-  -- <> O.header "help header"
 
 main :: IO()
 main = do
-  o <- O.execParser optsInfo
+  o <- parseOptions
-  result <- loadLTasks (oTodofile o)
+  state <- loadTasks (startUIState o)
-  case result of
+  void $ B.defaultMain myApp state
-    Left parseError -> putStrLn parseError
-    Right tasks -> void $ B.defaultMain (myApp defaultTheme) (startUIState tasks)
--}
-
-main :: IO ()
-main = putStrLn "Hello world again"

package.yaml

@@ -24,11 +24,11 @@ dependencies:
   #- ConfigFile
   #- aeson
   #- async
-  #- brick
+- brick
   #- bytestring
 - containers
 - megaparsec
-  #- optparse-applicative
+- optparse-applicative
   #- sqlite-simple
   #- stm
   #- text
@@ -38,7 +38,7 @@ dependencies:
   #- unix
   #- unordered-containers
 - vector
-  #- vty
+- vty
 # tests
 - hspec
 - QuickCheck

src/TaskMachine/LTask.hs

@@ -55,9 +55,9 @@ loadLTasks file = do
   content <- readFile file
   case parse pTasks file content of
     Right taskList  -> pure $ Right $ V.fromList $ fromTasks taskList
-    Left parseError -> pure $ Left $ show parseError
+    Left parseError -> pure $ Left $ parseErrorPretty parseError
 
-saveLTasks :: V.Vector LTask -> FilePath -> IO ()
+saveLTasks :: FilePath -> V.Vector LTask -> IO ()
-saveLTasks ltasks file = do
+saveLTasks file ltasks = do
   let text = formatTasks $ toTasks $ V.toList ltasks
   writeFile file text

src/TaskMachine/Options.hs

@@ -0,0 +1,28 @@
+module TaskMachine.Options
+  ( Options(..)
+  , parseOptions
+  ) where
+
+import           Control.Applicative
+
+import qualified Options.Applicative as O
+
+newtype Options = Options
+  { oTodofile :: FilePath
+  } deriving (Show)
+
+opts :: O.Parser Options
+opts = Options <$> todofile
+  where
+    todofile = O.strArgument
+      (  O.help "The file containing all your tasks"
+      <> O.metavar "TODOFILE"
+      )
+
+optsInfo :: O.ParserInfo Options
+optsInfo = O.info (opts <**> O.helper) O.fullDesc
+  -- <> O.progDesc "program description"
+  -- <> O.header "help header"
+
+parseOptions :: IO Options
+parseOptions = O.execParser optsInfo

src/TaskMachine/Task.hs

@@ -24,8 +24,8 @@ module TaskMachine.Task
   , formatTask
   , formatTasks
   , formatDate
-  , formatDueDate
+  , formatDue
-  , formatCreationDate
+  , formatCreated
   , formatCompletion
   , formatPriority
   , formatDescription
@@ -42,8 +42,8 @@ module TaskMachine.Task
   , pPriorityChar
   , pPriority
   , pDate
-  , pDueDate
+  , pDue
-  , pCreationDate
+  , pCreated
   , pDescription
   , pSnippet
   ) where
@@ -61,7 +61,7 @@ import           Text.Megaparsec.Char
 
 -- | A single task
 data Task = Task
-  { taskCompleted   :: Completion
+  { taskCompletion  :: Completion
   , taskPriority    :: Maybe Priority
   , taskDue         :: Maybe Day
   , taskCreated     :: Maybe Day
@@ -77,10 +77,10 @@ data Task = Task
 -- In that case, converting the task to a string and back yields a different result.
 formatTask :: Task -> String
 formatTask t
-  =  formatCompletion (taskCompleted t) ++ " "
+  =  formatCompletion (taskCompletion t) ++ " "
   ++ maybeWithSpace formatPriority (taskPriority t)
-  ++ maybeWithSpace formatDueDate (taskDue t)
+  ++ maybeWithSpace formatDue(taskDue t)
-  ++ maybeWithSpace formatCreationDate (taskCreated t)
+  ++ maybeWithSpace formatCreated (taskCreated t)
   ++ formatDescription (taskDescription t)
   where
     maybeWithSpace :: (a -> String) -> Maybe a -> String
@@ -99,17 +99,17 @@ formatTasks = concatMap ((++"\n") . formatTask)
 formatDate :: Day -> String
 formatDate = show
 
--- | Convert a 'Day' into the due date string representation, which can be parsed by 'pDueDate'.
+-- | Convert a 'Day' into the due date string representation, which can be parsed by 'pDue'.
 --
 -- Example: @"d2018-09-08"@
-formatDueDate :: Day -> String
+formatDue :: Day -> String
-formatDueDate d = 'd' : formatDate d
+formatDue d = 'd' : formatDate d
 
--- | Convert a 'Day into the creation date string representation, which can be parsed by 'pCreationDate'.
+-- | Convert a 'Day into the creation date string representation, which can be parsed by 'pCreation.
 --
 -- Example: @"c2018-09-08"@
-formatCreationDate :: Day -> String
+formatCreated :: Day -> String
-formatCreationDate d = 'c' : formatDate d
+formatCreated d = 'c' : formatDate d
 
 {- Completion -}
 
@@ -213,13 +213,13 @@ pDate = label "date" $ fromGregorian
     int :: Parser Int
     int = read <$> count 2 digitChar
 
--- | Parse a date in the due date format (see 'formatDueDate').
+-- | Parse a date in the due date format (see 'formatDue').
-pDueDate :: Parser Day
+pDue :: Parser Day
-pDueDate = label "due date" $ char 'd' *> pDate
+pDue = label "due date" $ char 'd' *> pDate
 
--- | Parse a date in the creation date format (see 'formatCreationDate').
+-- | Parse a date in the creation date format (see 'formatCreated').
-pCreationDate :: Parser Day
+pCreated :: Parser Day
-pCreationDate = label "creation date" $ char 'c' *> pDate
+pCreated = label "creation date" $ char 'c' *> pDate
 
 -- Completion
 
@@ -263,7 +263,7 @@ pContext = char '@' *> (Context <$> wordBody)
 pKeyValue :: Parser Snippet
 pKeyValue = KeyValue <$> (keyBody <* char ':') <*> wordBody
   where
-    keyBody = takeWhile1P (Just "key character")   (not . (`elem` ": \n"))
+    keyBody = takeWhile1P (Just "key character") (not . (`elem` ": \n"))
 
 -- | Parse a 'Description' (see 'formatDescription').
 pDescription :: Parser Description
@@ -300,8 +300,8 @@ pTask
   =   Task
   <$> andSpace pCompletion
   <*> maybeParse (andSpace pPriority)
-  <*> maybeParse (andSpace pDueDate)
+  <*> maybeParse (andSpace pDue)
-  <*> maybeParse (andSpace pCreationDate)
+  <*> maybeParse (andSpace pCreated)
   <*> pDescription
 
 -- | Parse a list of 'Task's (see 'formatTasks').

src/TaskMachine/UI.hs

@@ -0,0 +1,65 @@
+module TaskMachine.UI
+  ( myApp
+  , startUIState
+  ) where
+
+import qualified Brick                     as B
+import qualified Brick.Focus               as B
+import qualified Brick.Themes              as B
+import qualified Data.Vector               as V
+import qualified Graphics.Vty.Input.Events as VTY
+
+import           TaskMachine.Options
+import           TaskMachine.UI.NewTask
+import           TaskMachine.UI.TaskList
+import           TaskMachine.UI.TopBar
+import           TaskMachine.UI.Popup
+import           TaskMachine.UI.Types
+
+drawBaseLayer :: UIState -> B.Widget RName
+drawBaseLayer s = B.vBox [placeholderTopBar, renderTaskList s, placeholderNewTask]
+
+drawUIState :: UIState -> [B.Widget RName]
+drawUIState s@UIState{errorPopup=Just p} = [renderPopupOk p, drawBaseLayer s]
+drawUIState s                            = [drawBaseLayer 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}
+updateUIState s@UIState{errorPopup=Just _} (B.VtyEvent (VTY.EvKey VTY.KEsc   [])) = B.continue s{errorPopup=Nothing}
+--updateUIState s@UIState{errorPopup=Just p} (B.VtyEvent e) = do
+--  newPopup <- handlePopupEvent e p
+--  B.continue s{errorPopup=Just newPopup}
+updateUIState s e =
+  case B.focusGetCurrent (focus s) of
+    Nothing           -> B.halt s
+    (Just BRTopBar)   -> placeholderUpdate s e
+    --(Just BRTaskList) -> updateTaskList s e
+    (Just BRTaskList) -> placeholderUpdate s e
+    (Just BRNewTask)  -> placeholderUpdate s e
+
+placeholderUpdate :: UIState -> B.BrickEvent RName () -> B.EventM RName (B.Next UIState)
+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 -}
+
+myApp :: B.App UIState () RName
+myApp = B.App
+  { B.appDraw         = drawUIState
+  , B.appChooseCursor = B.showFirstCursor
+  , B.appHandleEvent  = updateUIState
+  , B.appStartEvent   = pure
+  , B.appAttrMap      = const (B.themeToAttrMap defaultTheme)
+  }
+
+startUIState :: Options -> UIState
+startUIState o = UIState
+  { options        = o
+  , focus          = B.focusRing [BRTaskList, BRNewTask, BRTopBar]
+  , errorPopup     = Nothing
+  , taskList       = newTaskList V.empty
+  , invisibleTasks = V.empty
+  }

src/TaskMachine/UI/NewTask.hs

@@ -0,0 +1,8 @@
+module TaskMachine.UI.NewTask where
+
+import qualified Brick                as B
+
+import           TaskMachine.UI.Types
+
+placeholderNewTask :: B.Widget RName
+placeholderNewTask = B.str "New: " B.<+> B.vLimit 1 (B.fill '_')

src/TaskMachine/UI/Popup.hs

@@ -0,0 +1,34 @@
+module TaskMachine.UI.Popup
+  ( minPopupWidth
+  -- * Ok popup
+  , PopupOk
+  , popupOk
+  , popupOk'
+  , renderPopupOk
+  , handlePopupOkEvent
+  ) where
+
+import qualified Brick                as B
+import qualified Brick.Widgets.Dialog as B
+import qualified Graphics.Vty         as VTY
+
+minPopupWidth :: Int
+minPopupWidth = 70
+
+{- Ok popup -}
+
+data PopupOk n = PopupOk (B.Dialog ()) (B.Widget n)
+
+popupOk :: String -> String -> PopupOk n
+popupOk title content = popupOk' title (B.str content)
+
+popupOk' :: String -> B.Widget n -> PopupOk n
+popupOk' title widget =
+  let dialog = B.dialog (Just title) (Just (0,[("Ok",())])) minPopupWidth
+  in  PopupOk dialog widget
+
+renderPopupOk :: PopupOk n -> B.Widget n
+renderPopupOk (PopupOk dialog widget) = B.renderDialog dialog widget
+
+handlePopupOkEvent :: VTY.Event -> PopupOk n -> B.EventM n (PopupOk n)
+handlePopupOkEvent e (PopupOk dialog widget) = PopupOk <$> B.handleDialogEvent e dialog <*> pure widget

src/TaskMachine/UI/Task.hs

@@ -0,0 +1,86 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module TaskMachine.UI.Task
+  ( renderTask
+  , renderCompletion
+  , renderPriority
+  , renderDue
+  , renderCreated
+  , renderDescription
+  , renderSnippet
+  -- * Attributes
+  , taskAttr
+  , taskCompletionAttr
+  , taskPriorityAttr
+  , taskDueAttr
+  , taskCreatedAttr
+  , taskProjectAttr
+  , taskContextAttr
+  , taskKeyValueAttr
+  ) where
+
+import           Data.Maybe
+
+import qualified Brick              as B
+import           Data.Time.Calendar
+
+import           TaskMachine.Task
+
+withSpace :: B.Widget n -> B.Widget n
+withSpace w = w B.<+> B.withDefAttr taskAttr (B.str " ")
+
+renderCompletion :: Completion -> B.Widget n
+renderCompletion = B.withDefAttr taskCompletionAttr . B.str . formatCompletion
+
+renderPriority :: Priority -> B.Widget n
+renderPriority p =
+  let name = taskPriorityAttr <> B.attrName [priorityToChar p]
+  in  B.withDefAttr name $ B.str $ formatPriority p
+
+renderDue :: Day -> B.Widget n
+renderDue = B.withDefAttr taskDueAttr . B.str . formatDue
+
+renderCreated :: Day -> B.Widget n
+renderCreated = B.withDefAttr taskCreatedAttr . B.str . formatCreated
+
+renderDescription :: Description -> B.Widget n
+renderDescription = B.withDefAttr taskAttr . B.hBox . map renderSnippet
+
+renderSnippet :: Snippet -> B.Widget n
+renderSnippet s@(Project _)    = B.withDefAttr taskProjectAttr  $ B.str $ formatSnippet s
+renderSnippet s@(Context _)    = B.withDefAttr taskContextAttr  $ B.str $ formatSnippet s
+renderSnippet s@(KeyValue _ _) = B.withDefAttr taskKeyValueAttr $ B.str $ formatSnippet s
+renderSnippet s                =                                  B.str $ formatSnippet s
+
+renderTask :: Task -> B.Widget n
+renderTask t = B.hBox $ catMaybes
+  [ Just $ withSpace $ renderCompletion $ taskCompletion t
+  , (withSpace . renderPriority) <$> taskPriority t
+  , (withSpace . renderDue) <$> taskDue t
+  , (withSpace . renderCreated) <$> taskCreated t
+  , Just $ renderDescription $ taskDescription t
+  ]
+
+taskAttr :: B.AttrName
+taskAttr = "task"
+
+taskCompletionAttr :: B.AttrName
+taskCompletionAttr = taskAttr <> "completion"
+
+taskPriorityAttr :: B.AttrName
+taskPriorityAttr = taskAttr <> "priority"
+
+taskDueAttr :: B.AttrName
+taskDueAttr = taskAttr <> "due"
+
+taskCreatedAttr :: B.AttrName
+taskCreatedAttr = taskAttr <> "created"
+
+taskProjectAttr :: B.AttrName
+taskProjectAttr = taskAttr <> "project"
+
+taskContextAttr :: B.AttrName
+taskContextAttr = taskAttr <> "context"
+
+taskKeyValueAttr :: B.AttrName
+taskKeyValueAttr = taskAttr <> "keyvalue"

src/TaskMachine/UI/TaskList.hs

@@ -0,0 +1,178 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module TaskMachine.UI.TaskList 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 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
+
+{- Managing the tasks -}
+
+allTasks :: UIState -> V.Vector LTask
+allTasks s =
+  let visible   = B.listElements $ taskList s
+      invisible = invisibleTasks s
+  in  visible <> invisible
+
+newTaskList :: V.Vector LTask -> B.List RName LTask
+newTaskList ltasks = B.list RTaskList ltasks 1
+
+-- TODO: Catch errors when loading tasks
+loadTasks :: UIState -> IO UIState
+loadTasks s = do
+  let file = oTodofile $ options s
+  result <- loadLTasks file
+  case result of
+    Left errorMessage -> pure s{errorPopup=Just $ popupOk "Error loading tasks" errorMessage}
+    Right ltasks      -> pure s{taskList=newTaskList ltasks, invisibleTasks=V.empty}
+
+-- TODO: Catch errors when saving tasks
+saveTasks :: UIState -> IO UIState
+saveTasks s = do
+  let file = oTodofile $ options s
+      ltasks = allTasks s
+  saveLTasks file ltasks
+  pure s
+
+filterTasks :: (Task -> Bool) -> UIState -> UIState
+filterTasks f s =
+  let (yes, no) = V.partition (f . toTask) (allTasks s)
+  in  s{taskList=newTaskList yes, invisibleTasks=no}
+
+{- Rendering -}
+
+renderLTask :: Maybe (B.Editor String RName) -> Bool -> LTask -> B.Widget RName
+renderLTask _           False ltask = renderTask $ toTask ltask
+renderLTask Nothing     True  ltask = renderTask $ toTask ltask
+renderLTask _           _     _     = undefined
+--renderLTask (Just edit) True  _     = B.renderEditor (B.str . unlines) True edit
+
+renderTaskList :: UIState -> B.Widget RName
+renderTaskList s =
+  let inFocus = B.focusGetCurrent (focus s) == Just BRTaskList
+  in  B.renderList (renderLTask Nothing) inFocus (taskList s)
+
+{- Updating state -}
+
+updateTaskList :: UIState -> B.BrickEvent RName () -> B.EventM RName (B.Next UIState)
+updateTaskList = undefined
+
+{-
+widgetPriority :: B.AttrName -> Maybe Priority -> B.Widget n
+widgetPriority _         Nothing     = B.emptyWidget
+widgetPriority highlight (Just prio) =
+  let attrName = highlight <> "priority" <> B.attrName [priorityToChar prio]
+      text = formatPriority prio ++ " "
+  in  B.withAttr attrName $ B.str text
+
+widgetDescription :: B.AttrName -> String -> B.Widget n
+widgetDescription highlight desc =
+  let attrName = highlight <> "description"
+  in  B.withAttr attrName $ B.str desc
+
+renderLTask :: Bool -> LTask -> B.Widget RName
+renderLTask highlight (LTask _ Task{..}) =
+  let attrHighlight = if highlight then "highlight" else "normal"
+      wCompleted   = B.str $ if taskCompleted then "x " else "  "
+      wPriority    = widgetPriority    attrHighlight taskPriority
+      wDescription = widgetDescription attrHighlight taskDescription
+  in  B.hBox [wCompleted, wPriority, wDescription]
+-}
+
+--type Editor = B.Editor String RName
+--type TaskList = B.List RName LTask
+
+{- Editing tasks -}
+
+{-
+toEditText :: Task -> String
+toEditText Task{taskPriority=Nothing, taskDescription=d} = descriptionToString d
+toEditText Task{taskPriority=Just p, taskDescription=d} = formatPriority p ++ " " ++ descriptionToString d
+
+pEditText :: Parser (Maybe Priority, String)
+pEditText = undefined
+--pEditText = do
+--  prio <- maybeParse (andSpace pPriority)
+--  notFollowedBy (andSpace pDates)
+--  desc <- untilEndOfLine
+--  pure (prio, desc)
+
+parseEditText :: String -> Either (ParseError Char Void) (Maybe Priority, String)
+parseEditText = parse pEditText "edited task"
+-}
+
+{- Updating state -}
+
+{-
+startEdit :: UIState -> UIState
+startEdit s =
+  case B.listSelectedElement (taskList s) of
+    Nothing -> s
+    Just (_, LTask _ t) ->
+      let edit = B.editor RTaskEdit (Just 1) (toEditText t)
+      in  s{taskEdit=Just edit}
+
+finishEdit :: UIState -> UIState
+finishEdit s@UIState{taskEdit=Just edit} =
+  case B.getEditContents edit of
+    [line] -> case parseEditText line of
+      Right (prio, desc) ->
+        --let changeTask (LTask n t) = LTask n t{taskPriority=prio, taskDescription=desc}
+        let changeTask (LTask n t) = LTask n t{taskPriority=prio, taskDescription=undefined desc}
+            newList = B.listModify changeTask (taskList s)
+        in  s{taskList=newList, taskEdit=Nothing}
+
+      Left parseError -> s{errorPopup=Just $ popup "Parse error" (parseErrorTextPretty parseError)}
+    _ -> s{errorPopup=Just $ popup "Empty editor" "Enter a task description."}
+finishEdit s = s
+
+updateEditor :: B.Editor String RName -> VTY.Event -> B.EventM RName (B.Editor String RName)
+updateEditor edit (VTY.EvKey VTY.KHome []) = pure $ B.applyEdit T.gotoBOL edit
+updateEditor edit (VTY.EvKey VTY.KEnd  []) = pure $ B.applyEdit T.gotoEOL edit
+updateEditor edit e                        = B.handleEditorEvent e edit
+
+updateTaskList :: UIState -> B.BrickEvent RName () -> B.EventM RName (B.Next UIState)
+-- Exit application
+updateTaskList s@UIState{taskEdit=Nothing} (B.VtyEvent (VTY.EvKey VTY.KEsc [])) = B.halt s
+
+-- Test stuff
+updateTaskList s e = do
+  let changeTask (LTask n t) = LTask n t{taskDescription=show e}
+      newList = B.listModify changeTask (taskList s)
+  B.continue s{taskList=newList}
+
+-- Scroll focus
+updateTaskList s (B.VtyEvent (VTY.EvKey VTY.KBackTab     [])) = B.continue $ bigFocusPrev s
+updateTaskList s (B.VtyEvent (VTY.EvKey (VTY.KChar '\t') [])) = B.continue $ bigFocusNext s
+-- Start editing the current task
+updateTaskList s@UIState{taskEdit=Nothing} (B.VtyEvent (VTY.EvKey (VTY.KChar 'e') [])) = B.continue $ startEdit s
+-- Update the task list
+updateTaskList s@UIState{taskEdit=Nothing} (B.VtyEvent e) = do
+  newList <- B.handleListEventVi B.handleListEvent e (taskList s)
+  B.continue s{taskList=newList}
+-- Exit the editor (losing all changes)
+updateTaskList s@UIState{taskEdit=Just _} (B.VtyEvent (VTY.EvKey VTY.KEsc [])) = B.continue $ s{taskEdit=Nothing}
+-- Exit the editor (keeping all changes)
+updateTaskList s@UIState{taskEdit=Just _} (B.VtyEvent (VTY.EvKey VTY.KEnter [])) = B.continue $ finishEdit s
+-- Update the editor
+updateTaskList s@UIState{taskEdit=Just edit} (B.VtyEvent e) = do
+  newTaskEdit <- updateEditor edit e
+  B.continue s{taskEdit=Just newTaskEdit}
+-- Catch everything else
+updateTaskList s _ = B.halt s
+--updateTaskList list (Just editor) (B.VtyEvent e) = (,) <$> const list <*> B.handleEditorEvent e editor
+-}

src/TaskMachine/UI/TopBar.hs

@@ -0,0 +1,6 @@
+module TaskMachine.UI.TopBar where
+
+import qualified Brick as B
+
+placeholderTopBar :: B.Widget n
+placeholderTopBar = B.str "Prune | Reload | Search: " B.<+> B.vLimit 1 (B.fill '_')

src/TaskMachine/UI/Types.hs

@@ -0,0 +1,176 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | A collection of types necessary for the UI.
+--
+-- These were put in a separate module to avoid an import cycle.
+
+module TaskMachine.UI.Types
+  ( RName(..)
+  , BigRing(..)
+  --, SmallRing(..)
+  -- * Popups
+  --, Popup
+  --, popup
+  --, renderPopup
+  --, handlePopupEvent
+  -- * UI state
+  , UIState(..)
+  , 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           TaskMachine.LTask
+import           TaskMachine.Options
+import           TaskMachine.UI.Popup
+import           TaskMachine.UI.Task
+
+-- | Resource names
+data RName
+  = RSearchEdit
+  | RTaskList
+  | RTaskEdit
+  | RNewEdit
+  deriving (Eq, Show, Ord)
+
+data BigRing
+  = BRTopBar
+  | BRTaskList
+  | BRNewTask
+  deriving (Eq)
+
+{-
+data SmallRing
+  = SRPurge
+  | SRReload
+  | SRSearch
+  deriving (Eq)
+-}
+
+{- Popup -}
+
+{-
+data Popup = Popup (B.Dialog ()) (B.Widget RName)
+
+popup :: String -> String -> Popup
+popup title content =
+  let dialog = B.dialog (Just title) (Just (0,[("OK",())])) 70 -- with a min terminal width of 80
+      widget = B.str content
+  in  Popup dialog widget
+
+renderPopup :: Popup -> B.Widget RName
+renderPopup (Popup dialog widget) = B.renderDialog dialog widget
+
+handlePopupEvent :: VTY.Event -> Popup -> B.EventM RName Popup
+handlePopupEvent e (Popup dialog widget) = Popup <$> B.handleDialogEvent e dialog <*> pure widget
+-}
+
+{- 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)
+
+  -- tasks
+  , taskList       :: B.List RName LTask
+  , invisibleTasks :: V.Vector LTask
+  }
+
+
+
+
+
+
+
+
+{-
+  , focus          :: B.FocusRing BigRing
+  -- ^ 'B.FocusRing' for tab navigation
+  --, focusTopBar    :: B.FocusRing SmallRing
+  -- ^ 'B.FocusRing' for the top bar, for ← and → arrow key navigation
+  , errorPopup     :: Maybe Popup
+
+  -- TOP BAR
+  --, searchEdit     :: B.Editor String RName
+  -- ^ Content of the search field
+
+  -- TASK LIST
+  , taskList       :: B.List RName LTask
+  -- ^ List to display tasks
+  , invisibleTasks :: V.Vector LTask
+  -- ^ All tasks that aren't displayed in the taskList due to search filters
+  , taskEdit       :: Maybe (B.Editor String RName)
+  -- ^ Task currently being edited
+
+  -- NEW TASK
+  --, newEdit        :: B.Editor String RName
+  -- ^ "New task" text field at the bottom
+  }
+
+-- | Create a starting UI state
+startUIState :: V.Vector LTask -> UIState
+startUIState ltasks = UIState
+  { focus          = B.focusRing [BRTaskList, BRNewTask, BRTopBar]
+  --, focusTopBar    = B.focusRing [SRPrune, SRReload, SRSearch]
+  , errorPopup     = Nothing
+  --, searchEdit     = B.editor RSearchEdit (Just 1) ""
+  , taskList       = B.list RTaskList ltasks 1
+  , invisibleTasks = V.empty
+  , taskEdit       = Nothing
+  --, newEdit        = B.editor RNewEdit (Just 1) ""
+  }
+-}
+
+bigFocusNext :: UIState -> UIState
+bigFocusNext s = s{focus=B.focusNext (focus s)}
+
+bigFocusPrev :: UIState -> UIState
+bigFocusPrev s = s{focus=B.focusPrev (focus s)}
+
+{-
+smallFocusNext :: UIState -> UIState
+smallFocusNext s = s{focusTopBar=B.focusNext (focusTopBar s)}
+
+smallFocusPrev :: UIState -> UIState
+smallFocusPrev s = s{focusTopBar=B.focusPrev (focusTopBar s)}
+-}
+
+defaultTheme :: B.Theme
+defaultTheme = B.newTheme VTY.defAttr
+  [ (B.dialogAttr,                                    none)
+  , (B.buttonAttr,                                    none)
+  , (B.buttonSelectedAttr,                    bg' VTY.blue)
+  , (B.editAttr,                                      none)
+  , (B.editFocusedAttr,                       bg' VTY.blue)
+  , (B.listAttr,                                      none)
+  , (B.listSelectedAttr,                      st' VTY.bold)
+  , (B.listSelectedFocusedAttr, bg VTY.blue $ st' VTY.bold)
+  , (taskAttr,                                        none)
+  , (taskCompletionAttr,                              none)
+  , (taskPriorityAttr,        fg VTY.cyan   $ st' VTY.bold)
+  , (taskPriorityAttr <> "A", fg VTY.red    $ st' VTY.bold)
+  , (taskPriorityAttr <> "B", fg VTY.yellow $ st' VTY.bold)
+  , (taskPriorityAttr <> "C", fg VTY.green  $ st' VTY.bold)
+  , (taskDueAttr,                      fg' VTY.brightBlack)
+  , (taskCreatedAttr,                  fg' VTY.brightBlack)
+  , (taskProjectAttr,                       fg' VTY.yellow)
+  , (taskContextAttr,                         fg' VTY.cyan)
+  , (taskKeyValueAttr,                     fg' VTY.magenta)
+  ]
+  where
+    fg  = flip VTY.withForeColor
+    bg  = flip VTY.withBackColor
+    --st  = flip VTY.withStyle
+    fg' = VTY.withForeColor none
+    bg' = VTY.withBackColor none
+    st' = VTY.withStyle     none
+    none = VTY.defAttr