Skip to content

Commit 2cb52b2

Browse files
committed
Fix QDateEdit alignment
1 parent 124a2e0 commit 2cb52b2

3 files changed

Lines changed: 45 additions & 45 deletions

File tree

ff-qtah/FF/Qt/DateComponent.hs

Lines changed: 32 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE BlockArguments #-}
12
{-# LANGUAGE NamedFieldPuns #-}
23
{-# LANGUAGE OverloadedLabels #-}
34
{-# LANGUAGE OverloadedRecordDot #-}
@@ -8,19 +9,21 @@ module FF.Qt.DateComponent (DateComponent (..), new, setDate) where
89
import Data.Time (Day, toGregorian)
910
import Foreign.Hoppy.Runtime (toGc)
1011
import Graphics.UI.Qtah.Core.QDate qualified as QDate
11-
import Graphics.UI.Qtah.Core.QObject qualified as QObject
1212
import Graphics.UI.Qtah.Widgets.QAbstractSpinBox qualified as QAbstractSpinBox
13-
import Graphics.UI.Qtah.Widgets.QBoxLayout qualified as QBoxLayout
1413
import Graphics.UI.Qtah.Widgets.QDateEdit (QDateEdit)
15-
import Graphics.UI.Qtah.Widgets.QDateEdit qualified as QDateEdit
1614
import Graphics.UI.Qtah.Widgets.QDateTimeEdit qualified as QDateTimeEdit
1715
import Graphics.UI.Qtah.Widgets.QHBoxLayout (QHBoxLayout)
1816
import Graphics.UI.Qtah.Widgets.QPushButton (QPushButton)
19-
import Graphics.UI.Qtah.Widgets.QPushButton qualified as QPushButton
2017
import Graphics.UI.Qtah.Widgets.QWidget qualified as QWidget
2118
import Named ((!))
2219

23-
import FF.Qt.EDSL (qHBoxLayout)
20+
import FF.Qt.EDSL (
21+
QBoxLayoutItem (Widget),
22+
qDateEdit,
23+
qHBoxLayout,
24+
qPushButton,
25+
($<),
26+
)
2427

2528
data DateComponent = DateComponent
2629
{ parent :: QHBoxLayout
@@ -31,43 +34,35 @@ data DateComponent = DateComponent
3134

3235
new :: IO DateComponent
3336
new = do
37+
date <-
38+
qDateEdit
39+
-- ! #calendarPopup True -- TODO bad styling on Mac
40+
! #displayFormat "ddd d MMM yyyy"
41+
add <- qPushButton ! #objectName "set" ! #text "➕ Set"
42+
remove <- qPushButton ! #objectName "remove" ! #text ""
3443
parent <-
35-
qHBoxLayout ! #objectName "[DateComponent]parent" ! #spacing 0 $ []
36-
37-
date <- QDateEdit.new
38-
QDateTimeEdit.setCalendarPopup date True
39-
QDateTimeEdit.setDisplayFormat date "ddd d MMM yyyy"
40-
QBoxLayout.addWidget parent date
41-
42-
add <- QPushButton.newWithText "➕ Set"
43-
QObject.setObjectName add "set"
44-
QWidget.setEnabled add False
45-
QBoxLayout.addWidget parent add
46-
47-
remove <- QPushButton.newWithText ""
48-
QObject.setObjectName remove "remove"
49-
QWidget.setEnabled remove False
50-
QBoxLayout.addWidget parent remove
51-
44+
qHBoxLayout ! #objectName "[DateComponent]parent" ! #spacing 0 $
45+
[Widget $< date, Widget $< add, Widget $< remove]
5246
let this = DateComponent{parent, date, add, remove}
5347
setEditable this False
5448
pure this
5549

5650
setEditable :: DateComponent -> Bool -> IO ()
57-
setEditable DateComponent{date} editable =
58-
QAbstractSpinBox.setReadOnly date $ not editable
51+
setEditable this editable = do
52+
QAbstractSpinBox.setReadOnly this.date $ not editable
53+
QWidget.setEnabled this.add editable
54+
QWidget.setEnabled this.remove editable
5955

6056
setDate :: DateComponent -> Maybe Day -> IO ()
61-
setDate this day =
62-
case day of
63-
Just (toGregorian -> (y, m, d)) -> do
64-
QWidget.show this.date
65-
QWidget.hide this.add
66-
QWidget.show this.remove
67-
qdate <- toGc =<< QDate.newWithYmd (fromInteger y) m d
68-
QDateTimeEdit.setDate this.date qdate
69-
Nothing -> do
70-
-- TODO replace with button "add date"
71-
QWidget.hide this.date
72-
QWidget.show this.add
73-
QWidget.hide this.remove
57+
setDate this day = do
58+
dayIsSet <-
59+
case day of
60+
Just (toGregorian -> (y, m, d)) -> do
61+
qdate <- toGc =<< QDate.newWithYmd (fromInteger y) m d
62+
QDateTimeEdit.setDate this.date qdate
63+
pure True
64+
Nothing ->
65+
pure False
66+
QWidget.setVisible this.date dayIsSet
67+
QWidget.setVisible this.remove dayIsSet
68+
QWidget.setVisible this.add $ not dayIsSet

ff-qtah/FF/Qt/EDSL.hs

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,9 @@ import Graphics.UI.Qtah.Core.Types qualified as Qt
1010
import Graphics.UI.Qtah.Widgets.QAbstractButton qualified as QAbstractButton
1111
import Graphics.UI.Qtah.Widgets.QBoxLayout (QBoxLayoutPtr)
1212
import Graphics.UI.Qtah.Widgets.QBoxLayout qualified as QBoxLayout
13+
import Graphics.UI.Qtah.Widgets.QDateEdit (QDateEdit)
14+
import Graphics.UI.Qtah.Widgets.QDateEdit qualified as QDateEdit
15+
import Graphics.UI.Qtah.Widgets.QDateTimeEdit qualified as QDateTimeEdit
1316
import Graphics.UI.Qtah.Widgets.QFormLayout qualified as QFormLayout
1417
import Graphics.UI.Qtah.Widgets.QFrame (QFrame)
1518
import Graphics.UI.Qtah.Widgets.QFrame qualified as QFrame
@@ -42,6 +45,12 @@ data Layout
4245
= QFormLayout [QFormLayoutItem]
4346
| QVBoxLayout [QBoxLayoutItem]
4447

48+
qDateEdit :: "displayFormat" :? String -> IO QDateEdit
49+
qDateEdit (ArgF displayFormat) = do
50+
obj <- QDateEdit.new
51+
for_ displayFormat $ QDateTimeEdit.setDisplayFormat obj
52+
pure obj
53+
4554
qFrame :: "objectName" :? String -> Layout -> IO QFrame
4655
qFrame (ArgF objectName) lo = do
4756
obj <- QFrame.new
@@ -132,3 +141,6 @@ qScrollArea w = do
132141
QScrollArea.setWidget obj w
133142
QScrollArea.setWidgetResizable obj True
134143
pure obj
144+
145+
($<) :: (Applicative f) => (f a -> b) -> a -> b
146+
f $< x = f $ pure x

ff-qtah/FF/Qt/TaskWidget.hs

Lines changed: 1 addition & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -13,12 +13,10 @@ 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
1716
import Graphics.UI.Qtah.Core.Types qualified as Qt
1817
import Graphics.UI.Qtah.Flags (Flags (enumToFlags))
1918
import Graphics.UI.Qtah.Signal (connect_)
2019
import Graphics.UI.Qtah.Widgets.QAbstractButton qualified as QAbstractButton
21-
import Graphics.UI.Qtah.Widgets.QDateEdit qualified as QDateEdit
2220
import Graphics.UI.Qtah.Widgets.QFrame (QFrame)
2321
import Graphics.UI.Qtah.Widgets.QLabel (QLabel)
2422
import Graphics.UI.Qtah.Widgets.QLabel qualified as QLabel
@@ -48,6 +46,7 @@ import FF.Qt.EDSL (
4846
qLabel,
4947
qPushButton,
5048
qScrollArea,
49+
($<),
5150
)
5251

5352
type OnTaskUpdated =
@@ -74,7 +73,6 @@ new storage onTaskUpdated = do
7473
start <- DateComponent.new
7574
end <- DateComponent.new
7675

77-
-- setup UI (TODO xDSL?)
7876
textContent <-
7977
qLabel
8078
! #alignment Qt.AlignTop
@@ -94,7 +92,6 @@ new storage onTaskUpdated = do
9492
QFormLayout
9593
[ RowWidget $ qScrollArea textContent
9694
, StringLayout "Start:" start.parent
97-
-- , StringWidget "TEST" QDateEdit.new
9895
, StringLayout "Deadline:" end.parent
9996
, StringWidget "Created:" $< created
10097
, StringWidget "Updated:" $< updated
@@ -103,17 +100,13 @@ new storage onTaskUpdated = do
103100
qHBoxLayout ! #objectName "actionsRow" ! defaults $
104101
[Widget $< postpone, Widget $< done, Stretch]
105102
]
106-
-- end setup UI
107103

108104
noteId <- newIORef Nothing
109105
let this = TaskWidget{..}
110106
connect_ postpone QAbstractButton.clickedSignal $ onPostponeClicked this
111107
connect_ done QAbstractButton.clickedSignal $ onDoneClicked this
112108
pure this
113109

114-
($<) :: (Applicative f) => (f a -> b) -> a -> b
115-
f $< x = f $ pure x
116-
117110
onPostponeClicked :: TaskWidget -> Bool -> IO ()
118111
onPostponeClicked this _checked = do
119112
mNoteId <- readIORef this.noteId

0 commit comments

Comments
 (0)