ff-qtah: Move dates and actions out of scrollable area in TaskWidget

Author: cblp

.hlint.yaml

@@ -1,2 +1,3 @@
 - error: {lhs: a $ b, rhs: a b, side: isRecUpdate b || isRecConstr b}
 - ignore: {name: Use camelCase}
+- ignore: {name: Use uncurry}

ff-qtah/FF/Qt/EDSL.hs

@@ -8,6 +8,7 @@ module FF.Qt.EDSL where
 
 import Data.Foldable (for_)
 import Graphics.UI.Qtah.Core.Types qualified as Qt
+import Graphics.UI.Qtah.Widgets.QBoxLayout (QBoxLayoutPtr)
 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)
@@ -20,9 +21,10 @@ import Graphics.UI.Qtah.Widgets.QLayout (QLayoutPtr (toQLayout))
 import Graphics.UI.Qtah.Widgets.QScrollArea (QScrollArea)
 import Graphics.UI.Qtah.Widgets.QScrollArea qualified as QScrollArea
 import Graphics.UI.Qtah.Widgets.QSizePolicy (QSizePolicyPolicy)
+import Graphics.UI.Qtah.Widgets.QVBoxLayout qualified as QVBoxLayout
 import Graphics.UI.Qtah.Widgets.QWidget (QWidgetPtr, toQWidget)
 import Graphics.UI.Qtah.Widgets.QWidget qualified as QWidget
-import Named (arg, (:!))
+import Named (arg, argF, (:!), (:?))
 
 data QBoxLayoutItem
     = Stretch
@@ -33,22 +35,32 @@ data QFormLayoutItem
     | forall a. (QWidgetPtr a) => RowWidget (IO a)
     | forall a. (QLayoutPtr a) => StringLayout String a
 
--- newtype Layout = QFormLayout [QFormLayoutItem]
+data Layout
+    = QFormLayout [QFormLayoutItem]
+    | QVBoxLayout [QBoxLayoutItem]
 
-qFrame :: [QFormLayoutItem] -> IO QFrame
-qFrame items = do
+qFrame :: Layout -> IO QFrame
+qFrame lo = do
     obj <- QFrame.new
-    -- case lo of
-    --     QFormLayout items -> do
-    form <- QFormLayout.newWithParent obj
-    for_ items $ addRow form
+    case lo of
+        QFormLayout items -> do
+            form <- QFormLayout.newWithParent obj
+            for_ items $ addRow form
+        QVBoxLayout items -> do
+            box <- QVBoxLayout.newWithParent obj
+            for_ items $ addBoxLayoutItem box
     pure obj
   where
     addRow form = \case
         RowLayout io -> QFormLayout.addRowLayout form . toQLayout =<< io
         RowWidget io -> QFormLayout.addRowWidget form . toQWidget =<< io
         StringLayout s c -> QFormLayout.addRowStringLayout form s $ toQLayout c
 
+addBoxLayoutItem :: (QBoxLayoutPtr p) => p -> QBoxLayoutItem -> IO ()
+addBoxLayoutItem box = \case
+    Stretch -> QBoxLayout.addStretch box
+    Widget io -> QBoxLayout.addWidget box =<< io
+
 hline :: IO QFrame
 hline = do
     obj <- QFrame.new
@@ -58,31 +70,29 @@ hline = do
 qHBoxLayout :: [QBoxLayoutItem] -> IO QHBoxLayout
 qHBoxLayout items = do
     obj <- QHBoxLayout.new
-    for_ items \case
-        Stretch -> QBoxLayout.addStretch obj
-        Widget io -> QBoxLayout.addWidget obj =<< io
+    for_ items $ addBoxLayoutItem obj
     pure obj
 
 qLabel ::
     (Qt.IsQtTextInteractionFlags textInteractionFlags) =>
     "alignment" :! Qt.QtAlignmentFlag ->
     "openExternalLinks" :! Bool ->
-    "sizePolicy" :! (QSizePolicyPolicy, QSizePolicyPolicy) ->
+    "sizePolicy" :? (QSizePolicyPolicy, QSizePolicyPolicy) ->
     "textInteractionFlags" :! textInteractionFlags ->
     "textFormat" :! Qt.QtTextFormat ->
     "wordWrap" :! Bool ->
     IO QLabel
 qLabel
     (arg #alignment -> a)
     (arg #openExternalLinks -> oel)
-    (arg #sizePolicy -> (sp1, sp2))
+    (argF #sizePolicy -> sp)
     (arg #textInteractionFlags -> tif)
     (arg #textFormat -> tf)
     (arg #wordWrap -> ww) = do
         obj <- QLabel.new
         QLabel.setAlignment obj a
         QLabel.setOpenExternalLinks obj oel
-        QWidget.setSizePolicyRaw obj sp1 sp2
+        for_ sp \(sp1, sp2) -> QWidget.setSizePolicyRaw obj sp1 sp2
         QLabel.setTextInteractionFlags obj tif
         QLabel.setTextFormat obj tf
         QLabel.setWordWrap obj ww
@@ -92,4 +102,5 @@ qScrollArea :: (QWidgetPtr widget) => widget -> IO QScrollArea
 qScrollArea w = do
     obj <- QScrollArea.new
     QScrollArea.setWidget obj w
+    QScrollArea.setWidgetResizable obj True
     pure obj

ff-qtah/FF/Qt/TaskWidget.hs

@@ -18,12 +18,7 @@ import Graphics.UI.Qtah.Widgets.QFrame (QFrame)
 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.QSizePolicy (
-    QSizePolicyPolicy (..),
- )
-import Graphics.UI.Qtah.Widgets.QWidget qualified as QWidget
-import Named ((!))
+import Named (defaults, (!))
 import RON.Storage.FS (runStorage)
 import RON.Storage.FS qualified as Storage
 
@@ -41,9 +36,9 @@ import FF.Types (
 import FF.Qt.DateComponent (DateComponent)
 import FF.Qt.DateComponent qualified as DateComponent
 import FF.Qt.EDSL (
+    Layout (..),
     QBoxLayoutItem (..),
     QFormLayoutItem (..),
-    hline,
     qFrame,
     qHBoxLayout,
     qLabel,
@@ -57,9 +52,7 @@ type OnTaskUpdated =
     IO ()
 
 data TaskWidget = TaskWidget
-    { parent :: QScrollArea
-    , innerWidget :: QFrame
-    -- ^ the main widget inside the scroll area
+    { parent :: QFrame
     , textContent :: QLabel
     , storage :: Storage.Handle
     , start :: DateComponent
@@ -78,20 +71,18 @@ new storage onTaskUpdated = do
         qLabel
             ! #alignment Qt.AlignTop
             ! #openExternalLinks True
-            ! #sizePolicy (MinimumExpanding, MinimumExpanding)
             ! #textInteractionFlags Qt.TextBrowserInteraction
             ! #textFormat Qt.MarkdownText
             ! #wordWrap True
+            ! defaults
     postpone <- QPushButton.newWithText "Postpone"
-    innerWidget <-
-        qFrame
-            [ RowWidget $ pure textContent
-            , RowWidget hline
+    parent <-
+        qFrame . QFormLayout $
+            [ RowWidget $ qScrollArea textContent
             , StringLayout "Start:" start.parent
             , StringLayout "Deadline:" end.parent
             , RowLayout $ qHBoxLayout [Widget $ pure postpone, Stretch]
             ]
-    parent <- qScrollArea innerWidget
     -- end setup UI
 
     noteId <- newIORef Nothing
@@ -121,5 +112,4 @@ update keepOpen this noteDoc = do
     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 keepOpen entity