AssociatedFile newtype

To prevent any further mistakes like 301aff34c4

This commit was sponsored by Francois Marier on Patreon.

Assistant/DeleteRemote.hs

@@ -64,7 +64,7 @@ removableRemote urlrenderer uuid = do
   where
 	queueremaining r k = 
 		queueTransferWhenSmall "remaining object in unwanted remote"
-			Nothing (Transfer Download uuid k) r
+			(AssociatedFile Nothing) (Transfer Download uuid k) r
 	{- Scanning for keys can take a long time; do not tie up
 	 - the Annex monad while doing it, so other threads continue to
 	 - run. -}

Assistant/Threads/Committer.hs

@@ -503,9 +503,10 @@ checkChangeContent change@(Change { changeInfo = i }) =
 		Just k -> whenM (scanComplete <$> getDaemonStatus) $ do
 			present <- liftAnnex $ inAnnex k
 			void $ if present
-				then queueTransfers "new file created" Next k (Just f) Upload
-				else queueTransfers "new or renamed file wanted" Next k (Just f) Download
-			handleDrops "file renamed" present k (Just f) []
+				then queueTransfers "new file created" Next k af Upload
+				else queueTransfers "new or renamed file wanted" Next k af Download
+			handleDrops "file renamed" present k af []
   where
 	f = changeFile change
+	af = AssociatedFile (Just f)
 checkChangeContent _ = noop

Assistant/Threads/Cronner.hs

@@ -190,7 +190,7 @@ runActivity' urlrenderer (ScheduledSelfFsck _ d) = do
 	void $ repairWhenNecessary urlrenderer u Nothing fsckresults
 	mapM_ reget =<< liftAnnex (dirKeys gitAnnexBadDir)
   where
-	reget k = queueTransfers "fsck found bad file; redownloading" Next k Nothing Download
+	reget k = queueTransfers "fsck found bad file; redownloading" Next k (AssociatedFile Nothing) Download
 runActivity' urlrenderer (ScheduledRemoteFsck u s d) = dispatch =<< liftAnnex (remoteFromUUID u)
   where
 	dispatch Nothing = debug ["skipping remote fsck of uuid without a configured remote", fromUUID u, fromSchedule s]

Assistant/Threads/SanityChecker.hs

@@ -190,8 +190,8 @@ dailyCheck urlrenderer = do
 	unused <- liftAnnex unusedKeys'
 	void $ liftAnnex $ setUnusedKeys unused
 	forM_ unused $ \k -> do
-		unlessM (queueTransfers "unused" Later k Nothing Upload) $
-			handleDrops "unused" True k Nothing []
+		unlessM (queueTransfers "unused" Later k (AssociatedFile Nothing) Upload) $
+			handleDrops "unused" True k (AssociatedFile Nothing) []
 
 	return True
   where

Assistant/Threads/TransferScanner.hs

@@ -154,8 +154,9 @@ expensiveScan urlrenderer rs = batch <~> do
 
 	enqueue f (r, t) =
 		queueTransferWhenSmall "expensive scan found missing object"
-			(Just f) t r
+			(AssociatedFile (Just f)) t r
 	findtransfers f unwanted key = do
+		let af = AssociatedFile (Just f)
 		{- The syncable remotes may have changed since this
 		 - scan began. -}
 		syncrs <- syncDataRemotes <$> getDaemonStatus
@@ -163,14 +164,14 @@ expensiveScan urlrenderer rs = batch <~> do
 		present <- liftAnnex $ inAnnex key
 		liftAnnex $ handleDropsFrom locs syncrs
 			"expensive scan found too many copies of object"
-			present key (Just f) [] callCommandAction
+			present key af [] callCommandAction
 		liftAnnex $ do
 			let slocs = S.fromList locs
 			let use a = return $ mapMaybe (a key slocs) syncrs
 			ts <- if present
-				then filterM (wantSend True (Just key) (Just f) . Remote.uuid . fst)
+				then filterM (wantSend True (Just key) af . Remote.uuid . fst)
 					=<< use (genTransfer Upload False)
-				else ifM (wantGet True (Just key) (Just f))
+				else ifM (wantGet True (Just key) af)
 					( use (genTransfer Download True) , return [] )
 			let unwanted' = S.difference unwanted slocs
 			return (unwanted', ts)

Assistant/TransferSlots.hs

@@ -153,10 +153,11 @@ genTransfer t info = case transferRemote info of
 	 -}
 	go remote transferrer = ifM (liftIO $ performTransfer transferrer t info)
 		( do
-			maybe noop
-				(void . addAlert . makeAlertFiller True 
-					. transferFileAlert direction True)
-				(associatedFile info)
+			case associatedFile info of
+				AssociatedFile Nothing -> noop
+				AssociatedFile (Just af) -> void $ 
+					addAlert $ makeAlertFiller True $
+						transferFileAlert direction True af
 			unless isdownload $
 				handleDrops
 					("object uploaded to " ++ show remote)

Assistant/Upgrade.hs

@@ -85,7 +85,7 @@ startDistributionDownload d = go =<< liftIO . newVersionLocation d =<< liftIO ol
 		hook <- asIO1 $ distributionDownloadComplete d dest cleanup
 		modifyDaemonStatus_ $ \s -> s
 			{ transferHook = M.insert k hook (transferHook s) }
-		maybe noop (queueTransfer "upgrade" Next (Just f) t)
+		maybe noop (queueTransfer "upgrade" Next (AssociatedFile (Just f)) t)
 			=<< liftAnnex (remoteFromUUID webUUID)
 		startTransfer t
 	k = distributionKey d

Assistant/WebApp/DashBoard.hs

@@ -43,6 +43,9 @@ transfersDisplay = do
 	ident = "transfers"
 	isrunning info = not $
 		transferPaused info || isNothing (startedTime info)
+	desc transfer info = case associatedFile info of
+		AssociatedFile Nothing -> key2file $ transferKey transfer
+		AssociatedFile (Just af) -> af
 
 {- Simplifies a list of transfers, avoiding display of redundant
  - equivilant transfers. -}