Skip to content

Commit 3d37290

Browse files
cblpcblp
committed
Add note tags
1 parent aa6337e commit 3d37290

3 files changed

Lines changed: 75 additions & 17 deletions

File tree

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

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@ import Graphics.UI.Qtah.Widgets.QDateTimeEdit qualified as QDateTimeEdit
1515
import Graphics.UI.Qtah.Widgets.QHBoxLayout (QHBoxLayout)
1616
import Graphics.UI.Qtah.Widgets.QPushButton (QPushButton)
1717
import Graphics.UI.Qtah.Widgets.QWidget qualified as QWidget
18-
import Named ((!))
18+
import Named (defaults, (!))
1919

2020
import FF.Qt (qDateFormat)
2121
import FF.Qt.EDSL (
@@ -39,8 +39,8 @@ new = do
3939
qDateEdit
4040
-- ! #calendarPopup True -- TODO bad styling on Mac
4141
! #displayFormat qDateFormat
42-
add <- qPushButton ! #objectName "set" ! #text "➕ Set"
43-
remove <- qPushButton ! #objectName "remove" ! #text "╳"
42+
add <- qPushButton ! #objectName "set" ! #text "➕ Set" ! defaults
43+
remove <- qPushButton ! #objectName "remove" ! #text "╳" ! defaults
4444
parent <-
4545
qHBoxLayout ! #objectName "[DateComponent]parent" ! #spacing 0 $
4646
[Widget $< date, Widget $< add, Widget $< remove]

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

Lines changed: 32 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,8 @@ import Graphics.UI.Qtah.Core.QDateTime qualified as QDateTime
1515
import Graphics.UI.Qtah.Core.QObject qualified as QObject
1616
import Graphics.UI.Qtah.Core.Types qualified as Qt
1717
import Graphics.UI.Qtah.Widgets.QAbstractButton qualified as QAbstractButton
18+
import Graphics.UI.Qtah.Widgets.QAction (QAction)
19+
import Graphics.UI.Qtah.Widgets.QAction qualified as QAction
1820
import Graphics.UI.Qtah.Widgets.QBoxLayout (QBoxLayoutPtr)
1921
import Graphics.UI.Qtah.Widgets.QBoxLayout qualified as QBoxLayout
2022
import Graphics.UI.Qtah.Widgets.QDateEdit (QDateEdit)
@@ -33,6 +35,8 @@ import Graphics.UI.Qtah.Widgets.QPushButton qualified as QPushButton
3335
import Graphics.UI.Qtah.Widgets.QScrollArea (QScrollArea)
3436
import Graphics.UI.Qtah.Widgets.QScrollArea qualified as QScrollArea
3537
import Graphics.UI.Qtah.Widgets.QSizePolicy (QSizePolicyPolicy)
38+
import Graphics.UI.Qtah.Widgets.QToolButton (QToolButton)
39+
import Graphics.UI.Qtah.Widgets.QToolButton qualified as QToolButton
3640
import Graphics.UI.Qtah.Widgets.QVBoxLayout qualified as QVBoxLayout
3741
import Graphics.UI.Qtah.Widgets.QWidget (QWidgetPtr, toQWidget)
3842
import Graphics.UI.Qtah.Widgets.QWidget qualified as QWidget
@@ -45,13 +49,19 @@ data QBoxLayoutItem
4549
data QFormLayoutItem
4650
= forall a. (QLayoutPtr a) => RowLayout (IO a)
4751
| forall a. (QWidgetPtr a) => RowWidget (IO a)
48-
| forall a. (QLayoutPtr a) => StringLayout String a
52+
| forall a. (QLayoutPtr a) => StringLayout String (IO a)
4953
| forall a. (QWidgetPtr a) => StringWidget String (IO a)
5054

5155
data Layout
5256
= QFormLayout [QFormLayoutItem]
5357
| QVBoxLayout [QBoxLayoutItem]
5458

59+
qAction :: "text" :? String -> IO QAction
60+
qAction (ArgF text) = do
61+
obj <- QAction.new
62+
for_ text $ QAction.setText obj
63+
pure obj
64+
5565
qDate :: Day -> IO QDate
5666
qDate day = toGc =<< QDate.newWithYmd (fromInteger y) m d
5767
where
@@ -89,7 +99,8 @@ qFrame (ArgF objectName) lo = do
8999
addRow form = \case
90100
RowLayout a -> QFormLayout.addRowLayout form . toQLayout =<< a
91101
RowWidget a -> QFormLayout.addRowWidget form . toQWidget =<< a
92-
StringLayout s a -> QFormLayout.addRowStringLayout form s $ toQLayout a
102+
StringLayout s a ->
103+
QFormLayout.addRowStringLayout form s . toQLayout =<< a
93104
StringWidget s a ->
94105
QFormLayout.addRowStringWidget form s . toQWidget =<< a
95106

@@ -146,10 +157,17 @@ qLabel
146157
for_ wordWrap $ QLabel.setWordWrap obj
147158
pure obj
148159

149-
qPushButton :: "objectName" :? String -> "text" :? String -> IO QPushButton
150-
qPushButton (ArgF objectName) (ArgF text) = do
160+
qPushButton ::
161+
"flat" :? Bool ->
162+
"objectName" :? String ->
163+
"styleSheet" :? String ->
164+
"text" :? String ->
165+
IO QPushButton
166+
qPushButton (ArgF flat) (ArgF objectName) (ArgF styleSheet) (ArgF text) = do
151167
obj <- QPushButton.new
168+
for_ flat $ QPushButton.setFlat obj
152169
for_ objectName $ QObject.setObjectName obj
170+
for_ styleSheet $ QWidget.setStyleSheet obj
153171
for_ text $ QAbstractButton.setText obj
154172
pure obj
155173

@@ -160,5 +178,15 @@ qScrollArea w = do
160178
QScrollArea.setWidgetResizable obj True
161179
pure obj
162180

181+
qToolButton ::
182+
"objectName" :? String ->
183+
"text" :? String ->
184+
IO QToolButton
185+
qToolButton (ArgF objectName) (ArgF text) = do
186+
obj <- QToolButton.new
187+
for_ objectName $ QObject.setObjectName obj
188+
for_ text $ QAbstractButton.setText obj
189+
pure obj
190+
163191
($<) :: (Applicative f) => (f a -> b) -> a -> b
164192
f $< x = f $ pure x

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

Lines changed: 40 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -10,17 +10,24 @@ module FF.Qt.TaskWidget (
1010
reload,
1111
) where
1212

13+
import Control.Monad (void, when)
1314
import Data.Foldable (for_)
1415
import Data.IORef (IORef, atomicWriteIORef, newIORef, readIORef)
1516
import Data.Maybe (fromMaybe)
17+
import Data.Text qualified as Text
1618
import Data.Time (defaultTimeLocale, formatTime)
19+
import Foreign.Hoppy.Runtime (delete, nullptr)
1720
import Graphics.UI.Qtah.Core.Types qualified as Qt
18-
import Graphics.UI.Qtah.Flags (Flags (enumToFlags))
1921
import Graphics.UI.Qtah.Signal (connect_)
2022
import Graphics.UI.Qtah.Widgets.QAbstractButton qualified as QAbstractButton
23+
import Graphics.UI.Qtah.Widgets.QBoxLayout qualified as QBoxLayout
2124
import Graphics.UI.Qtah.Widgets.QFrame (QFrame)
25+
import Graphics.UI.Qtah.Widgets.QHBoxLayout (QHBoxLayout)
2226
import Graphics.UI.Qtah.Widgets.QLabel (QLabel)
2327
import Graphics.UI.Qtah.Widgets.QLabel qualified as QLabel
28+
import Graphics.UI.Qtah.Widgets.QLayout (QLayoutPtr)
29+
import Graphics.UI.Qtah.Widgets.QLayout qualified as QLayout
30+
import Graphics.UI.Qtah.Widgets.QLayoutItem qualified as QLayoutItem
2431
import Named (defaults, (!))
2532
import RON.Storage.FS (runStorage)
2633
import RON.Storage.FS qualified as Storage
@@ -59,13 +66,15 @@ type OnTaskUpdated =
5966
IO ()
6067

6168
data TaskWidget = TaskWidget
62-
{ parent :: QFrame
69+
{ storage :: Storage.Handle
70+
, noteId :: IORef (Maybe NoteId)
71+
, onTaskUpdated :: OnTaskUpdated
72+
, -- UI
73+
parent :: QFrame
6374
, textContent :: QLabel
64-
, storage :: Storage.Handle
75+
, tags :: QHBoxLayout
6576
, start :: DateComponent
6677
, end :: DateComponent
67-
, noteId :: IORef (Maybe NoteId)
68-
, onTaskUpdated :: OnTaskUpdated
6978
, created :: QLabel
7079
, updated :: QLabel
7180
, recurring :: QLabel
@@ -82,20 +91,23 @@ new storage onTaskUpdated = do
8291
! #objectName "textContent"
8392
! #openExternalLinks True
8493
! #textFormat Qt.MarkdownText
85-
! #textInteractionFlags (enumToFlags Qt.TextBrowserInteraction)
94+
! #textInteractionFlags Qt.textBrowserInteraction
8695
! #wordWrap True
8796
! defaults
88-
postpone <- qPushButton ! #objectName "postpone" ! #text "Postpone"
89-
done <- qPushButton ! #objectName "postpone" ! #text "Done"
97+
tags <- qHBoxLayout ! #spacing 0 ! defaults $ []
98+
postpone <-
99+
qPushButton ! #objectName "postpone" ! #text "Postpone" ! defaults
100+
done <- qPushButton ! #objectName "done" ! #text "Done" ! defaults
90101
created <- qLabel ! #objectName "created" ! defaults
91102
updated <- qLabel ! #objectName "updated" ! defaults
92103
recurring <- qLabel ! #objectName "recurring" ! defaults
93104
parent <-
94105
qFrame ! #objectName "parent" $
95106
QFormLayout
96107
[ RowWidget $ qScrollArea textContent
97-
, StringLayout "Start:" start.parent
98-
, StringLayout "Deadline:" end.parent
108+
, StringLayout "Tags:" $< tags
109+
, StringLayout "Start:" $< start.parent
110+
, StringLayout "Deadline:" $< end.parent
99111
, StringWidget "Created:" $< created
100112
, StringWidget "Updated:" $< updated
101113
, StringWidget "Recurring:" $< recurring
@@ -132,6 +144,7 @@ update keepOpen this noteDoc = do
132144
entity <- runStorage this.storage $ viewNote noteDoc
133145
let Entity{entityVal = view@NoteView{note}} = entity
134146
QLabel.setText this.textContent $ fromRgaM note.note_text
147+
resetTags view.tags
135148
DateComponent.setDate this.start note.note_start
136149
DateComponent.setDate this.end note.note_end
137150
QLabel.setText this.created $
@@ -142,3 +155,20 @@ update keepOpen this noteDoc = do
142155
this.recurring
143156
if fromMaybe False note.note_recurring then "Yes" else "No"
144157
this.onTaskUpdated keepOpen entity
158+
where
159+
resetTags tags = do
160+
deleteChildrenWidgets this.tags
161+
for_ tags \tag ->
162+
void $
163+
QBoxLayout.addWidget this.tags
164+
=<< qPushButton ! #text (Text.unpack tag) ! defaults
165+
166+
deleteChildrenWidgets :: (QLayoutPtr layout) => layout -> IO ()
167+
deleteChildrenWidgets layout = loop
168+
where
169+
loop = do
170+
child <- QLayout.takeAt layout 0
171+
when (child /= nullptr) do
172+
delete =<< QLayoutItem.widget child
173+
delete child
174+
loop

0 commit comments

Comments
 (0)