git-annex/Assistant/Alert.hs
Joey Hess a929e6641a show one alert when bulk adding files
Turns out that a lot of the time spent in a bulk add was just updating the
add alert to rotate through each file that was added. Showing one alert
makes for a significant speedup.

Also, when the webapp is open, this makes it take quite a lot less cpu
during bulk adds.

Also, it lets the user know when a bulk add happened, which is sorta
nice..
2013-04-24 13:04:46 -04:00

263 lines
7.7 KiB
Haskell

{- git-annex assistant alerts
-
- Copyright 2012, 2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings, CPP #-}
module Assistant.Alert where
import Common.Annex
import Assistant.Types.Alert
import Assistant.Alert.Utility
import qualified Remote
import Utility.Tense
import Logs.Transfer
import Data.String
import qualified Data.Text as T
#ifdef WITH_WEBAPP
import Assistant.Monad
import Assistant.DaemonStatus
import Assistant.WebApp.Types
import Assistant.WebApp
import Yesod
#endif
{- Makes a button for an alert that opens a Route. The button will
- close the alert it's attached to when clicked. -}
#ifdef WITH_WEBAPP
mkAlertButton :: T.Text -> UrlRenderer -> Route WebApp -> Assistant AlertButton
mkAlertButton label urlrenderer route = do
close <- asIO1 removeAlert
url <- liftIO $ renderUrl urlrenderer route []
return $ AlertButton
{ buttonLabel = label
, buttonUrl = url
, buttonAction = Just close
}
#endif
baseActivityAlert :: Alert
baseActivityAlert = Alert
{ alertClass = Activity
, alertHeader = Nothing
, alertMessageRender = tenseWords
, alertData = []
, alertBlockDisplay = False
, alertClosable = False
, alertPriority = Medium
, alertIcon = Just ActivityIcon
, alertCombiner = Nothing
, alertName = Nothing
, alertButton = Nothing
}
warningAlert :: String -> String -> Alert
warningAlert name msg = Alert
{ alertClass = Warning
, alertHeader = Just $ tenseWords ["warning"]
, alertMessageRender = tenseWords
, alertData = [UnTensed $ T.pack msg]
, alertBlockDisplay = True
, alertClosable = True
, alertPriority = High
, alertIcon = Just ErrorIcon
, alertCombiner = Just $ dataCombiner $ \_old new -> new
, alertName = Just $ WarningAlert name
, alertButton = Nothing
}
activityAlert :: Maybe TenseText -> [TenseChunk] -> Alert
activityAlert header dat = baseActivityAlert
{ alertHeader = header
, alertData = dat
}
startupScanAlert :: Alert
startupScanAlert = activityAlert Nothing
[Tensed "Performing" "Performed", "startup scan"]
{- Displayed when a shutdown is occurring, so will be seen after shutdown
- has happened. -}
shutdownAlert :: Alert
shutdownAlert = warningAlert "shutdown" "git-annex has been shut down"
commitAlert :: Alert
commitAlert = activityAlert Nothing
[Tensed "Committing" "Committed", "changes to git"]
showRemotes :: [Remote] -> TenseChunk
showRemotes = UnTensed . T.intercalate ", " . map (T.pack . Remote.name)
syncAlert :: [Remote] -> Alert
syncAlert rs = baseActivityAlert
{ alertName = Just SyncAlert
, alertHeader = Just $ tenseWords
[Tensed "Syncing" "Synced", "with", showRemotes rs]
, alertPriority = Low
, alertIcon = Just SyncIcon
}
syncResultAlert :: [Remote] -> [Remote] -> Alert
syncResultAlert succeeded failed = makeAlertFiller (not $ null succeeded) $
baseActivityAlert
{ alertName = Just SyncAlert
, alertHeader = Just $ tenseWords msg
}
where
msg
| null succeeded = ["Failed to sync with", showRemotes failed]
| null failed = ["Synced with", showRemotes succeeded]
| otherwise =
[ "Synced with", showRemotes succeeded
, "but not with", showRemotes failed
]
sanityCheckAlert :: Alert
sanityCheckAlert = activityAlert
(Just $ tenseWords [Tensed "Running" "Ran", "daily sanity check"])
["to make sure everything is ok."]
sanityCheckFixAlert :: String -> Alert
sanityCheckFixAlert msg = Alert
{ alertClass = Warning
, alertHeader = Just $ tenseWords ["Fixed a problem"]
, alertMessageRender = render
, alertData = [UnTensed $ T.pack msg]
, alertBlockDisplay = True
, alertPriority = High
, alertClosable = True
, alertIcon = Just ErrorIcon
, alertName = Just SanityCheckFixAlert
, alertCombiner = Just $ dataCombiner (++)
, alertButton = Nothing
}
where
render dta = tenseWords $ alerthead : dta ++ [alertfoot]
alerthead = "The daily sanity check found and fixed a problem:"
alertfoot = "If these problems persist, consider filing a bug report."
pairingAlert :: AlertButton -> Alert
pairingAlert button = baseActivityAlert
{ alertData = [ UnTensed "Pairing in progress" ]
, alertPriority = High
, alertButton = Just button
}
pairRequestReceivedAlert :: String -> AlertButton -> Alert
pairRequestReceivedAlert who button = Alert
{ alertClass = Message
, alertHeader = Nothing
, alertMessageRender = tenseWords
, alertData = [UnTensed $ T.pack $ who ++ " is sending a pair request."]
, alertBlockDisplay = False
, alertPriority = High
, alertClosable = True
, alertIcon = Just InfoIcon
, alertName = Just $ PairAlert who
, alertCombiner = Just $ dataCombiner $ \_old new -> new
, alertButton = Just button
}
pairRequestAcknowledgedAlert :: String -> Maybe AlertButton -> Alert
pairRequestAcknowledgedAlert who button = baseActivityAlert
{ alertData = ["Pairing with", UnTensed (T.pack who), Tensed "in progress" "complete"]
, alertPriority = High
, alertName = Just $ PairAlert who
, alertCombiner = Just $ dataCombiner $ \_old new -> new
, alertButton = button
}
xmppNeededAlert :: AlertButton -> Alert
xmppNeededAlert button = Alert
{ alertHeader = Just "Share with friends, and keep your devices in sync across the cloud."
, alertIcon = Just TheCloud
, alertPriority = High
, alertButton = Just button
, alertClosable = True
, alertClass = Message
, alertMessageRender = tenseWords
, alertBlockDisplay = True
, alertName = Just $ XMPPNeededAlert
, alertCombiner = Just $ dataCombiner $ \_old new -> new
, alertData = []
}
cloudRepoNeededAlert :: Maybe String -> AlertButton -> Alert
cloudRepoNeededAlert friendname button = Alert
{ alertHeader = Just $ fromString $ unwords
[ "Unable to download files from"
, (fromMaybe "your other devices" friendname) ++ "."
]
, alertIcon = Just ErrorIcon
, alertPriority = High
, alertButton = Just button
, alertClosable = True
, alertClass = Message
, alertMessageRender = tenseWords
, alertBlockDisplay = True
, alertName = Just $ CloudRepoNeededAlert
, alertCombiner = Just $ dataCombiner $ \_old new -> new
, alertData = []
}
remoteRemovalAlert :: String -> AlertButton -> Alert
remoteRemovalAlert desc button = Alert
{ alertHeader = Just $ fromString $
"The repository \"" ++ desc ++
"\" has been emptied, and can now be removed."
, alertIcon = Just InfoIcon
, alertPriority = High
, alertButton = Just button
, alertClosable = True
, alertClass = Message
, alertMessageRender = tenseWords
, alertBlockDisplay = True
, alertName = Just $ RemoteRemovalAlert desc
, alertCombiner = Just $ dataCombiner $ \_old new -> new
, alertData = []
}
fileAlert :: TenseChunk -> FilePath -> Alert
fileAlert msg file = (activityAlert Nothing [f])
{ alertName = Just $ FileAlert msg
, alertMessageRender = render
, alertCombiner = Just $ dataCombiner combiner
}
where
f = fromString $ shortFile $ takeFileName file
render fs = tenseWords $ msg : fs
combiner new old = take 10 $ new ++ old
addFileAlert :: String -> Alert
addFileAlert = fileAlert (Tensed "Adding" "Added")
{- This is only used as a success alert after a transfer, not during it. -}
transferFileAlert :: Direction -> Bool -> FilePath -> Alert
transferFileAlert direction True
| direction == Upload = fileAlert "Uploaded"
| otherwise = fileAlert "Downloaded"
transferFileAlert direction False
| direction == Upload = fileAlert "Upload failed"
| otherwise = fileAlert "Download failed"
dataCombiner :: ([TenseChunk] -> [TenseChunk] -> [TenseChunk]) -> AlertCombiner
dataCombiner combiner new old
| alertClass new /= alertClass old = Nothing
| alertName new == alertName old =
Just $! old { alertData = alertData new `combiner` alertData old }
| otherwise = Nothing
shortFile :: FilePath -> String
shortFile f
| len < maxlen = f
| otherwise = take half f ++ ".." ++ drop (len - half) f
where
len = length f
maxlen = 20
half = (maxlen - 2) `div` 2