webapp: Better display of added files.

4 files changed, 76 insertions, 32 deletions

diff --git a/Assistant/Alert.hs b/Assistant/Alert.hs
index da22d6031..df5ee2910 100644
--- a/Assistant/Alert.hs
+++ b/Assistant/Alert.hs
@@ -41,12 +41,16 @@ mkAlertButton label urlrenderer route = do
 		}
 #endif
 
+renderData :: Alert -> TenseText
+renderData = tenseWords . alertData
+
 baseActivityAlert :: Alert
 baseActivityAlert = Alert
 	{ alertClass = Activity
 	, alertHeader = Nothing
-	, alertMessageRender = tenseWords
+	, alertMessageRender = renderData
 	, alertData = []
+	, alertCounter = 0
 	, alertBlockDisplay = False
 	, alertClosable = False
 	, alertPriority = Medium
@@ -60,8 +64,9 @@ warningAlert :: String -> String -> Alert
 warningAlert name msg = Alert
 	{ alertClass = Warning
 	, alertHeader = Just $ tenseWords ["warning"]
-	, alertMessageRender = tenseWords
+	, alertMessageRender = renderData
 	, alertData = [UnTensed $ T.pack msg]
+	, alertCounter = 0
 	, alertBlockDisplay = True
 	, alertClosable = True
 	, alertPriority = High
@@ -128,6 +133,7 @@ sanityCheckFixAlert msg = Alert
 	, alertHeader = Just $ tenseWords ["Fixed a problem"]
 	, alertMessageRender = render
 	, alertData = [UnTensed $ T.pack msg]
+	, alertCounter = 0
 	, alertBlockDisplay = True
 	, alertPriority = High
 	, alertClosable = True
@@ -137,7 +143,7 @@ sanityCheckFixAlert msg = Alert
 	, alertButton = Nothing
 	}
   where
-	render dta = tenseWords $ alerthead : dta ++ [alertfoot]
+	render alert = tenseWords $ alerthead : alertData alert ++ [alertfoot]
 	alerthead = "The daily sanity check found and fixed a problem:"
 	alertfoot = "If these problems persist, consider filing a bug report."
 
@@ -152,8 +158,9 @@ pairRequestReceivedAlert :: String -> AlertButton -> Alert
 pairRequestReceivedAlert who button = Alert
 	{ alertClass = Message
 	, alertHeader = Nothing
-	, alertMessageRender = tenseWords
+	, alertMessageRender = renderData
 	, alertData = [UnTensed $ T.pack $ who ++ " is sending a pair request."]
+	, alertCounter = 0
 	, alertBlockDisplay = False
 	, alertPriority = High
 	, alertClosable = True
@@ -180,7 +187,8 @@ xmppNeededAlert button = Alert
 	, alertButton = Just button
 	, alertClosable = True
 	, alertClass = Message
-	, alertMessageRender = tenseWords
+	, alertMessageRender = renderData
+	, alertCounter = 0
 	, alertBlockDisplay = True
 	, alertName = Just $ XMPPNeededAlert
 	, alertCombiner = Just $ dataCombiner $ \_old new -> new
@@ -198,7 +206,8 @@ cloudRepoNeededAlert friendname button = Alert
 	, alertButton = Just button
 	, alertClosable = True
 	, alertClass = Message
-	, alertMessageRender = tenseWords
+	, alertMessageRender = renderData
+	, alertCounter = 0
 	, alertBlockDisplay = True
 	, alertName = Just $ CloudRepoNeededAlert
 	, alertCombiner = Just $ dataCombiner $ \_old new -> new
@@ -215,41 +224,80 @@ remoteRemovalAlert desc button = Alert
 	, alertButton = Just button
 	, alertClosable = True
 	, alertClass = Message
-	, alertMessageRender = tenseWords
+	, alertMessageRender = renderData
+	, alertCounter = 0
 	, alertBlockDisplay = True
 	, alertName = Just $ RemoteRemovalAlert desc
 	, alertCombiner = Just $ dataCombiner $ \_old new -> new
 	, alertData = []
 	}
 
-fileAlert :: TenseChunk -> FilePath -> Alert
-fileAlert msg file = (activityAlert Nothing [f])
+{- Show a message that relates to a list of files.
+ -
+ - The most recent several files are shown, and a count of any others. -}
+fileAlert :: TenseChunk -> [FilePath] -> Alert
+fileAlert msg files = (activityAlert Nothing shortfiles)
 	{ alertName = Just $ FileAlert msg
-	, alertMessageRender = render
-	, alertCombiner = Just $ dataCombiner combiner
+	, alertMessageRender = renderer
+	, alertCounter = counter
+	, alertCombiner = Just $ fullCombiner combiner
 	}
   where
-	f = fromString $ shortFile $ takeFileName file
-	render fs = tenseWords $ msg : fs
-	combiner new old = take 10 $ new ++ old
+	maxfilesshown = 10
+
+	(somefiles, counter) = splitcounter (dedupadjacent files)
+	shortfiles = map (fromString . shortFile . takeFileName) somefiles
+
+	renderer alert = tenseWords $ msg : alertData alert ++ showcounter
+	  where
+		showcounter = case alertCounter alert of
+			0 -> []
+			_ -> [fromString $ "and " ++ show (alertCounter alert) ++ " other files"]
 
-addFileAlert :: String -> Alert
+	dedupadjacent (x:y:rest)
+		| x == y = dedupadjacent (y:rest)
+		| otherwise = x : dedupadjacent (y:rest)
+	dedupadjacent (x:[]) = [x]
+	dedupadjacent [] = []
+
+	{- Note that this ensures the counter is never 1; no need to say 
+	 - "1 file" when the filename could be shown. -}
+	splitcounter l
+		| length l <= maxfilesshown = (l, 0)
+		| otherwise =
+			let (keep, rest) = splitAt (maxfilesshown - 1) l
+			in (keep, length rest)
+	
+	combiner new old =
+		let (fs, n) = splitcounter $
+			dedupadjacent $ alertData new ++ alertData old
+		    cnt = n + alertCounter new + alertCounter old
+		in old
+			{ alertData = fs
+			, alertCounter = cnt
+			}
+
+addFileAlert :: [FilePath] -> 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"
+transferFileAlert direction True file
+	| direction == Upload = fileAlert "Uploaded" [file]
+	| otherwise = fileAlert "Downloaded" [file]
+transferFileAlert direction False file
+	| direction == Upload = fileAlert "Upload failed" [file]
+	| otherwise = fileAlert "Download failed" [file]
 
 dataCombiner :: ([TenseChunk] -> [TenseChunk] -> [TenseChunk]) -> AlertCombiner
-dataCombiner combiner new old
+dataCombiner combiner = fullCombiner $
+	\new old -> old { alertData = alertData new `combiner` alertData old }
+
+fullCombiner :: (Alert -> Alert -> Alert) -> AlertCombiner
+fullCombiner combiner new old
 	| alertClass new /= alertClass old = Nothing
 	| alertName new == alertName old = 
-		Just $! old { alertData = alertData new `combiner` alertData old }
+		Just $! new `combiner` old
 	| otherwise = Nothing
 
 shortFile :: FilePath -> String
diff --git a/Assistant/Alert/Utility.hs b/Assistant/Alert/Utility.hs
index 4757c4498..af52a4235 100644
--- a/Assistant/Alert/Utility.hs
+++ b/Assistant/Alert/Utility.hs
@@ -56,7 +56,7 @@ renderAlertHeader alert = renderTense (alertTense alert) <$> alertHeader alert
 {- Renders an alert's message for display. -}
 renderAlertMessage :: Alert -> Text
 renderAlertMessage alert = renderTense (alertTense alert) $
-	(alertMessageRender alert) (alertData alert)
+	(alertMessageRender alert) alert
 
 showAlert :: Alert -> String
 showAlert alert = T.unpack $ T.unwords $ catMaybes
diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs
index 1064f371a..5c7332ba6 100644
--- a/Assistant/Threads/Committer.hs
+++ b/Assistant/Threads/Committer.hs
@@ -383,7 +383,7 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do
 				return Nothing
 
 	{- Shown an alert while performing an action to add a file or
-	 - files. When only one file is added, its name is shown
+	 - files. When only a few files are added, their names are shown
 	 - in the alert. When it's a batch add, the number of files added
 	 - is shown.
 	 -
@@ -392,15 +392,10 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do
 	 - the add succeeded.
 	 -}
 	addaction [] a = a
-	addaction toadd a = alertWhile' (addFileAlert msg) $
+	addaction toadd a = alertWhile' (addFileAlert $ map changeFile toadd) $
 		(,) 
 			<$> pure True
 			<*> a
-	  where
-	  	msg = case toadd of
-			(InProcessAddChange { keySource = ks }:[]) ->
-				keyFilename ks
-			_ -> show (length toadd) ++ " files"
 
 {- Files can Either be Right to be added now,
  - or are unsafe, and must be Left for later.
diff --git a/Assistant/Types/Alert.hs b/Assistant/Types/Alert.hs
index 1ca886242..290733b66 100644
--- a/Assistant/Types/Alert.hs
+++ b/Assistant/Types/Alert.hs
@@ -39,8 +39,9 @@ type AlertCombiner = Alert -> Alert -> Maybe Alert
 data Alert = Alert
 	{ alertClass :: AlertClass
 	, alertHeader :: Maybe TenseText
-	, alertMessageRender :: [TenseChunk] -> TenseText
+	, alertMessageRender :: Alert -> TenseText
 	, alertData :: [TenseChunk]
+	, alertCounter :: Int
 	, alertBlockDisplay :: Bool
 	, alertClosable :: Bool
 	, alertPriority :: AlertPriority