ff-qtah: Add postpone action

Author: cblp

ff-qtah/FF/Qt/DateComponent.hs

@@ -5,6 +5,7 @@
 module FF.Qt.DateComponent (DateComponent (..), new, setDate) where
 
 import Data.Time (Day, toGregorian)
+import Foreign.Hoppy.Runtime (toGc)
 import Graphics.UI.Qtah.Core.QDate qualified as QDate
 import Graphics.UI.Qtah.Widgets.QAbstractSpinBox qualified as QAbstractSpinBox
 import Graphics.UI.Qtah.Widgets.QBoxLayout qualified as QBoxLayout
@@ -56,7 +57,7 @@ setDate this day =
             QWidget.show this.date
             QWidget.hide this.add
             QWidget.show this.remove
-            qdate <- QDate.newWithYmd (fromInteger y) m d
+            qdate <- toGc =<< QDate.newWithYmd (fromInteger y) m d
             QDateTimeEdit.setDate this.date qdate
         Nothing -> do
             -- TODO replace with button "add date"

ff-qtah/FF/Qt/MainWindow.hs

@@ -160,7 +160,7 @@ setTaskView taskWidget item = do
             hPutStrLn stderr $ "internal error" ++ prettyCallStack callStack
         Task -> do
             noteId <- DocId @Note <$> TaskListWidget.getId item
-            TaskWidget.update taskWidget noteId
+            TaskWidget.reload taskWidget noteId
             QWidget.show taskWidget.parent
 
 showAboutProgram :: (QWidgetPtr mainWindow) => mainWindow -> String -> IO ()

ff-qtah/FF/Qt/TaskWidget.hs

@@ -1,15 +1,18 @@
+{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedRecordDot #-}
 
 module FF.Qt.TaskWidget (
     TaskWidget (parent),
     new,
-    update,
+    reload,
 ) where
 
--- global
+import Data.IORef (IORef, atomicWriteIORef, newIORef, readIORef)
 import Foreign.Hoppy.Runtime (toGc)
 import Graphics.UI.Qtah.Core.Types (QtAlignmentFlag (AlignTop))
+import Graphics.UI.Qtah.Signal (connect_)
+import Graphics.UI.Qtah.Widgets.QAbstractButton qualified as QAbstractButton
 import Graphics.UI.Qtah.Widgets.QBoxLayout qualified as QBoxLayout
 import Graphics.UI.Qtah.Widgets.QFormLayout qualified as QFormLayout
 import Graphics.UI.Qtah.Widgets.QFrame (QFrame)
@@ -18,25 +21,24 @@ import Graphics.UI.Qtah.Widgets.QHBoxLayout qualified as QHBoxLayout
 import Graphics.UI.Qtah.Widgets.QLabel (QLabel)
 import Graphics.UI.Qtah.Widgets.QLabel qualified as QLabel
 import Graphics.UI.Qtah.Widgets.QPushButton qualified as QPushButton
-import Graphics.UI.Qtah.Widgets.QScrollArea (QScrollArea)
+import Graphics.UI.Qtah.Widgets.QScrollArea (QScrollArea, setWidget)
 import Graphics.UI.Qtah.Widgets.QScrollArea qualified as QScrollArea
 import Graphics.UI.Qtah.Widgets.QSizePolicy (QSizePolicy, QSizePolicyPolicy)
 import Graphics.UI.Qtah.Widgets.QSizePolicy qualified as QSizePolicy
 import Graphics.UI.Qtah.Widgets.QWidget qualified as QWidget
 import RON.Storage.FS (runStorage)
 import RON.Storage.FS qualified as Storage
 
--- project
-import FF (fromRgaM, viewNote)
+import FF (cmdPostpone, fromRgaM, viewNote)
 import FF.Types (
     Entity (..),
+    EntityDoc,
     Note (..),
     NoteId,
     View (NoteView, note),
     loadNote,
  )
 
--- package
 import FF.Qt.DateComponent (DateComponent)
 import FF.Qt.DateComponent qualified as DateComponent
 
@@ -48,14 +50,15 @@ data TaskWidget = TaskWidget
     , storage :: Storage.Handle
     , start :: DateComponent
     , end :: DateComponent
+    , noteId :: IORef (Maybe NoteId)
     }
 
 new :: Storage.Handle -> IO TaskWidget
 new storage = do
     parent <- QScrollArea.new
 
     innerWidget <- QFrame.new
-    QScrollArea.setWidget parent innerWidget
+    setWidget parent innerWidget
 
     textContent <- QLabel.new
     QWidget.setSizePolicy textContent
@@ -83,11 +86,39 @@ new storage = do
     QBoxLayout.addStretch actions
     QFormLayout.addRowLayout form actions
 
-    pure TaskWidget{parent, innerWidget, textContent, storage, start, end}
-
-update :: TaskWidget -> NoteId -> IO ()
-update this noteId = do
-    Entity{entityVal} <- runStorage this.storage $ loadNote noteId >>= viewNote
+    noteId <- newIORef Nothing
+
+    let this =
+            TaskWidget
+                { parent
+                , innerWidget
+                , textContent
+                , storage
+                , start
+                , end
+                , noteId
+                }
+
+    connect_ postpone QAbstractButton.clickedSignal $ postponeSlot this
+
+    pure this
+
+postponeSlot :: TaskWidget -> Bool -> IO ()
+postponeSlot this _checked = do
+    mNoteId <- readIORef this.noteId
+    case mNoteId of
+        Just noteId ->
+            runStorage this.storage (cmdPostpone noteId) >>= update this
+        Nothing -> pure ()
+
+reload :: TaskWidget -> NoteId -> IO ()
+reload this noteId = do
+    atomicWriteIORef this.noteId $ Just noteId
+    runStorage this.storage (loadNote noteId) >>= update this
+
+update :: TaskWidget -> EntityDoc Note -> IO ()
+update this noteDoc = do
+    Entity{entityVal} <- runStorage this.storage $ viewNote noteDoc
     let NoteView{note} = entityVal
     let Note{note_text, note_start, note_end} = note
     QLabel.setText this.textContent $ fromRgaM note_text