Skip to content

Commit 59d5813

Browse files
cblpcblp
committed
ff-qtah: Add eDSL
1 parent 90c7eb3 commit 59d5813

File tree

3 files changed

+130
-36
lines changed

3 files changed

+130
-36
lines changed

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

Lines changed: 95 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,95 @@
1+
{-# LANGUAGE BlockArguments #-}
2+
{-# LANGUAGE DataKinds #-}
3+
{-# LANGUAGE LambdaCase #-}
4+
{-# LANGUAGE OverloadedLabels #-}
5+
{-# LANGUAGE ViewPatterns #-}
6+
7+
module FF.Qt.EDSL where
8+
9+
import Data.Foldable (for_)
10+
import Graphics.UI.Qtah.Core.Types qualified as Qt
11+
import Graphics.UI.Qtah.Widgets.QBoxLayout qualified as QBoxLayout
12+
import Graphics.UI.Qtah.Widgets.QFormLayout qualified as QFormLayout
13+
import Graphics.UI.Qtah.Widgets.QFrame (QFrame)
14+
import Graphics.UI.Qtah.Widgets.QFrame qualified as QFrame
15+
import Graphics.UI.Qtah.Widgets.QHBoxLayout (QHBoxLayout)
16+
import Graphics.UI.Qtah.Widgets.QHBoxLayout qualified as QHBoxLayout
17+
import Graphics.UI.Qtah.Widgets.QLabel (QLabel)
18+
import Graphics.UI.Qtah.Widgets.QLabel qualified as QLabel
19+
import Graphics.UI.Qtah.Widgets.QLayout (QLayoutPtr (toQLayout))
20+
import Graphics.UI.Qtah.Widgets.QScrollArea (QScrollArea)
21+
import Graphics.UI.Qtah.Widgets.QScrollArea qualified as QScrollArea
22+
import Graphics.UI.Qtah.Widgets.QSizePolicy (QSizePolicyPolicy)
23+
import Graphics.UI.Qtah.Widgets.QWidget (QWidgetPtr, toQWidget)
24+
import Graphics.UI.Qtah.Widgets.QWidget qualified as QWidget
25+
import Named (arg, (:!))
26+
27+
data QBoxLayoutItem
28+
= Stretch
29+
| forall a. (QWidgetPtr a) => Widget (IO a)
30+
31+
data QFormLayoutItem
32+
= forall a. (QLayoutPtr a) => RowLayout (IO a)
33+
| forall a. (QWidgetPtr a) => RowWidget (IO a)
34+
| forall a. (QLayoutPtr a) => StringLayout String a
35+
36+
-- newtype Layout = QFormLayout [QFormLayoutItem]
37+
38+
qFrame :: [QFormLayoutItem] -> IO QFrame
39+
qFrame items = do
40+
obj <- QFrame.new
41+
-- case lo of
42+
-- QFormLayout items -> do
43+
form <- QFormLayout.newWithParent obj
44+
for_ items $ addRow form
45+
pure obj
46+
where
47+
addRow form = \case
48+
RowLayout io -> QFormLayout.addRowLayout form . toQLayout =<< io
49+
RowWidget io -> QFormLayout.addRowWidget form . toQWidget =<< io
50+
StringLayout s c -> QFormLayout.addRowStringLayout form s $ toQLayout c
51+
52+
hline :: IO QFrame
53+
hline = do
54+
obj <- QFrame.new
55+
QFrame.setFrameShape obj QFrame.HLine
56+
pure obj
57+
58+
qHBoxLayout :: [QBoxLayoutItem] -> IO QHBoxLayout
59+
qHBoxLayout items = do
60+
obj <- QHBoxLayout.new
61+
for_ items \case
62+
Stretch -> QBoxLayout.addStretch obj
63+
Widget io -> QBoxLayout.addWidget obj =<< io
64+
pure obj
65+
66+
qLabel ::
67+
(Qt.IsQtTextInteractionFlags textInteractionFlags) =>
68+
"alignment" :! Qt.QtAlignmentFlag ->
69+
"openExternalLinks" :! Bool ->
70+
"sizePolicy" :! (QSizePolicyPolicy, QSizePolicyPolicy) ->
71+
"textInteractionFlags" :! textInteractionFlags ->
72+
"textFormat" :! Qt.QtTextFormat ->
73+
"wordWrap" :! Bool ->
74+
IO QLabel
75+
qLabel
76+
(arg #alignment -> a)
77+
(arg #openExternalLinks -> oel)
78+
(arg #sizePolicy -> (sp1, sp2))
79+
(arg #textInteractionFlags -> tif)
80+
(arg #textFormat -> tf)
81+
(arg #wordWrap -> ww) = do
82+
obj <- QLabel.new
83+
QLabel.setAlignment obj a
84+
QLabel.setOpenExternalLinks obj oel
85+
QWidget.setSizePolicyRaw obj sp1 sp2
86+
QLabel.setTextInteractionFlags obj tif
87+
QLabel.setTextFormat obj tf
88+
QLabel.setWordWrap obj ww
89+
pure obj
90+
91+
qScrollArea :: (QWidgetPtr widget) => widget -> IO QScrollArea
92+
qScrollArea w = do
93+
obj <- QScrollArea.new
94+
QScrollArea.setWidget obj w
95+
pure obj

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

Lines changed: 33 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
{-# LANGUAGE BlockArguments #-}
22
{-# LANGUAGE NamedFieldPuns #-}
3+
{-# LANGUAGE OverloadedLabels #-}
34
{-# LANGUAGE OverloadedRecordDot #-}
45
{-# LANGUAGE RecordWildCards #-}
56

@@ -10,23 +11,19 @@ module FF.Qt.TaskWidget (
1011
) where
1112

1213
import Data.IORef (IORef, atomicWriteIORef, newIORef, readIORef)
13-
import Foreign.Hoppy.Runtime (toGc)
1414
import Graphics.UI.Qtah.Core.Types qualified as Qt
1515
import Graphics.UI.Qtah.Signal (connect_)
1616
import Graphics.UI.Qtah.Widgets.QAbstractButton qualified as QAbstractButton
17-
import Graphics.UI.Qtah.Widgets.QBoxLayout qualified as QBoxLayout
18-
import Graphics.UI.Qtah.Widgets.QFormLayout qualified as QFormLayout
1917
import Graphics.UI.Qtah.Widgets.QFrame (QFrame)
20-
import Graphics.UI.Qtah.Widgets.QFrame qualified as QFrame
21-
import Graphics.UI.Qtah.Widgets.QHBoxLayout qualified as QHBoxLayout
2218
import Graphics.UI.Qtah.Widgets.QLabel (QLabel)
2319
import Graphics.UI.Qtah.Widgets.QLabel qualified as QLabel
2420
import Graphics.UI.Qtah.Widgets.QPushButton qualified as QPushButton
2521
import Graphics.UI.Qtah.Widgets.QScrollArea (QScrollArea)
26-
import Graphics.UI.Qtah.Widgets.QScrollArea qualified as QScrollArea
27-
import Graphics.UI.Qtah.Widgets.QSizePolicy (QSizePolicy, QSizePolicyPolicy)
28-
import Graphics.UI.Qtah.Widgets.QSizePolicy qualified as QSizePolicy
22+
import Graphics.UI.Qtah.Widgets.QSizePolicy (
23+
QSizePolicyPolicy (..),
24+
)
2925
import Graphics.UI.Qtah.Widgets.QWidget qualified as QWidget
26+
import Named ((!))
3027
import RON.Storage.FS (runStorage)
3128
import RON.Storage.FS qualified as Storage
3229

@@ -43,6 +40,15 @@ import FF.Types (
4340

4441
import FF.Qt.DateComponent (DateComponent)
4542
import FF.Qt.DateComponent qualified as DateComponent
43+
import FF.Qt.EDSL (
44+
QBoxLayoutItem (..),
45+
QFormLayoutItem (..),
46+
hline,
47+
qFrame,
48+
qHBoxLayout,
49+
qLabel,
50+
qScrollArea,
51+
)
4652

4753
type OnTaskUpdated =
4854
-- | Keep open task view (e.g. on postpone)
@@ -67,31 +73,26 @@ new storage onTaskUpdated = do
6773
start <- DateComponent.new
6874
end <- DateComponent.new
6975

70-
-- TODO generate this from .ui
71-
parent <- QScrollArea.new
72-
innerWidget <- QFrame.new
73-
QScrollArea.setWidget parent innerWidget
74-
textContent <- QLabel.new
75-
QWidget.setSizePolicy textContent
76-
=<< makeSimpleSizePolicy QSizePolicy.MinimumExpanding
77-
QLabel.setAlignment textContent Qt.AlignTop
78-
QLabel.setWordWrap textContent True
79-
QLabel.setTextFormat textContent Qt.MarkdownText
80-
QLabel.setTextInteractionFlags textContent Qt.TextBrowserInteraction
81-
QLabel.setOpenExternalLinks textContent True
82-
hline <- QFrame.new
83-
QFrame.setFrameShape hline QFrame.HLine
84-
form <- QFormLayout.newWithParent innerWidget
85-
QFormLayout.addRowWidget form textContent
86-
QFormLayout.addRowWidget form hline
87-
QFormLayout.addRowStringLayout form "Start:" start.parent
88-
QFormLayout.addRowStringLayout form "Deadline:" end.parent
76+
-- setup UI (TODO xDSL?)
77+
textContent <-
78+
qLabel
79+
! #alignment Qt.AlignTop
80+
! #openExternalLinks True
81+
! #sizePolicy (MinimumExpanding, MinimumExpanding)
82+
! #textInteractionFlags Qt.TextBrowserInteraction
83+
! #textFormat Qt.MarkdownText
84+
! #wordWrap True
8985
postpone <- QPushButton.newWithText "Postpone"
90-
actions <- QHBoxLayout.new
91-
QBoxLayout.addWidget actions postpone
92-
QBoxLayout.addStretch actions
93-
QFormLayout.addRowLayout form actions
94-
-- end generated
86+
innerWidget <-
87+
qFrame
88+
[ RowWidget $ pure textContent
89+
, RowWidget hline
90+
, StringLayout "Start:" start.parent
91+
, StringLayout "Deadline:" end.parent
92+
, RowLayout $ qHBoxLayout [Widget $ pure postpone, Stretch]
93+
]
94+
parent <- qScrollArea innerWidget
95+
-- end setup UI
9596

9697
noteId <- newIORef Nothing
9798
let this = TaskWidget{..}
@@ -122,7 +123,3 @@ update keepOpen this noteDoc = do
122123
DateComponent.setDate this.end note_end
123124
QWidget.adjustSize this.innerWidget
124125
this.onTaskUpdated keepOpen entity
125-
126-
makeSimpleSizePolicy :: QSizePolicyPolicy -> IO QSizePolicy
127-
makeSimpleSizePolicy policy =
128-
toGc =<< QSizePolicy.newWithOptions policy policy QSizePolicy.DefaultType

‎ff-qtah/ff-qtah.cabal‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,7 @@ executable ff-qtah
1515
, bytestring
1616
, containers
1717
, hoppy-runtime
18+
, named
1819
, qtah
1920
, stm
2021
, text
@@ -31,6 +32,7 @@ executable ff-qtah
3132
other-modules:
3233
FF.Qt
3334
FF.Qt.DateComponent
35+
FF.Qt.EDSL
3436
FF.Qt.MainWindow
3537
FF.Qt.TaskListWidget
3638
FF.Qt.TaskWidget

0 commit comments

Comments
 (0)