Skip to content

Commit 124a2e0

Browse files
cblpcblp
committed
Add objectNames to debug
1 parent e803f47 commit 124a2e0

4 files changed

Lines changed: 65 additions & 43 deletions

File tree

‎ff-qtah/FF/Qt.hs‎

Lines changed: 1 addition & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -1,29 +1,13 @@
11
{-# LANGUAGE BlockArguments #-}
22

3-
module FF.Qt (printChildrenTree, repeatInGuiThreadWheneverIdle, runInGuiThreadWhenReady) where
3+
module FF.Qt (repeatInGuiThreadWheneverIdle, runInGuiThreadWhenReady) where
44

55
import Control.Concurrent.MVar (MVar, tryTakeMVar)
66
import Data.Foldable (for_)
7-
import Graphics.UI.Qtah.Core.QMetaClassInfo qualified as QMetaClassInfo
8-
import Graphics.UI.Qtah.Core.QMetaObject qualified as QMetaObject
9-
import Graphics.UI.Qtah.Core.QObject (QObjectPtr, toQObject)
107
import Graphics.UI.Qtah.Core.QObject qualified as QObject
118
import Graphics.UI.Qtah.Core.QTimer qualified as QTimer
129
import Graphics.UI.Qtah.Signal (connect_)
1310

14-
printChildrenTree :: (QObjectPtr object) => object -> IO ()
15-
printChildrenTree = go 0 . toQObject
16-
where
17-
go level object = do
18-
name <- QObject.objectName object
19-
meta <- QObject.metaObject object
20-
classInfo <- QMetaObject.classInfo meta 0
21-
className <- QMetaClassInfo.name classInfo
22-
putStrLn . unwords $
23-
replicate level "| " ++ [show name, ":", show className]
24-
children <- QObject.children object
25-
for_ children $ go (level + 1)
26-
2711
-- | Repaeat some code in the GUI thread, when it is idle
2812
repeatInGuiThreadWheneverIdle :: IO () -> IO ()
2913
repeatInGuiThreadWheneverIdle action = do

‎ff-qtah/FF/Qt/DateComponent.hs‎

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE NamedFieldPuns #-}
2+
{-# LANGUAGE OverloadedLabels #-}
23
{-# LANGUAGE OverloadedRecordDot #-}
34
{-# LANGUAGE ViewPatterns #-}
45

@@ -7,16 +8,19 @@ module FF.Qt.DateComponent (DateComponent (..), new, setDate) where
78
import Data.Time (Day, toGregorian)
89
import Foreign.Hoppy.Runtime (toGc)
910
import Graphics.UI.Qtah.Core.QDate qualified as QDate
11+
import Graphics.UI.Qtah.Core.QObject qualified as QObject
1012
import Graphics.UI.Qtah.Widgets.QAbstractSpinBox qualified as QAbstractSpinBox
1113
import Graphics.UI.Qtah.Widgets.QBoxLayout qualified as QBoxLayout
1214
import Graphics.UI.Qtah.Widgets.QDateEdit (QDateEdit)
1315
import Graphics.UI.Qtah.Widgets.QDateEdit qualified as QDateEdit
1416
import Graphics.UI.Qtah.Widgets.QDateTimeEdit qualified as QDateTimeEdit
1517
import Graphics.UI.Qtah.Widgets.QHBoxLayout (QHBoxLayout)
16-
import Graphics.UI.Qtah.Widgets.QHBoxLayout qualified as QHBoxLayout
1718
import Graphics.UI.Qtah.Widgets.QPushButton (QPushButton)
1819
import Graphics.UI.Qtah.Widgets.QPushButton qualified as QPushButton
1920
import Graphics.UI.Qtah.Widgets.QWidget qualified as QWidget
21+
import Named ((!))
22+
23+
import FF.Qt.EDSL (qHBoxLayout)
2024

2125
data DateComponent = DateComponent
2226
{ parent :: QHBoxLayout
@@ -27,18 +31,21 @@ data DateComponent = DateComponent
2731

2832
new :: IO DateComponent
2933
new = do
30-
parent <- QHBoxLayout.new
34+
parent <-
35+
qHBoxLayout ! #objectName "[DateComponent]parent" ! #spacing 0 $ []
3136

3237
date <- QDateEdit.new
3338
QDateTimeEdit.setCalendarPopup date True
3439
QDateTimeEdit.setDisplayFormat date "ddd d MMM yyyy"
3540
QBoxLayout.addWidget parent date
3641

3742
add <- QPushButton.newWithText "➕ Set"
43+
QObject.setObjectName add "set"
3844
QWidget.setEnabled add False
3945
QBoxLayout.addWidget parent add
4046

4147
remove <- QPushButton.newWithText "╳"
48+
QObject.setObjectName remove "remove"
4249
QWidget.setEnabled remove False
4350
QBoxLayout.addWidget parent remove
4451

‎ff-qtah/FF/Qt/EDSL.hs‎

Lines changed: 31 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,9 @@
55
module FF.Qt.EDSL where
66

77
import Data.Foldable (for_)
8+
import Graphics.UI.Qtah.Core.QObject qualified as QObject
89
import Graphics.UI.Qtah.Core.Types qualified as Qt
10+
import Graphics.UI.Qtah.Widgets.QAbstractButton qualified as QAbstractButton
911
import Graphics.UI.Qtah.Widgets.QBoxLayout (QBoxLayoutPtr)
1012
import Graphics.UI.Qtah.Widgets.QBoxLayout qualified as QBoxLayout
1113
import Graphics.UI.Qtah.Widgets.QFormLayout qualified as QFormLayout
@@ -15,7 +17,9 @@ import Graphics.UI.Qtah.Widgets.QHBoxLayout (QHBoxLayout)
1517
import Graphics.UI.Qtah.Widgets.QHBoxLayout qualified as QHBoxLayout
1618
import Graphics.UI.Qtah.Widgets.QLabel (QLabel)
1719
import Graphics.UI.Qtah.Widgets.QLabel qualified as QLabel
18-
import Graphics.UI.Qtah.Widgets.QLayout (QLayoutPtr (toQLayout))
20+
import Graphics.UI.Qtah.Widgets.QLayout (QLayoutPtr, toQLayout)
21+
import Graphics.UI.Qtah.Widgets.QPushButton (QPushButton)
22+
import Graphics.UI.Qtah.Widgets.QPushButton qualified as QPushButton
1923
import Graphics.UI.Qtah.Widgets.QScrollArea (QScrollArea)
2024
import Graphics.UI.Qtah.Widgets.QScrollArea qualified as QScrollArea
2125
import Graphics.UI.Qtah.Widgets.QSizePolicy (QSizePolicyPolicy)
@@ -38,15 +42,20 @@ data Layout
3842
= QFormLayout [QFormLayoutItem]
3943
| QVBoxLayout [QBoxLayoutItem]
4044

41-
qFrame :: Layout -> IO QFrame
42-
qFrame lo = do
45+
qFrame :: "objectName" :? String -> Layout -> IO QFrame
46+
qFrame (ArgF objectName) lo = do
4347
obj <- QFrame.new
48+
for_ objectName $ QObject.setObjectName obj
4449
case lo of
4550
QFormLayout items -> do
4651
form <- QFormLayout.newWithParent obj
52+
for_ objectName \oname ->
53+
QObject.setObjectName form $ oname <> ".form"
4754
for_ items $ addRow form
4855
QVBoxLayout items -> do
4956
box <- QVBoxLayout.newWithParent obj
57+
for_ objectName \oname ->
58+
QObject.setObjectName box $ oname <> ".box"
5059
for_ items $ addBoxLayoutItem box
5160
pure obj
5261
where
@@ -68,24 +77,31 @@ hline = do
6877
QFrame.setFrameShape obj QFrame.HLine
6978
pure obj
7079

71-
qHBoxLayout :: [QBoxLayoutItem] -> IO QHBoxLayout
72-
qHBoxLayout items = do
80+
qHBoxLayout ::
81+
"objectName" :? String ->
82+
"spacing" :? Int ->
83+
[QBoxLayoutItem] ->
84+
IO QHBoxLayout
85+
qHBoxLayout (ArgF objectName) (ArgF spacing) items = do
7386
obj <- QHBoxLayout.new
87+
for_ objectName $ QObject.setObjectName obj
88+
for_ spacing $ QBoxLayout.setSpacing obj
7489
for_ items $ addBoxLayoutItem obj
7590
pure obj
7691

7792
qLabel ::
78-
(Qt.IsQtTextInteractionFlags textInteractionFlags) =>
7993
"alignment" :? Qt.QtAlignmentFlag ->
94+
"objectName" :? String ->
8095
"openExternalLinks" :? Bool ->
8196
"sizePolicy" :? (QSizePolicyPolicy, QSizePolicyPolicy) ->
8297
"text" :? String ->
8398
"textFormat" :? Qt.QtTextFormat ->
84-
"textInteractionFlags" :? textInteractionFlags ->
99+
"textInteractionFlags" :? Qt.QtTextInteractionFlags ->
85100
"wordWrap" :? Bool ->
86101
IO QLabel
87102
qLabel
88103
(ArgF alignment)
104+
(ArgF objectName)
89105
(ArgF openExternalLinks)
90106
(ArgF sizePolicy)
91107
(ArgF text)
@@ -94,6 +110,7 @@ qLabel
94110
(ArgF wordWrap) = do
95111
obj <- QLabel.new
96112
for_ alignment $ QLabel.setAlignment obj
113+
for_ objectName $ QObject.setObjectName obj
97114
for_ openExternalLinks $ QLabel.setOpenExternalLinks obj
98115
for_ sizePolicy \(sp1, sp2) -> QWidget.setSizePolicyRaw obj sp1 sp2
99116
for_ text $ QLabel.setText obj
@@ -102,6 +119,13 @@ qLabel
102119
for_ wordWrap $ QLabel.setWordWrap obj
103120
pure obj
104121

122+
qPushButton :: "objectName" :? String -> "text" :? String -> IO QPushButton
123+
qPushButton (ArgF objectName) (ArgF text) = do
124+
obj <- QPushButton.new
125+
for_ objectName $ QObject.setObjectName obj
126+
for_ text $ QAbstractButton.setText obj
127+
pure obj
128+
105129
qScrollArea :: (QWidgetPtr widget) => widget -> IO QScrollArea
106130
qScrollArea w = do
107131
obj <- QScrollArea.new

‎ff-qtah/FF/Qt/TaskWidget.hs‎

Lines changed: 24 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -13,13 +13,15 @@ module FF.Qt.TaskWidget (
1313
import Data.Foldable (for_)
1414
import Data.IORef (IORef, atomicWriteIORef, newIORef, readIORef)
1515
import Data.Maybe (fromMaybe)
16+
import Graphics.UI.Qtah.Core.QObject qualified as QObject
1617
import Graphics.UI.Qtah.Core.Types qualified as Qt
18+
import Graphics.UI.Qtah.Flags (Flags (enumToFlags))
1719
import Graphics.UI.Qtah.Signal (connect_)
1820
import Graphics.UI.Qtah.Widgets.QAbstractButton qualified as QAbstractButton
21+
import Graphics.UI.Qtah.Widgets.QDateEdit qualified as QDateEdit
1922
import Graphics.UI.Qtah.Widgets.QFrame (QFrame)
2023
import Graphics.UI.Qtah.Widgets.QLabel (QLabel)
2124
import Graphics.UI.Qtah.Widgets.QLabel qualified as QLabel
22-
import Graphics.UI.Qtah.Widgets.QPushButton qualified as QPushButton
2325
import Named (defaults, (!))
2426
import RON.Storage.FS (runStorage)
2527
import RON.Storage.FS qualified as Storage
@@ -44,6 +46,7 @@ import FF.Qt.EDSL (
4446
qFrame,
4547
qHBoxLayout,
4648
qLabel,
49+
qPushButton,
4750
qScrollArea,
4851
)
4952

@@ -75,27 +78,31 @@ new storage onTaskUpdated = do
7578
textContent <-
7679
qLabel
7780
! #alignment Qt.AlignTop
81+
! #objectName "textContent"
7882
! #openExternalLinks True
7983
! #textFormat Qt.MarkdownText
80-
! #textInteractionFlags Qt.TextBrowserInteraction
84+
! #textInteractionFlags (enumToFlags Qt.TextBrowserInteraction)
8185
! #wordWrap True
8286
! defaults
83-
postpone <- QPushButton.newWithText "Postpone"
84-
done <- QPushButton.newWithText "Done"
85-
created <- QLabel.new
86-
updated <- QLabel.new
87-
recurring <- QLabel.new
87+
postpone <- qPushButton ! #objectName "postpone" ! #text "Postpone"
88+
done <- qPushButton ! #objectName "postpone" ! #text "Done"
89+
created <- qLabel ! #objectName "created" ! defaults
90+
updated <- qLabel ! #objectName "updated" ! defaults
91+
recurring <- qLabel ! #objectName "recurring" ! defaults
8892
parent <-
89-
qFrame . QFormLayout $
90-
[ RowWidget $ qScrollArea textContent
91-
, StringLayout "Start:" start.parent
92-
, StringLayout "Deadline:" end.parent
93-
, StringWidget "Created:" $< created
94-
, StringWidget "Updated:" $< updated
95-
, StringWidget "Recurring:" $< recurring
96-
, RowLayout . qHBoxLayout $
97-
[Widget $< postpone, Widget $< done, Stretch]
98-
]
93+
qFrame ! #objectName "parent" $
94+
QFormLayout
95+
[ RowWidget $ qScrollArea textContent
96+
, StringLayout "Start:" start.parent
97+
-- , StringWidget "TEST" QDateEdit.new
98+
, StringLayout "Deadline:" end.parent
99+
, StringWidget "Created:" $< created
100+
, StringWidget "Updated:" $< updated
101+
, StringWidget "Recurring:" $< recurring
102+
, RowLayout $
103+
qHBoxLayout ! #objectName "actionsRow" ! defaults $
104+
[Widget $< postpone, Widget $< done, Stretch]
105+
]
99106
-- end setup UI
100107

101108
noteId <- newIORef Nothing

0 commit comments

Comments
 (0)