AssociatedFile newtype

To prevent any further mistakes like 1a497cefb47557f0b4788c606f9071be422b2511

This commit was sponsored by Francois Marier on Patreon.

4 files changed, 22 insertions, 20 deletions

diff --git a/Annex/Drop.hs b/Annex/Drop.hs
index cd0168a9f..1723bce0d 100644
--- a/Annex/Drop.hs
+++ b/Annex/Drop.hs
@@ -55,8 +55,8 @@ handleDropsFrom locs rs reason fromhere key afile preverified runner = do
 			map (`fromTopFilePath` g) <$> Database.Keys.getAssociatedFiles key
 		)
 	let fs = case afile of
-		Just f -> nub (f : l)
-		Nothing -> l
+		AssociatedFile (Just f) -> nub (f : l)
+		AssociatedFile Nothing -> l
 	n <- getcopies fs
 	void $ if fromhere && checkcopies n Nothing
 		then go fs rs n >>= dropl fs
@@ -93,9 +93,9 @@ handleDropsFrom locs rs reason fromhere key afile preverified runner = do
 
 	checkdrop fs n u a
 		| null fs = check $ -- no associated files; unused content
-			wantDrop True u (Just key) Nothing
+			wantDrop True u (Just key) (AssociatedFile Nothing)
 		| otherwise = check $
-			allM (wantDrop True u (Just key) . Just) fs
+			allM (wantDrop True u (Just key) . AssociatedFile . Just) fs
 		where
 			check c = ifM c
 				( dodrop n u a
@@ -107,7 +107,9 @@ handleDropsFrom locs rs reason fromhere key afile preverified runner = do
 			( do
 				liftIO $ debugM "drop" $ unwords
 					[ "dropped"
-					, fromMaybe (key2file key) afile
+					, case afile of
+						AssociatedFile Nothing -> key2file key
+						AssociatedFile (Just af) -> af
 					, "(from " ++ maybe "here" show u ++ ")"
 					, "(copies now " ++ show (fromNumCopies have - 1) ++ ")"
 					, ": " ++ reason
diff --git a/Annex/FileMatcher.hs b/Annex/FileMatcher.hs
index 7a418cc48..1e07a9da2 100644
--- a/Annex/FileMatcher.hs
+++ b/Annex/FileMatcher.hs
@@ -44,13 +44,13 @@ type GetFileMatcher = FilePath -> Annex (FileMatcher Annex)
 checkFileMatcher :: GetFileMatcher -> FilePath -> Annex Bool
 checkFileMatcher getmatcher file = do
 	matcher <- getmatcher file
-	checkMatcher matcher Nothing (Just file) S.empty True
+	checkMatcher matcher Nothing (AssociatedFile (Just file)) S.empty True
 
 checkMatcher :: FileMatcher Annex -> Maybe Key -> AssociatedFile -> AssumeNotPresent -> Bool -> Annex Bool
 checkMatcher matcher mkey afile notpresent d
 	| isEmpty matcher = return d
 	| otherwise = case (mkey, afile) of
-		(_, Just file) -> go =<< fileMatchInfo file
+		(_, AssociatedFile (Just file)) -> go =<< fileMatchInfo file
 		(Just key, _) -> go (MatchingKey key)
 		_ -> return d
   where
diff --git a/Annex/Notification.hs b/Annex/Notification.hs
index e61b362ad..0501c0db7 100644
--- a/Annex/Notification.hs
+++ b/Annex/Notification.hs
@@ -28,10 +28,10 @@ noNotification = NotifyWitness
 {- Wrap around an action that performs a transfer, which may run multiple
  - attempts. Displays notification when supported and when the user asked
  - for it. -}
-notifyTransfer :: Direction -> Maybe FilePath -> (NotifyWitness -> Annex Bool) -> Annex Bool
-notifyTransfer _ Nothing a = a NotifyWitness
+notifyTransfer :: Direction -> AssociatedFile -> (NotifyWitness -> Annex Bool) -> Annex Bool
+notifyTransfer _ (AssociatedFile Nothing) a = a NotifyWitness
 #ifdef WITH_DBUS_NOTIFICATIONS
-notifyTransfer direction (Just f) a = do
+notifyTransfer direction (AssociatedFile (Just f)) a = do
 	wanted <- Annex.getState Annex.desktopnotify
 	if (notifyStart wanted || notifyFinish wanted)
 		then do
@@ -47,19 +47,19 @@ notifyTransfer direction (Just f) a = do
 			return ok
 		else a NotifyWitness
 #else
-notifyTransfer _ (Just _) a = a NotifyWitness
+notifyTransfer _ (AssociatedFile (Just _)) a = a NotifyWitness
 #endif
 
-notifyDrop :: Maybe FilePath -> Bool -> Annex ()
-notifyDrop Nothing _ = noop
+notifyDrop :: AssociatedFile -> Bool -> Annex ()
+notifyDrop (AssociatedFile Nothing) _ = noop
 #ifdef WITH_DBUS_NOTIFICATIONS
-notifyDrop (Just f) ok = do
+notifyDrop (AssociatedFile (Just f)) ok = do
 	wanted <- Annex.getState Annex.desktopnotify
 	when (notifyFinish wanted) $ liftIO $ do
 		client <- DBus.Client.connectSession
 		void $ Notify.notify client (droppedNote ok f)
 #else
-notifyDrop (Just _) _ = noop
+notifyDrop (AssociatedFile (Just _)) _ = noop
 #endif
 
 #ifdef WITH_DBUS_NOTIFICATIONS
diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs
index 0b794b379..87480b2f1 100644
--- a/Annex/Transfer.hs
+++ b/Annex/Transfer.hs
@@ -77,7 +77,7 @@ guardHaveUUID u a
  - An upload can be run from a read-only filesystem, and in this case
  - no transfer information or lock file is used.
  -}
-runTransfer :: Observable v => Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v
+runTransfer :: Observable v => Transfer -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v
 runTransfer = runTransfer' False
 
 {- Like runTransfer, but ignores any existing transfer lock file for the
@@ -85,12 +85,12 @@ runTransfer = runTransfer' False
  -
  - Note that this may result in confusing progress meter display in the
  - webapp, if multiple processes are writing to the transfer info file. -}
-alwaysRunTransfer :: Observable v => Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v
+alwaysRunTransfer :: Observable v => Transfer -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v
 alwaysRunTransfer = runTransfer' True
 
-runTransfer' :: Observable v => Bool -> Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v
-runTransfer' ignorelock t file shouldretry transferaction = checkSecureHashes t $ do
-	info <- liftIO $ startTransferInfo file
+runTransfer' :: Observable v => Bool -> Transfer -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v
+runTransfer' ignorelock t afile shouldretry transferaction = checkSecureHashes t $ do
+	info <- liftIO $ startTransferInfo afile
 	(meter, tfile, metervar) <- mkProgressUpdater t info
 	mode <- annexFileMode
 	(lck, inprogress) <- prep tfile mode info