From 3dce75fb23fca94ad86c3f0ee816bb0ad2ecb27c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 30 Jul 2012 02:07:02 -0400 Subject: make old activiy alerts stay visible They're updated to show whether the activity succeeded or failed. This adds several TODOs to the code to fix later. --- Assistant/DaemonStatus.hs | 27 ++++++++++++++++++++++----- 1 file changed, 22 insertions(+), 5 deletions(-) (limited to 'Assistant/DaemonStatus.hs') diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs index f1b3bdb9f..6d05c6152 100644 --- a/Assistant/DaemonStatus.hs +++ b/Assistant/DaemonStatus.hs @@ -223,12 +223,29 @@ addAlert dstatus alert = notifyAlert dstatus `after` modifyDaemonStatus dstatus m = M.insertWith' const i alert (alertMap s) removeAlert :: DaemonStatusHandle -> AlertId -> IO () -removeAlert dstatus i = notifyAlert dstatus `after` modifyDaemonStatus_ dstatus go +removeAlert dstatus i = updateAlert dstatus i (const Nothing) + +updateAlert :: DaemonStatusHandle -> AlertId -> (Alert -> Maybe Alert) -> IO () +updateAlert dstatus i a = updateAlertMap dstatus $ \m -> M.update a i m + +updateAlertMap :: DaemonStatusHandle -> (AlertMap -> AlertMap) -> IO () +updateAlertMap dstatus a = notifyAlert dstatus `after` modifyDaemonStatus_ dstatus go where - go s = s { alertMap = M.delete i (alertMap s) } + go s = s { alertMap = a (alertMap s) } -{- Displays an alert while performing an activity, then removes it. -} -alertWhile :: DaemonStatusHandle -> Alert -> IO a -> IO a +{- Displays an alert while performing an activity. + - + - The alert is left visible afterwards, as filler. + - Old filler is pruned, to prevent the map growing too large. -} +alertWhile :: DaemonStatusHandle -> Alert -> IO Bool -> IO Bool alertWhile dstatus alert a = do let alert' = alert { alertClass = Activity } - bracket (addAlert dstatus alert') (removeAlert dstatus) (const a) + i <- addAlert dstatus alert' + r <- bracket_ noop noop a + updateAlertMap dstatus $ makeold i (makeAlertFiller r) + return r + where + -- TODO prune old filler + makeold i filler m + | M.size m < 20 = M.adjust filler i m + | otherwise = M.adjust filler i m -- cgit v1.2.3