Skip to content

Commit bd991bb

Browse files
cblpcblp
committed
ff-qtah: Add sorting by end/start
1 parent f670136 commit bd991bb

3 files changed

Lines changed: 91 additions & 39 deletions

File tree

‎ff-qtah/FF/Qt.hs‎

Lines changed: 18 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,8 @@
1-
module FF.Qt (printChildrenTree, whenUIIdle) where
1+
{-# LANGUAGE BlockArguments #-}
22

3+
module FF.Qt (printChildrenTree, repeatInGuiThreadWheneverIdle, runInGuiThreadWhenReady) where
4+
5+
import Control.Concurrent.MVar (MVar, tryTakeMVar)
36
import Data.Foldable (for_)
47
import Graphics.UI.Qtah.Core.QMetaClassInfo qualified as QMetaClassInfo
58
import Graphics.UI.Qtah.Core.QMetaObject qualified as QMetaObject
@@ -21,8 +24,20 @@ printChildrenTree = go 0 . toQObject
2124
children <- QObject.children object
2225
for_ children $ go (level + 1)
2326

24-
whenUIIdle :: IO () -> IO ()
25-
whenUIIdle action = do
27+
-- | Repaeat some code in the GUI thread, when it is idle
28+
repeatInGuiThreadWheneverIdle :: IO () -> IO ()
29+
repeatInGuiThreadWheneverIdle action = do
2630
t <- QTimer.new
2731
connect_ t QTimer.timeoutSignal action
2832
QTimer.start t 0
33+
34+
-- | When an MVar gets a value, run the handler once in the GUI thread.
35+
runInGuiThreadWhenReady :: MVar a -> (a -> IO ()) -> IO ()
36+
runInGuiThreadWhenReady var action = do
37+
t <- QTimer.new
38+
connect_ t QTimer.timeoutSignal do
39+
mVal <- tryTakeMVar var
40+
for_ mVal \val -> do
41+
QObject.deleteLater t
42+
action val
43+
QTimer.start t 0

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

Lines changed: 65 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -15,14 +15,14 @@ module FF.Qt.TaskListWidget (
1515
upsertTask,
1616
) where
1717

18-
-- global
1918
import Control.Monad (void)
2019
import Data.IORef (IORef, modifyIORef, newIORef, readIORef)
2120
import Data.Map.Strict (Map)
2221
import Data.Map.Strict qualified as Map
2322
import Data.Text qualified as Text
24-
import Data.Time (getCurrentTime, utctDay)
23+
import Data.Time (getCurrentTime, toGregorian, utctDay)
2524
import Foreign.Hoppy.Runtime (fromCppEnum, toGc)
25+
import Graphics.UI.Qtah.Core.Types qualified as Qt
2626
import Graphics.UI.Qtah.Gui.QFont (QFont)
2727
import Graphics.UI.Qtah.Gui.QFont qualified as QFont
2828
import Graphics.UI.Qtah.Widgets.QAbstractItemView qualified as QAbstractItemView
@@ -32,14 +32,14 @@ import Graphics.UI.Qtah.Widgets.QTreeWidget qualified as QTreeWidget
3232
import Graphics.UI.Qtah.Widgets.QTreeWidgetItem (QTreeWidgetItem)
3333
import Graphics.UI.Qtah.Widgets.QTreeWidgetItem qualified as QTreeWidgetItem
3434
import RON.Storage.Backend (DocId (DocId))
35+
import Text.Printf (printf)
3536

36-
-- project
3737
import FF (fromRgaM)
3838
import FF.Types (
3939
Entity (..),
4040
EntityView,
4141
Note (..),
42-
TaskMode,
42+
TaskMode (..),
4343
View (NoteView, note),
4444
taskMode,
4545
)
@@ -50,10 +50,15 @@ data TaskListWidget = TaskListWidget
5050

5151
{- | Value order in this enumeration defines the field order in the tree widget.
5252
0th column mustn't be hideable, because when 0th column is hidden,
53-
the tree strcuture, alternating row color, and child indicators
53+
the tree structure, alternating row color, and child indicators
5454
are hidden too.
5555
-}
56-
data Field = TitleField | IdField deriving (Bounded, Enum)
56+
data Field
57+
= TitleField
58+
| IdField
59+
| -- | see NaturalTaskOrder.md
60+
SortKeyField
61+
deriving (Bounded, Enum)
5762

5863
fieldCount :: Int
5964
fieldCount = fromEnum (maxBound :: Field) + 1
@@ -84,8 +89,14 @@ new :: IO TaskListWidget
8489
new = do
8590
parent <- QTreeWidget.new
8691
QAbstractItemView.setAlternatingRowColors parent True
87-
QTreeView.setHeaderHidden parent True
92+
QTreeView.setSortingEnabled parent True
93+
QTreeWidget.sortItems parent (fromEnum SortKeyField) Qt.AscendingOrder
8894
QTreeWidget.setColumnCount parent fieldCount
95+
QTreeWidget.setHeaderLabels parent $
96+
fieldsToStrings \case
97+
TitleField -> "Title"
98+
IdField -> "UUID"
99+
SortKeyField -> "Sort key"
89100

90101
modeItems <- newIORef mempty
91102

@@ -96,42 +107,64 @@ new = do
96107
pure this
97108

98109
setDebugInfoVisible :: TaskListWidget -> Bool -> IO ()
99-
setDebugInfoVisible this =
100-
QTreeView.setColumnHidden this.parent (fromEnum IdField) . not
110+
setDebugInfoVisible this v = do
111+
QTreeView.setColumnHidden this.parent (fromEnum IdField) $ not v
112+
QTreeView.setColumnHidden this.parent (fromEnum SortKeyField) $ not v
113+
QTreeView.setHeaderHidden this.parent $ not v
101114

102115
-- Only insertion is implemeted. TODO implement update.
103116
upsertTask :: TaskListWidget -> EntityView Note -> IO ()
104-
upsertTask TaskListWidget{parent, modeItems} Entity{entityId, entityVal} = do
117+
upsertTask this entity = do
105118
today <- utctDay <$> getCurrentTime
106119
let mode = taskMode today note
107-
mModeItem <- Map.lookup mode <$> readIORef modeItems
120+
mModeItem <- Map.lookup mode <$> readIORef this.modeItems
108121
modeItem <- case mModeItem of
109-
Just item ->
110-
pure item
111-
Nothing -> do
112-
item <-
113-
QTreeWidgetItem.newWithParentTreeAndStringsAndType
114-
parent
115-
( fieldsToStrings \case
116-
IdField -> show mode
117-
TitleField -> Text.unpack $ sampleLabel mode
118-
)
119-
(itemTypeToInt ModeGroup)
120-
QTreeWidgetItem.setExpanded item True
121-
QTreeWidgetItem.setFont item (fromEnum TitleField) =<< makeBoldFont
122-
modifyIORef modeItems $ Map.insert mode item
123-
pure item
122+
Just item -> pure item
123+
Nothing -> createModeItem this mode
124+
createTaskItem modeItem entity
125+
where
126+
Entity{entityVal = NoteView{note}} = entity
127+
128+
createModeItem :: TaskListWidget -> TaskMode -> IO QTreeWidgetItem
129+
createModeItem this mode = do
130+
item <-
131+
QTreeWidgetItem.newWithParentTreeAndStringsAndType
132+
this.parent
133+
( fieldsToStrings \case
134+
IdField -> show mode
135+
SortKeyField ->
136+
case mode of
137+
-- 999_999 days ~ 2700 years, should be enough
138+
Overdue n -> printf "0Overdue-%06d" (999_999 - n)
139+
EndToday -> printf "1EndToday"
140+
EndSoon n -> printf "2EndSoon+%06d" n
141+
Actual -> printf "3Actual"
142+
Starting n -> printf "4Starting+%06d" n
143+
TitleField -> Text.unpack $ sampleLabel mode
144+
)
145+
(itemTypeToInt ModeGroup)
146+
QTreeWidgetItem.setExpanded item True
147+
QTreeWidgetItem.setFont item (fromEnum TitleField) =<< makeBoldFont
148+
modifyIORef this.modeItems $ Map.insert mode item
149+
pure item
150+
151+
createTaskItem :: QTreeWidgetItem -> EntityView Note -> IO ()
152+
createTaskItem modeItem entity =
124153
void $
125154
QTreeWidgetItem.newWithParentItemAndStringsAndType
126155
modeItem
127-
(fieldsToStrings \case IdField -> noteId; TitleField -> title)
156+
( fieldsToStrings \case
157+
IdField -> noteId
158+
SortKeyField -> sortKey
159+
TitleField -> title
160+
)
128161
(itemTypeToInt Task)
129162
where
130-
DocId noteId = entityId
131-
NoteView{note} = entityVal
132-
Note{note_text} = note
133-
text = fromRgaM note_text
134-
title = concat $ take 1 $ lines text
163+
Entity{entityId = DocId noteId, entityVal = NoteView{note}} = entity
164+
title = concat $ take 1 $ lines $ fromRgaM note.note_text
165+
sortKey = printf "End=%04d%02d%02d,Start=%04d%02d%02d" ey em ed sy sm sd
166+
(ey, em, ed) = maybe (9999, 99, 99) toGregorian note.note_end
167+
(sy, sm, sd) = maybe (0, 0, 0) toGregorian note.note_start
135168

136169
makeBoldFont :: IO QFont
137170
makeBoldFont = do

‎ff-qtah/Main.hs‎

Lines changed: 8 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@ module Main (main) where
88

99
-- global
1010
import Control.Concurrent (forkIO)
11+
import Control.Concurrent.MVar (newEmptyMVar, putMVar)
1112
import Control.Concurrent.STM (TChan, atomically, tryReadTChan)
1213
import Control.Monad (void)
1314
import Data.Foldable (for_)
@@ -37,7 +38,7 @@ import FF.Config qualified
3738
import FF.Types (Note, Status (Active), loadNote)
3839

3940
-- package
40-
import FF.Qt (whenUIIdle)
41+
import FF.Qt (repeatInGuiThreadWheneverIdle, runInGuiThreadWhenReady)
4142
import FF.Qt.MainWindow (MainWindow)
4243
import FF.Qt.MainWindow qualified as MainWindow
4344
import Paths_ff_qtah qualified as PackageInfo
@@ -53,7 +54,7 @@ main = do
5354
window <- MainWindow.new progName storage
5455
QWidget.show window.parent
5556
initializeAsync storage window
56-
whenUIIdle $ checkDBChange storage window changedDocs
57+
repeatInGuiThreadWheneverIdle $ checkDBChange storage window changedDocs
5758
QCoreApplication.exec
5859

5960
withApp :: (QApplication -> IO a) -> IO a
@@ -69,14 +70,17 @@ setupApp = do
6970
QCoreApplication.setApplicationVersion $ showVersion PackageInfo.version
7071

7172
initializeAsync :: Storage.Handle -> MainWindow -> IO ()
72-
initializeAsync storage window =
73+
initializeAsync storage window = do
74+
tasksVar <- newEmptyMVar
7375
void . forkIO $ do
7476
activeTasks <-
7577
runStorage storage do
7678
notes <- loadAllNotes
7779
let activeTaskEntities = filterTasksByStatus Active notes
7880
traverse viewNote activeTaskEntities
79-
for_ activeTasks $ MainWindow.upsertNote window
81+
putMVar tasksVar activeTasks
82+
runInGuiThreadWhenReady tasksVar \tasks ->
83+
for_ tasks $ MainWindow.upsertNote window
8084

8185
checkDBChange ::
8286
Storage.Handle -> MainWindow -> TChan (CollectionName, RawDocId) -> IO ()

0 commit comments

Comments
 (0)