make alerts change tense when they finish

Assistant/Alert.hs

@@ -5,17 +5,17 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE RankNTypes, BangPatterns #-}
+{-# LANGUAGE RankNTypes, BangPatterns, OverloadedStrings #-}
 
 module Assistant.Alert where
 
 import Common.Annex
 import qualified Remote
+import Utility.Tense
 
+import qualified Data.Text as T
 import qualified Data.Map as M
-import Yesod
+import Data.String
-
-type Widget = forall sub master. GWidget sub master ()
 
 {- Different classes of alerts are displayed differently. -}
 data AlertClass = Success | Message | Activity | Warning | Error
@@ -24,9 +24,6 @@ data AlertClass = Success | Message | Activity | Warning | Error
 data AlertPriority = Filler | Low | Medium | High | Pinned
 	deriving (Eq, Ord)
 
-{- An alert can be a simple message, or an arbitrary Yesod Widget. -}
-data AlertMessage = StringAlert String | WidgetAlert (Alert -> Widget)
-
 {- An alert can have an name, which is used to combine it with other similar
  - alerts. -}
 data AlertName = AddFileAlert | DownloadFailedAlert | SanityCheckFixAlert
@@ -38,8 +35,8 @@ type AlertCombiner = Maybe (Alert -> Alert -> Maybe Alert)
 
 data Alert = Alert
 	{ alertClass :: AlertClass
-	, alertHeader :: Maybe String
+	, alertHeader :: Maybe TenseText
-	, alertMessage :: AlertMessage
+	, alertMessage :: TenseText
 	, alertBlockDisplay :: Bool
 	, alertClosable :: Bool
 	, alertPriority :: AlertPriority
@@ -56,7 +53,6 @@ type AlertMap = M.Map AlertId Alert
 newtype AlertId = AlertId Integer
         deriving (Read, Show, Eq, Ord)
 
-{- Note: This first alert id is used for yesod's message. -}
 firstAlertId :: AlertId
 firstAlertId = AlertId 0
 
@@ -64,7 +60,7 @@ nextAlertId :: AlertId -> AlertId
 nextAlertId (AlertId i) = AlertId $ succ i
 
 {- This is as many alerts as it makes sense to display at a time.
- - A display might be smaller ,or larger, the point is to not overwhelm the
+ - A display might be smaller, or larger, the point is to not overwhelm the
  - user with a ton of alerts. -}
 displayAlerts :: Int
 displayAlerts = 6
@@ -95,24 +91,29 @@ compareAlertPairs
 sortAlertPairs :: [AlertPair] -> [AlertPair]
 sortAlertPairs = sortBy compareAlertPairs
 
-{- Checks if two alerts display the same.
+{- Renders an alert's header for display, if it has one. -}
- - Yesod Widgets cannot be compared, as they run code. -}
+renderAlertHeader :: Alert -> Maybe T.Text
+renderAlertHeader alert = renderTense (alertTense alert) <$> alertHeader alert
+
+{- Renders an alert's message for display. -}
+renderAlertMessage :: Alert -> T.Text
+renderAlertMessage alert = renderTense (alertTense alert) $ alertMessage alert
+
+alertTense :: Alert -> Tense
+alertTense alert
+	| alertClass alert == Activity = Present
+	| otherwise = Past
+
+{- Checks if two alerts display the same. -}
 effectivelySameAlert :: Alert -> Alert -> Bool
-effectivelySameAlert x y
+effectivelySameAlert x y = all id 
-	| uncomparable x || uncomparable y = False
+	[ alertClass x == alertClass y
-	| otherwise = all id 
+	, alertHeader x == alertHeader y
-		[ alertClass x == alertClass y
+	, alertMessage x == alertMessage y
-		, alertHeader x == alertHeader y
+	, alertBlockDisplay x == alertBlockDisplay y
-		, extract (alertMessage x) == extract (alertMessage y)
+	, alertClosable x == alertClosable y
-		, alertBlockDisplay x == alertBlockDisplay y
+	, alertPriority x == alertPriority y
-		, alertClosable x == alertClosable y
+	]
-		, alertPriority x == alertPriority y
-		]
-	where
-		uncomparable (Alert { alertMessage = StringAlert _ }) = False
-		uncomparable _ = True
-		extract (StringAlert s) = s
-		extract _ = ""
 
 makeAlertFiller :: Bool -> Alert -> Alert
 makeAlertFiller success alert
@@ -171,7 +172,7 @@ baseActivityAlert :: Alert
 baseActivityAlert = Alert
 	{ alertClass = Activity
 	, alertHeader = Nothing
-	, alertMessage = StringAlert ""
+	, alertMessage = ""
 	, alertBlockDisplay = False
 	, alertClosable = False
 	, alertPriority = Medium
@@ -180,32 +181,39 @@ baseActivityAlert = Alert
 	, alertName = Nothing
 	}
 
-activityAlert :: Maybe String -> String -> Alert
+activityAlert :: Maybe TenseText -> TenseText -> Alert
 activityAlert header message = baseActivityAlert
 	{ alertHeader = header
-	, alertMessage = StringAlert message
+	, alertMessage = message
 	}
 
 startupScanAlert :: Alert
-startupScanAlert = activityAlert Nothing "Performing startup scan"
+startupScanAlert = activityAlert Nothing $
+	tenseWords [Tensed "Performing" "Performed", "startup scan"]
 
 commitAlert :: Alert
-commitAlert = activityAlert Nothing "Committing changes to git"
+commitAlert = activityAlert Nothing $ tenseWords
+	[Tensed "Committing" "Committed", "changes to git"]
+
+showRemotes :: [Remote] -> TenseChunk
+showRemotes = UnTensed . T.unwords . map (T.pack . Remote.name)
 
 pushAlert :: [Remote] -> Alert
-pushAlert rs = activityAlert Nothing $
+pushAlert rs = activityAlert Nothing $ tenseWords
-	"Syncing with " ++ unwords (map Remote.name rs)
+	[Tensed "Syncing" "Synced", "with", showRemotes rs]
 
 pushRetryAlert :: [Remote] -> Alert
-pushRetryAlert rs = activityAlert (Just "Retrying sync") $
+pushRetryAlert rs = activityAlert
-	"with " ++ unwords (map Remote.name rs) ++ ", which failed earlier."
+	(Just $ tenseWords [Tensed "Retrying" "Retried", "sync"])
+	(tenseWords ["with", showRemotes rs])
 
 syncMountAlert :: FilePath -> [Remote] -> Alert
 syncMountAlert dir rs = baseActivityAlert
-	{ alertHeader = Just $ "Syncing with " ++ unwords (map Remote.name rs)
+	{ alertHeader = Just $ tenseWords
-	, alertMessage = StringAlert $ unwords
+		[Tensed "Syncing" "Sync", "with", showRemotes rs]
+	, alertMessage = tenseWords $ map UnTensed
 		["You plugged in"
-		, dir
+		, T.pack dir
 		, " -- let's get it in sync!"
 		]
 	, alertBlockDisplay = True
@@ -214,23 +222,29 @@ syncMountAlert dir rs = baseActivityAlert
 
 scanAlert :: Remote -> Alert
 scanAlert r = baseActivityAlert
-	{ alertHeader = Just $ "Scanning " ++ Remote.name r
+	{ alertHeader = Just $ tenseWords
-	, alertMessage = StringAlert $ unwords
+		[Tensed "Scanning" "Scanned", showRemotes [r]]
-		[ "Ensuring that ", Remote.name r
+	, alertMessage = tenseWords
-		, "is fully in sync." ]
+		[ Tensed "Ensuring" "Ensured"
+		, "that"
+		, showRemotes [r]
+		, Tensed "is" "was"
+		, "fully in sync."
+		]
 	, alertBlockDisplay = True
 	, alertPriority = Low
 	}
 
 sanityCheckAlert :: Alert
-sanityCheckAlert = activityAlert (Just "Running daily sanity check")
+sanityCheckAlert = activityAlert
-	"to make sure everything is ok."
+	(Just $ tenseWords [Tensed "Running" "Ran", "daily sanity check"])
+	(tenseWords ["to make sure everything is ok."])
 
 sanityCheckFixAlert :: String -> Alert
 sanityCheckFixAlert msg = Alert
 	{ alertClass = Warning
-	, alertHeader = Just "Fixed a problem"
+	, alertHeader = Just $ tenseWords ["Fixed a problem"]
-	, alertMessage = StringAlert $ unlines [ alerthead, msg, alertfoot ]
+	, alertMessage = buildmsg [ alerthead, T.pack msg, alertfoot ]
 	, alertBlockDisplay = True
 	, alertPriority = High
 	, alertClosable = True
@@ -241,26 +255,26 @@ sanityCheckFixAlert msg = Alert
 	where
 		alerthead = "The daily sanity check found and fixed a problem:"
 		alertfoot = "If these problems persist, consider filing a bug report."
-		combinemessage (StringAlert new) (StringAlert old) =
+		combinemessage new old =
 			let newmsg = filter (/= alerthead) $
 				filter (/= alertfoot) $
-				lines old ++ lines new
+				T.lines (renderTense Past old) ++ T.lines (renderTense Past new)
-			in Just $ StringAlert $
+			in Just $ buildmsg $ alerthead : newmsg ++ [alertfoot]
-				unlines $ alerthead : newmsg ++ [alertfoot]
+		buildmsg l = TenseText [UnTensed $ T.unlines l]
-		combinemessage _ _ = Nothing
 
 addFileAlert :: FilePath -> Alert
-addFileAlert file = (activityAlert (Just "Added") $ shortFile $ takeFileName file)
+addFileAlert file = (activityAlert header message)
 	{ alertName = Just AddFileAlert
 	, alertCombiner = messageCombiner combinemessage
 	}
 	where
-		combinemessage (StringAlert new) (StringAlert old) =
+		header = Just $ tenseWords [Tensed "Adding" "Added"]
-			Just $ StringAlert $
+		message = fromString $ shortFile $ takeFileName file
-				unlines $ take 10 $ new : lines old
+		combinemessage new old = Just $ buildmsg $ take 10 $
-		combinemessage _ _ = Nothing
+			(renderTense Past new) : T.lines (renderTense Past old)
+		buildmsg l = TenseText [UnTensed $ T.unlines l]
 
-messageCombiner :: (AlertMessage -> AlertMessage -> Maybe AlertMessage) -> AlertCombiner
+messageCombiner :: (TenseText -> TenseText -> Maybe TenseText) -> AlertCombiner
 messageCombiner combinemessage = Just go
 	where
 		go new old

Assistant/WebApp.hs

@@ -15,7 +15,7 @@ import Assistant.ThreadedMonad
 import Assistant.DaemonStatus
 import Assistant.ScanRemotes
 import Assistant.TransferQueue
-import Assistant.Alert hiding (Widget)
+import Assistant.Alert
 import Utility.NotificationBroadcaster
 import Utility.WebApp
 import Utility.Yesod

Assistant/WebApp/SideBar.hs

@@ -13,7 +13,7 @@ import Assistant.Common
 import Assistant.WebApp
 import Assistant.WebApp.Notifications
 import Assistant.DaemonStatus
-import Assistant.Alert hiding (Widget)
+import Assistant.Alert
 import Utility.NotificationBroadcaster
 import Utility.Yesod
 
@@ -25,9 +25,6 @@ import Control.Concurrent
 sideBarDisplay :: Widget
 sideBarDisplay = do
 	let content = do
-		{- Any yesod message appears as the first alert. -}
-		maybe noop rendermessage =<< lift getMessage
-	
 		{- Add newest alerts to the sidebar. -}
 		webapp <- lift getYesod
 		alertpairs <- M.toList . alertMap
@@ -49,17 +46,12 @@ sideBarDisplay = do
 			(alertClosable alert)
 			(alertBlockDisplay alert)
 			(bootstrapclass $ alertClass alert)
-			(alertHeader alert)
+			(renderAlertHeader alert)
+			(renderAlertMessage alert)
 			(alertIcon alert)
-			$ case alertMessage alert of
-				StringAlert s -> [whamlet|#{s}|]
-				WidgetAlert w -> w alert
 
-		rendermessage msg = addalert firstAlertId True False
+		addalert :: AlertId -> Bool -> Bool -> Text -> Maybe Text -> Text -> Maybe String -> Widget
-			"alert-info" Nothing (Just "exclamation-sign") [whamlet|#{msg}|]
+		addalert i closable block divclass heading message icon = do
-
-		addalert :: AlertId -> Bool -> Bool -> Text -> Maybe String -> Maybe String -> Widget -> Widget
-		addalert i closable block divclass heading icon widget = do
 			let alertid = show i
 			let closealert = CloseAlert i
 			$(widgetFile "sidebar/alert")

templates/sidebar/alert.hamlet

@@ -10,4 +10,4 @@
       <h4 .alert-heading>#{h}</h4> #
     $else
       <strong>#{h}</strong> #
-  ^{widget}
+  #{message}