Update task position in tree after postpone

Author: cblp

ff-qtah/FF/Qt/MainWindow.hs

@@ -75,7 +75,10 @@ new progName storage = do
     agendaTasks <- TaskListWidget.new
     QSplitter.addWidget agendaSplitter agendaTasks.parent
 
-    taskWidget <- TaskWidget.new storage
+    taskWidget <-
+        TaskWidget.new
+            storage
+            (TaskListWidget.upsertTask agendaTasks) -- on task updated
     QWidget.hide taskWidget.parent
     QSplitter.addWidget agendaSplitter taskWidget.parent
 

ff-qtah/FF/Qt/TaskListWidget.hs

@@ -15,9 +15,10 @@ module FF.Qt.TaskListWidget (
     upsertTask,
 ) where
 
-import Control.Monad (void)
+import Control.Monad (void, when)
+import Data.Foldable (for_)
 import Data.IORef (IORef, modifyIORef, newIORef, readIORef)
-import Data.Map.Strict (Map)
+import Data.Map.Strict (Map, (!))
 import Data.Map.Strict qualified as Map
 import Data.Text qualified as Text
 import Data.Time (getCurrentTime, toGregorian, utctDay)
@@ -46,7 +47,10 @@ import FF.Types (
 import FF.UI (sampleLabel)
 
 data TaskListWidget = TaskListWidget
-    {parent :: QTreeWidget, modeItems :: IORef (Map TaskMode QTreeWidgetItem)}
+    { parent :: QTreeWidget
+    , modeItems :: IORef (Map TaskMode QTreeWidgetItem)
+    , taskItems :: IORef (Map String (TaskMode, QTreeWidgetItem))
+    }
 
 {- | Value order in this enumeration defines the field order in the tree widget.
 0th column mustn't be hideable, because when 0th column is hidden,
@@ -60,9 +64,6 @@ data Field
       SortKeyField
     deriving (Bounded, Enum)
 
-fieldCount :: Int
-fieldCount = fromEnum (maxBound :: Field) + 1
-
 fieldsToStrings :: (Field -> String) -> [String]
 fieldsToStrings f = map f [minBound .. maxBound]
 
@@ -99,8 +100,9 @@ new = do
     QTreeWidget.sortItems parent (fromEnum SortKeyField) Qt.AscendingOrder
 
     modeItems <- newIORef mempty
+    taskItems <- newIORef mempty
 
-    let this = TaskListWidget{parent, modeItems}
+    let this = TaskListWidget{parent, modeItems, taskItems}
 
     setDebugInfoVisible this False
 
@@ -112,18 +114,34 @@ setDebugInfoVisible this v = do
     QTreeView.setColumnHidden this.parent (fromEnum SortKeyField) $ not v
     QTreeView.setHeaderHidden this.parent $ not v
 
--- Only insertion is implemeted. TODO implement update.
 upsertTask :: TaskListWidget -> EntityView Note -> IO ()
 upsertTask this entity = do
     today <- utctDay <$> getCurrentTime
     let mode = taskMode today note
+    mExisting <- Map.lookup noteId <$> readIORef this.taskItems
+    case mExisting of
+        Nothing -> do
+            modeItem <- getOrCreateModeItem this mode
+            item <- createTaskItem modeItem entity
+            modifyIORef this.taskItems $ Map.insert noteId (mode, item)
+        Just (oldMode, item) -> do
+            updateTaskItem item entity
+            when (oldMode /= mode) do
+                oldModeItem <- (! oldMode) <$> readIORef this.modeItems
+                idx <- QTreeWidgetItem.indexOfChild oldModeItem item
+                void $ QTreeWidgetItem.takeChild oldModeItem idx
+                newModeItem <- getOrCreateModeItem this mode
+                QTreeWidgetItem.addChild newModeItem item
+                modifyIORef this.taskItems $ Map.insert noteId (mode, item)
+  where
+    Entity{entityId = DocId noteId, entityVal = NoteView{note}} = entity
+
+getOrCreateModeItem :: TaskListWidget -> TaskMode -> IO QTreeWidgetItem
+getOrCreateModeItem this mode = do
     mModeItem <- Map.lookup mode <$> readIORef this.modeItems
-    modeItem <- case mModeItem of
+    case mModeItem of
         Just item -> pure item
         Nothing -> createModeItem this mode
-    createTaskItem modeItem entity
-  where
-    Entity{entityVal = NoteView{note}} = entity
 
 createModeItem :: TaskListWidget -> TaskMode -> IO QTreeWidgetItem
 createModeItem this mode = do
@@ -148,17 +166,26 @@ createModeItem this mode = do
     modifyIORef this.modeItems $ Map.insert mode item
     pure item
 
-createTaskItem :: QTreeWidgetItem -> EntityView Note -> IO ()
+createTaskItem :: QTreeWidgetItem -> EntityView Note -> IO QTreeWidgetItem
 createTaskItem modeItem entity =
-    void $
-        QTreeWidgetItem.newWithParentItemAndStringsAndType
-            modeItem
-            ( fieldsToStrings \case
-                IdField -> noteId
-                SortKeyField -> sortKey
-                TitleField -> title
-            )
-            (itemTypeToInt Task)
+    QTreeWidgetItem.newWithParentItemAndStringsAndType
+        modeItem
+        (fieldsToStrings $ taskItemField entity)
+        (itemTypeToInt Task)
+
+updateTaskItem :: QTreeWidgetItem -> EntityView Note -> IO ()
+updateTaskItem item entity =
+    for_ [minBound .. maxBound] \field ->
+        QTreeWidgetItem.setText
+            item
+            (fromEnum field)
+            (taskItemField entity field)
+
+taskItemField :: EntityView Note -> Field -> String
+taskItemField entity = \case
+    IdField -> noteId
+    SortKeyField -> sortKey
+    TitleField -> title
   where
     Entity{entityId = DocId noteId, entityVal = NoteView{note}} = entity
     title = concat $ take 1 $ lines $ fromRgaM note.note_text

ff-qtah/FF/Qt/TaskWidget.hs

@@ -33,6 +33,7 @@ import FF (cmdPostpone, fromRgaM, viewNote)
 import FF.Types (
     Entity (..),
     EntityDoc,
+    EntityView,
     Note (..),
     NoteId,
     View (NoteView, note),
@@ -51,10 +52,11 @@ data TaskWidget = TaskWidget
     , start :: DateComponent
     , end :: DateComponent
     , noteId :: IORef (Maybe NoteId)
+    , onTaskUpdated :: EntityView Note -> IO ()
     }
 
-new :: Storage.Handle -> IO TaskWidget
-new storage = do
+new :: Storage.Handle -> (EntityView Note -> IO ()) -> IO TaskWidget
+new storage onTaskUpdated = do
     parent <- QScrollArea.new
 
     innerWidget <- QFrame.new
@@ -97,6 +99,7 @@ new storage = do
                 , start
                 , end
                 , noteId
+                , onTaskUpdated
                 }
 
     connect_ postpone QAbstractButton.clickedSignal $ postponeSlot this
@@ -118,13 +121,15 @@ reload this noteId = do
 
 update :: TaskWidget -> EntityDoc Note -> IO ()
 update this noteDoc = do
-    Entity{entityVal} <- runStorage this.storage $ viewNote noteDoc
+    entity <- runStorage this.storage $ viewNote noteDoc
+    let Entity{entityVal} = entity
     let NoteView{note} = entityVal
     let Note{note_text, note_start, note_end} = note
     QLabel.setText this.textContent $ fromRgaM note_text
     DateComponent.setDate this.start note_start
     DateComponent.setDate this.end note_end
     QWidget.adjustSize this.innerWidget
+    this.onTaskUpdated entity
 
 makeSimpleSizePolicy :: QSizePolicyPolicy -> IO QSizePolicy
 makeSimpleSizePolicy policy =