Skip to content

Commit 1c864b7

Browse files
cblpcblp
committed
Restore ff-qtah
1 parent 7acaed7 commit 1c864b7

18 files changed

Lines changed: 566 additions & 382 deletions

‎ff-brick/Main.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
11
{-# LANGUAGE BlockArguments #-}
2+
{-# LANGUAGE DisambiguateRecordFields #-}
23
{-# LANGUAGE ImportQualifiedPost #-}
4+
{-# LANGUAGE LambdaCase #-}
35
{-# LANGUAGE OverloadedLabels #-}
46
{-# LANGUAGE OverloadedRecordDot #-}
57
{-# LANGUAGE OverloadedStrings #-}

‎ff-brick/ff-brick.cabal‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,6 @@ executable ff-brick
1818

1919
-- project
2020
build-depends: ff-core
21-
default-language: GHC2024
21+
default-language: GHC2021
2222
ghc-options: -threaded
2323
main-is: Main.hs

‎ff-core/ff-core.cabal‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,7 @@ library
4242
, ron-schema
4343
, ron-storage
4444

45-
default-language: GHC2024
45+
default-language: GHC2021
4646
exposed-modules:
4747
FF
4848
FF.CLI
@@ -62,6 +62,6 @@ test-suite features
6262
, blaze-html
6363
, interpolate
6464

65-
default-language: GHC2024
65+
default-language: GHC2021
6666
main-is: Features.hs
6767
type: exitcode-stdio-1.0

‎ff-core/lib/FF/Config.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
{-# LANGUAGE BlockArguments #-}
22
{-# LANGUAGE ImportQualifiedPost #-}
3+
{-# LANGUAGE LambdaCase #-}
34
{-# LANGUAGE OverloadedStrings #-}
45
{-# LANGUAGE RecordWildCards #-}
56
{-# LANGUAGE TemplateHaskell #-}

‎ff-core/lib/FF/Upgrade.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE BlockArguments #-}
2+
{-# LANGUAGE LambdaCase #-}
23
{-# LANGUAGE MultiWayIf #-}
34
{-# LANGUAGE OverloadedStrings #-}
45
{-# LANGUAGE PatternSynonyms #-}

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

Lines changed: 159 additions & 127 deletions
Original file line numberDiff line numberDiff line change
@@ -3,181 +3,213 @@
33
{-# LANGUAGE TypeApplications #-}
44

55
module FF.Qt.MainWindow (
6-
MainWindow, new, upsertNote
6+
MainWindow,
7+
new,
8+
upsertNote,
79
) where
810

911
-- global
10-
import Control.Monad (void)
11-
import Data.ByteString (ByteString)
12-
import Data.Foldable (fold)
13-
import Data.Traversable (for)
14-
import Foreign (castPtr)
15-
import Foreign.Hoppy.Runtime (CppPtr, nullptr, toPtr, touchCppPtr,
16-
withCppPtr, withScopedPtr)
17-
import GHC.Stack (callStack, prettyCallStack)
18-
import Graphics.UI.Qtah.Core.QObject (QObjectConstPtr, QObjectPtr,
19-
toQObject, toQObjectConst)
20-
import qualified Graphics.UI.Qtah.Core.QSettings as QSettings
21-
import qualified Graphics.UI.Qtah.Core.QVariant as QVariant
22-
import Graphics.UI.Qtah.Event (onEvent)
23-
import Graphics.UI.Qtah.Gui.QCloseEvent (QCloseEvent)
24-
import Graphics.UI.Qtah.Signal (connect_)
25-
import qualified Graphics.UI.Qtah.Widgets.QAction as QAction
26-
import Graphics.UI.Qtah.Widgets.QMainWindow (QMainWindow,
27-
QMainWindowPtr)
28-
import qualified Graphics.UI.Qtah.Widgets.QMainWindow as QMainWindow
29-
import qualified Graphics.UI.Qtah.Widgets.QMenu as QMenu
30-
import qualified Graphics.UI.Qtah.Widgets.QMenuBar as QMenuBar
31-
import qualified Graphics.UI.Qtah.Widgets.QMessageBox as QMessageBox
32-
import qualified Graphics.UI.Qtah.Widgets.QSplitter as QSplitter
33-
import qualified Graphics.UI.Qtah.Widgets.QTreeWidget as QTreeWidget
34-
import Graphics.UI.Qtah.Widgets.QTreeWidgetItem (QTreeWidgetItem)
35-
import qualified Graphics.UI.Qtah.Widgets.QTreeWidgetItem as QTreeWidgetItem
36-
import Graphics.UI.Qtah.Widgets.QWidget (QWidgetConstPtr, QWidgetPtr,
37-
toQWidget, toQWidgetConst)
38-
import qualified Graphics.UI.Qtah.Widgets.QWidget as QWidget
39-
import System.IO (hPutStrLn, stderr)
12+
import Control.Monad (void)
13+
import Data.ByteString (ByteString)
14+
import Data.Foldable (fold)
15+
import Data.Traversable (for)
16+
import Foreign (castPtr)
17+
import Foreign.Hoppy.Runtime (
18+
CppPtr,
19+
nullptr,
20+
toPtr,
21+
touchCppPtr,
22+
withCppPtr,
23+
withScopedPtr,
24+
)
25+
import GHC.Stack (callStack, prettyCallStack)
26+
import Graphics.UI.Qtah.Core.QObject (
27+
QObjectConstPtr,
28+
QObjectPtr,
29+
toQObject,
30+
toQObjectConst,
31+
)
32+
import Graphics.UI.Qtah.Core.QSettings qualified as QSettings
33+
import Graphics.UI.Qtah.Core.QVariant qualified as QVariant
34+
import Graphics.UI.Qtah.Event (onEvent)
35+
import Graphics.UI.Qtah.Gui.QCloseEvent (QCloseEvent)
36+
import Graphics.UI.Qtah.Gui.QPaintDevice (
37+
QPaintDeviceConstPtr,
38+
QPaintDevicePtr,
39+
toQPaintDevice,
40+
toQPaintDeviceConst,
41+
)
42+
import Graphics.UI.Qtah.Signal (connect_)
43+
import Graphics.UI.Qtah.Widgets.QAction qualified as QAction
44+
import Graphics.UI.Qtah.Widgets.QMainWindow (
45+
QMainWindow,
46+
QMainWindowPtr,
47+
)
48+
import Graphics.UI.Qtah.Widgets.QMainWindow qualified as QMainWindow
49+
import Graphics.UI.Qtah.Widgets.QMenu qualified as QMenu
50+
import Graphics.UI.Qtah.Widgets.QMenuBar qualified as QMenuBar
51+
import Graphics.UI.Qtah.Widgets.QMessageBox qualified as QMessageBox
52+
import Graphics.UI.Qtah.Widgets.QSplitter qualified as QSplitter
53+
import Graphics.UI.Qtah.Widgets.QTreeWidget qualified as QTreeWidget
54+
import Graphics.UI.Qtah.Widgets.QTreeWidgetItem (QTreeWidgetItem)
55+
import Graphics.UI.Qtah.Widgets.QTreeWidgetItem qualified as QTreeWidgetItem
56+
import Graphics.UI.Qtah.Widgets.QWidget (
57+
QWidgetConstPtr,
58+
QWidgetPtr,
59+
toQWidget,
60+
toQWidgetConst,
61+
)
62+
import Graphics.UI.Qtah.Widgets.QWidget qualified as QWidget
63+
import System.IO (hPutStrLn, stderr)
4064

4165
-- organization
42-
import RON.Storage.Backend (DocId (DocId))
43-
import qualified RON.Storage.FS as Storage
66+
import RON.Storage.Backend (DocId (DocId))
67+
import RON.Storage.FS qualified as Storage
4468

4569
-- project
46-
import FF.Types (EntityView, Note)
70+
import FF.Types (EntityView, Note)
4771

4872
-- package
49-
import FF.Qt.TaskListWidget (ItemType (ModeGroup, Task),
50-
TaskListWidget)
51-
import qualified FF.Qt.TaskListWidget as TaskListWidget
52-
import FF.Qt.TaskWidget (TaskWidget)
53-
import qualified FF.Qt.TaskWidget as TaskWidget
73+
import FF.Qt.TaskListWidget (
74+
ItemType (ModeGroup, Task),
75+
TaskListWidget,
76+
)
77+
import FF.Qt.TaskListWidget qualified as TaskListWidget
78+
import FF.Qt.TaskWidget (TaskWidget)
79+
import FF.Qt.TaskWidget qualified as TaskWidget
5480

5581
data MainWindow = MainWindow
56-
{ super :: QMainWindow
57-
, agendaTasks :: TaskListWidget
58-
, taskWidget :: TaskWidget
59-
}
82+
{ super :: QMainWindow
83+
, agendaTasks :: TaskListWidget
84+
, taskWidget :: TaskWidget
85+
}
6086

6187
instance CppPtr MainWindow where
62-
nullptr =
63-
MainWindow{super = nullptr, agendaTasks = nullptr, taskWidget = nullptr}
64-
withCppPtr MainWindow{super} proc = withCppPtr super $ proc . castPtr
65-
toPtr = castPtr . toPtr . super
66-
touchCppPtr = touchCppPtr . super
88+
nullptr =
89+
MainWindow{super = nullptr, agendaTasks = nullptr, taskWidget = nullptr}
90+
withCppPtr MainWindow{super} proc = withCppPtr super $ proc . castPtr
91+
toPtr = castPtr . toPtr . super
92+
touchCppPtr = touchCppPtr . super
6793

6894
instance QObjectConstPtr MainWindow where
69-
toQObjectConst = toQObjectConst . super
95+
toQObjectConst = toQObjectConst . super
7096

7197
instance QObjectPtr MainWindow where
72-
toQObject = toQObject . super
98+
toQObject = toQObject . super
7399

74100
instance QWidgetConstPtr MainWindow where
75-
toQWidgetConst = toQWidgetConst . super
101+
toQWidgetConst = toQWidgetConst . super
102+
103+
instance QPaintDeviceConstPtr MainWindow where
104+
toQPaintDeviceConst = toQPaintDeviceConst . super
105+
106+
instance QPaintDevicePtr MainWindow where
107+
toQPaintDevice = toQPaintDevice . super
76108

77109
instance QWidgetPtr MainWindow where
78-
toQWidget = toQWidget . super
110+
toQWidget = toQWidget . super
79111

80112
new :: String -> Storage.Handle -> IO MainWindow
81113
new progName storage = do
82-
super <- QMainWindow.new
83-
QWidget.setWindowTitle super progName
114+
super <- QMainWindow.new
115+
QWidget.setWindowTitle super progName
84116

85-
restoreGeometry super -- must be before widgets creation
117+
restoreGeometry super -- must be before widgets creation
86118

87-
-- UI setup and widgets creation
88-
agendaSplitter <- QSplitter.new
89-
QSplitter.setChildrenCollapsible agendaSplitter False
90-
QMainWindow.setCentralWidget super agendaSplitter
119+
-- UI setup and widgets creation
120+
agendaSplitter <- QSplitter.new
121+
QSplitter.setChildrenCollapsible agendaSplitter False
122+
QMainWindow.setCentralWidget super agendaSplitter
91123

92-
agendaTasks <- TaskListWidget.new
93-
QSplitter.addWidget agendaSplitter agendaTasks
124+
agendaTasks <- TaskListWidget.new
125+
QSplitter.addWidget agendaSplitter agendaTasks
94126

95-
taskWidget <- TaskWidget.new storage
96-
QWidget.hide taskWidget
97-
QSplitter.addWidget agendaSplitter taskWidget
127+
taskWidget <- TaskWidget.new storage
128+
QWidget.hide taskWidget
129+
QSplitter.addWidget agendaSplitter taskWidget
98130

99-
-- sizes need widgets to be added
100-
QSplitter.setSizes agendaSplitter [1, 1 :: Int]
131+
-- sizes need widgets to be added
132+
QSplitter.setSizes agendaSplitter [1, 1 :: Int]
101133

102-
do
103-
menuBar <- QMainWindow.menuBar super
104-
do
105-
debugMenu <- QMenuBar.addNewMenu menuBar "&Debug"
106-
showUuidsAction <-
107-
QMenu.addNewAction debugMenu "&Show UUIDs and internal keys"
108-
QAction.setCheckable showUuidsAction True
109-
connect_ showUuidsAction QAction.toggledSignal $
110-
TaskListWidget.setDebugInfoVisible agendaTasks
111134
do
112-
helpMenu <- QMenuBar.addNewMenu menuBar "&Help"
113-
aboutProgramAction <- QMenu.addNewAction helpMenu "&About ff"
114-
connect_ aboutProgramAction QAction.triggeredSignal $ const $
115-
showAboutProgram super progName
116-
117-
restoreState super -- must be after widgets creation
118-
119-
let mainWindow = MainWindow{super, agendaTasks, taskWidget}
120-
121-
-- handling events
122-
void $ onEvent super $ \(_ :: QCloseEvent) -> saveGeometryAndState super
123-
-- TODO
124-
-- connect_ editor QTextEdit.textChangedSignal $ saveTheText storage editor
125-
connect_ agendaTasks QTreeWidget.itemSelectionChangedSignal $
126-
resetTaskView mainWindow
127-
128-
pure mainWindow
135+
menuBar <- QMainWindow.menuBar super
136+
do
137+
debugMenu <- QMenuBar.addNewMenu menuBar "&Debug"
138+
showUuidsAction <-
139+
QMenu.addNewAction debugMenu "&Show UUIDs and internal keys"
140+
QAction.setCheckable showUuidsAction True
141+
connect_ showUuidsAction QAction.toggledSignal $
142+
TaskListWidget.setDebugInfoVisible agendaTasks
143+
do
144+
helpMenu <- QMenuBar.addNewMenu menuBar "&Help"
145+
aboutProgramAction <- QMenu.addNewAction helpMenu "&About ff"
146+
connect_ aboutProgramAction QAction.triggeredSignal $
147+
const $
148+
showAboutProgram super progName
149+
150+
restoreState super -- must be after widgets creation
151+
let mainWindow = MainWindow{super, agendaTasks, taskWidget}
152+
153+
-- handling events
154+
void $ onEvent super $ \(_ :: QCloseEvent) -> saveGeometryAndState super
155+
-- TODO
156+
-- connect_ editor QTextEdit.textChangedSignal $ saveTheText storage editor
157+
connect_ agendaTasks QTreeWidget.itemSelectionChangedSignal $
158+
resetTaskView mainWindow
159+
160+
pure mainWindow
129161

130162
-- | Only task notes are supported. TODO support wiki notes too
131163
upsertNote :: MainWindow -> EntityView Note -> IO ()
132164
upsertNote MainWindow{agendaTasks} = TaskListWidget.upsertTask agendaTasks
133165

134166
-- https://wiki.qt.io/Saving_Window_Size_State
135-
saveGeometryAndState :: QMainWindowPtr window => window -> IO Bool
167+
saveGeometryAndState :: (QMainWindowPtr window) => window -> IO Bool
136168
saveGeometryAndState window =
137-
withScopedPtr QSettings.new $ \settings -> do
138-
let saveSetting name value =
139-
QVariant.newWithByteArray value >>= QSettings.setValue settings name
140-
QWidget.saveGeometry window >>= saveSetting "mainWindowGeometry"
141-
QMainWindow.saveState window >>= saveSetting "mainWindowState"
142-
pure True
143-
144-
restoreGeometry :: QWidgetPtr widget => widget -> IO ()
169+
withScopedPtr QSettings.new $ \settings -> do
170+
let saveSetting name value =
171+
QVariant.newWithByteArray value >>= QSettings.setValue settings name
172+
QWidget.saveGeometry window >>= saveSetting "mainWindowGeometry"
173+
QMainWindow.saveState window >>= saveSetting "mainWindowState"
174+
pure True
175+
176+
restoreGeometry :: (QWidgetPtr widget) => widget -> IO ()
145177
restoreGeometry widget =
146-
void $ loadSetting "mainWindowGeometry" >>= QWidget.restoreGeometry widget
178+
void $ loadSetting "mainWindowGeometry" >>= QWidget.restoreGeometry widget
147179

148-
restoreState :: QMainWindowPtr window => window -> IO ()
180+
restoreState :: (QMainWindowPtr window) => window -> IO ()
149181
restoreState window =
150-
void $ loadSetting "mainWindowState" >>= QMainWindow.restoreState window
182+
void $ loadSetting "mainWindowState" >>= QMainWindow.restoreState window
151183

152184
loadSetting :: String -> IO ByteString
153185
loadSetting name =
154-
withScopedPtr QSettings.new $ \settings ->
155-
QSettings.value settings name >>= QVariant.toByteArray
186+
withScopedPtr QSettings.new $ \settings ->
187+
QSettings.value settings name >>= QVariant.toByteArray
156188

157189
resetTaskView :: MainWindow -> IO ()
158190
resetTaskView MainWindow{agendaTasks, taskWidget} = do
159-
items <- QTreeWidget.selectedItems agendaTasks
160-
taskItems <- fmap fold . for items $ \item -> do
161-
itemType <- toEnum <$> QTreeWidgetItem.getType item
162-
pure $ case itemType of
163-
Task -> [item]
164-
ModeGroup -> []
165-
case taskItems of
166-
[] -> QWidget.hide taskWidget
167-
[item] -> setTaskView taskWidget item
168-
_:_:_ -> print "TODO open/replace group actions view"
191+
items <- QTreeWidget.selectedItems agendaTasks
192+
taskItems <- fmap fold . for items $ \item -> do
193+
itemType <- toEnum <$> QTreeWidgetItem.getType item
194+
pure $ case itemType of
195+
Task -> [item]
196+
ModeGroup -> []
197+
case taskItems of
198+
[] -> QWidget.hide taskWidget
199+
[item] -> setTaskView taskWidget item
200+
_ : _ : _ -> print "TODO open/replace group actions view"
169201

170202
setTaskView :: TaskWidget -> QTreeWidgetItem -> IO ()
171203
setTaskView taskWidget item = do
172-
itemType <- toEnum <$> QTreeWidgetItem.getType item
173-
case itemType of
174-
ModeGroup ->
175-
hPutStrLn stderr $ "internal error" ++ prettyCallStack callStack
176-
Task -> do
177-
noteId <- DocId @Note <$> TaskListWidget.getId item
178-
TaskWidget.update taskWidget noteId
179-
QWidget.show taskWidget
180-
181-
showAboutProgram :: QWidgetPtr mainWindow => mainWindow -> String -> IO ()
204+
itemType <- toEnum <$> QTreeWidgetItem.getType item
205+
case itemType of
206+
ModeGroup ->
207+
hPutStrLn stderr $ "internal error" ++ prettyCallStack callStack
208+
Task -> do
209+
noteId <- DocId @Note <$> TaskListWidget.getId item
210+
TaskWidget.update taskWidget noteId
211+
QWidget.show taskWidget
212+
213+
showAboutProgram :: (QWidgetPtr mainWindow) => mainWindow -> String -> IO ()
182214
showAboutProgram mainWindow progName =
183-
QMessageBox.about mainWindow progName "A note taker and task tracker"
215+
QMessageBox.about mainWindow progName "A note taker and task tracker"

0 commit comments

Comments
 (0)