better alert message generation

This commit is contained in:
Joey Hess 2012-08-06 15:41:42 -04:00
parent 94e92a1b58
commit 05ed196ce5

View file

@ -31,17 +31,18 @@ data AlertName = AddFileAlert | DownloadFailedAlert | SanityCheckFixAlert
{- The first alert is the new alert, the second is an old alert. {- The first alert is the new alert, the second is an old alert.
- Should return a modified version of the old alert. -} - Should return a modified version of the old alert. -}
type AlertCombiner = Maybe (Alert -> Alert -> Maybe Alert) type AlertCombiner = Alert -> Alert -> Maybe Alert
data Alert = Alert data Alert = Alert
{ alertClass :: AlertClass { alertClass :: AlertClass
, alertHeader :: Maybe TenseText , alertHeader :: Maybe TenseText
, alertMessage :: TenseText , alertMessageRender :: [TenseChunk] -> TenseText
, alertData :: [TenseChunk]
, alertBlockDisplay :: Bool , alertBlockDisplay :: Bool
, alertClosable :: Bool , alertClosable :: Bool
, alertPriority :: AlertPriority , alertPriority :: AlertPriority
, alertIcon :: Maybe String , alertIcon :: Maybe String
, alertCombiner :: AlertCombiner , alertCombiner :: Maybe AlertCombiner
, alertName :: Maybe AlertName , alertName :: Maybe AlertName
} }
@ -97,7 +98,8 @@ renderAlertHeader alert = renderTense (alertTense alert) <$> alertHeader alert
{- Renders an alert's message for display. -} {- Renders an alert's message for display. -}
renderAlertMessage :: Alert -> T.Text renderAlertMessage :: Alert -> T.Text
renderAlertMessage alert = renderTense (alertTense alert) $ alertMessage alert renderAlertMessage alert = renderTense (alertTense alert) $
(alertMessageRender alert) (alertData alert)
alertTense :: Alert -> Tense alertTense :: Alert -> Tense
alertTense alert alertTense alert
@ -109,7 +111,7 @@ effectivelySameAlert :: Alert -> Alert -> Bool
effectivelySameAlert x y = all id effectivelySameAlert x y = all id
[ alertClass x == alertClass y [ alertClass x == alertClass y
, alertHeader x == alertHeader y , alertHeader x == alertHeader y
, alertMessage x == alertMessage y , alertData x == alertData y
, alertBlockDisplay x == alertBlockDisplay y , alertBlockDisplay x == alertBlockDisplay y
, alertClosable x == alertClosable y , alertClosable x == alertClosable y
, alertPriority x == alertPriority y , alertPriority x == alertPriority y
@ -172,7 +174,8 @@ baseActivityAlert :: Alert
baseActivityAlert = Alert baseActivityAlert = Alert
{ alertClass = Activity { alertClass = Activity
, alertHeader = Nothing , alertHeader = Nothing
, alertMessage = "" , alertMessageRender = tenseWords
, alertData = []
, alertBlockDisplay = False , alertBlockDisplay = False
, alertClosable = False , alertClosable = False
, alertPriority = Medium , alertPriority = Medium
@ -181,37 +184,37 @@ baseActivityAlert = Alert
, alertName = Nothing , alertName = Nothing
} }
activityAlert :: Maybe TenseText -> TenseText -> Alert activityAlert :: Maybe TenseText -> [TenseChunk] -> Alert
activityAlert header message = baseActivityAlert activityAlert header dat = baseActivityAlert
{ alertHeader = header { alertHeader = header
, alertMessage = message , alertData = dat
} }
startupScanAlert :: Alert startupScanAlert :: Alert
startupScanAlert = activityAlert Nothing $ startupScanAlert = activityAlert Nothing $
tenseWords [Tensed "Performing" "Performed", "startup scan"] [Tensed "Performing" "Performed", "startup scan"]
commitAlert :: Alert commitAlert :: Alert
commitAlert = activityAlert Nothing $ tenseWords commitAlert = activityAlert Nothing $
[Tensed "Committing" "Committed", "changes to git"] [Tensed "Committing" "Committed", "changes to git"]
showRemotes :: [Remote] -> TenseChunk showRemotes :: [Remote] -> TenseChunk
showRemotes = UnTensed . T.unwords . map (T.pack . Remote.name) showRemotes = UnTensed . T.unwords . map (T.pack . Remote.name)
pushAlert :: [Remote] -> Alert pushAlert :: [Remote] -> Alert
pushAlert rs = activityAlert Nothing $ tenseWords pushAlert rs = activityAlert Nothing $
[Tensed "Syncing" "Synced", "with", showRemotes rs] [Tensed "Syncing" "Synced", "with", showRemotes rs]
pushRetryAlert :: [Remote] -> Alert pushRetryAlert :: [Remote] -> Alert
pushRetryAlert rs = activityAlert pushRetryAlert rs = activityAlert
(Just $ tenseWords [Tensed "Retrying" "Retried", "sync"]) (Just $ tenseWords [Tensed "Retrying" "Retried", "sync"])
(tenseWords ["with", showRemotes rs]) (["with", showRemotes rs])
syncMountAlert :: FilePath -> [Remote] -> Alert syncMountAlert :: FilePath -> [Remote] -> Alert
syncMountAlert dir rs = baseActivityAlert syncMountAlert dir rs = baseActivityAlert
{ alertHeader = Just $ tenseWords { alertHeader = Just $ tenseWords
[Tensed "Syncing" "Sync", "with", showRemotes rs] [Tensed "Syncing" "Sync", "with", showRemotes rs]
, alertMessage = tenseWords $ map UnTensed , alertData = map UnTensed
["You plugged in" ["You plugged in"
, T.pack dir , T.pack dir
, " -- let's get it in sync!" , " -- let's get it in sync!"
@ -224,7 +227,7 @@ scanAlert :: Remote -> Alert
scanAlert r = baseActivityAlert scanAlert r = baseActivityAlert
{ alertHeader = Just $ tenseWords { alertHeader = Just $ tenseWords
[Tensed "Scanning" "Scanned", showRemotes [r]] [Tensed "Scanning" "Scanned", showRemotes [r]]
, alertMessage = tenseWords , alertData =
[ Tensed "Ensuring" "Ensured" [ Tensed "Ensuring" "Ensured"
, "that" , "that"
, showRemotes [r] , showRemotes [r]
@ -238,51 +241,42 @@ scanAlert r = baseActivityAlert
sanityCheckAlert :: Alert sanityCheckAlert :: Alert
sanityCheckAlert = activityAlert sanityCheckAlert = activityAlert
(Just $ tenseWords [Tensed "Running" "Ran", "daily sanity check"]) (Just $ tenseWords [Tensed "Running" "Ran", "daily sanity check"])
(tenseWords ["to make sure everything is ok."]) ["to make sure everything is ok."]
sanityCheckFixAlert :: String -> Alert sanityCheckFixAlert :: String -> Alert
sanityCheckFixAlert msg = Alert sanityCheckFixAlert msg = Alert
{ alertClass = Warning { alertClass = Warning
, alertHeader = Just $ tenseWords ["Fixed a problem"] , alertHeader = Just $ tenseWords ["Fixed a problem"]
, alertMessage = buildmsg [ alerthead, T.pack msg, alertfoot ] , alertMessageRender = render
, alertData = [UnTensed $ T.pack msg]
, alertBlockDisplay = True , alertBlockDisplay = True
, alertPriority = High , alertPriority = High
, alertClosable = True , alertClosable = True
, alertIcon = Just "exclamation-sign" , alertIcon = Just "exclamation-sign"
, alertName = Just SanityCheckFixAlert , alertName = Just SanityCheckFixAlert
, alertCombiner = messageCombiner combinemessage , alertCombiner = Just $ dataCombiner (++)
} }
where where
render dta = tenseWords $ alerthead : dta ++ [alertfoot]
alerthead = "The daily sanity check found and fixed a problem:" alerthead = "The daily sanity check found and fixed a problem:"
alertfoot = "If these problems persist, consider filing a bug report." alertfoot = "If these problems persist, consider filing a bug report."
combinemessage new old =
let newmsg = filter (/= alerthead) $
filter (/= alertfoot) $
T.lines (renderTense Past old) ++ T.lines (renderTense Past new)
in Just $ buildmsg $ alerthead : newmsg ++ [alertfoot]
buildmsg l = TenseText [UnTensed $ T.unlines l]
addFileAlert :: FilePath -> Alert addFileAlert :: FilePath -> Alert
addFileAlert file = (activityAlert header message) addFileAlert file = (activityAlert Nothing [f])
{ alertName = Just AddFileAlert { alertName = Just AddFileAlert
, alertCombiner = messageCombiner combinemessage , alertMessageRender = render
, alertCombiner = Just $ dataCombiner combiner
} }
where where
header = Just $ tenseWords [Tensed "Adding" "Added"] f = fromString $ shortFile $ takeFileName file
message = fromString $ shortFile $ takeFileName file render fs = tenseWords $ Tensed "Adding" "Added" : fs
combinemessage new old = Just $ buildmsg $ take 10 $ combiner new old = take 10 $ new ++ old
(renderTense Past new) : T.lines (renderTense Past old)
buildmsg l = TenseText [UnTensed $ T.unlines l]
messageCombiner :: (TenseText -> TenseText -> Maybe TenseText) -> AlertCombiner dataCombiner :: ([TenseChunk] -> [TenseChunk] -> [TenseChunk]) -> AlertCombiner
messageCombiner combinemessage = Just go dataCombiner combiner new old
where
go new old
| alertClass new /= alertClass old = Nothing | alertClass new /= alertClass old = Nothing
| alertName new == alertName old = | alertName new == alertName old =
case combinemessage (alertMessage new) (alertMessage old) of Just $! old { alertData = alertData new `combiner` alertData old }
Nothing -> Nothing
Just !m -> Just $! old { alertMessage = m }
| otherwise = Nothing | otherwise = Nothing
shortFile :: FilePath -> String shortFile :: FilePath -> String