clean up cleanup action enumeration

Annex.hs

@@ -60,6 +60,7 @@ import Types.FileMatcher
 import Types.NumCopies
 import Types.LockPool
 import Types.MetaData
+import Types.CleanupActions
 import qualified Utility.Matcher
 import qualified Data.Map as M
 import qualified Data.Set as S
@@ -114,7 +115,7 @@ data AnnexState = AnnexState
 	, flags :: M.Map String Bool
 	, fields :: M.Map String String
 	, modmeta :: [ModMeta]
-	, cleanup :: M.Map String (Annex ())
+	, cleanup :: M.Map CleanupAction (Annex ())
 	, inodeschanged :: Maybe Bool
 	, useragent :: Maybe String
 	, errcounter :: Integer
@@ -210,9 +211,9 @@ setField field value = changeState $ \s ->
 	s { fields = M.insertWith' const field value $ fields s }
 
 {- Adds a cleanup action to perform. -}
-addCleanup :: String -> Annex () -> Annex ()
-addCleanup uid a = changeState $ \s ->
-	s { cleanup = M.insertWith' const uid a $ cleanup s }
+addCleanup :: CleanupAction -> Annex () -> Annex ()
+addCleanup k a = changeState $ \s ->
+	s { cleanup = M.insertWith' const k a $ cleanup s }
 
 {- Sets the type of output to emit. -}
 setOutput :: OutputType -> Annex ()

Command/Fsck.hs

@@ -29,6 +29,7 @@ import Utility.DataUnits
 import Utility.FileMode
 import Config
 import Types.Key
+import Types.CleanupActions
 import Utility.HumanTime
 import Git.FilePath
 import Utility.PID
@@ -93,7 +94,7 @@ getIncremental = do
 
 	checkschedule Nothing = error "bad --incremental-schedule value"
 	checkschedule (Just delta) = do
-		Annex.addCleanup "" $ do
+		Annex.addCleanup FsckCleanup $ do
 			v <- getStartTime
 			case v of
 				Nothing -> noop

Remote/External.hs

@@ -11,6 +11,7 @@ import Remote.External.Types
 import qualified Annex
 import Common.Annex
 import Types.Remote
+import Types.CleanupActions
 import qualified Git
 import Config
 import Remote.Helper.Special
@@ -43,7 +44,7 @@ remote = RemoteType {
 gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
 gen r u c gc = do
 	external <- newExternal externaltype u c
-	Annex.addCleanup (fromUUID u) $ stopExternal external
+	Annex.addCleanup (RemoteCleanup u) $ stopExternal external
 	cst <- getCost external r gc
 	avail <- getAvailability external r gc
 	return $ Just $ encryptableRemote c

Remote/Git.hs

@@ -36,6 +36,7 @@ import Config
 import Config.Cost
 import Annex.Init
 import Types.Key
+import Types.CleanupActions
 import qualified CmdLine.GitAnnexShell.Fields as Fields
 import Logs.Location
 import Utility.Metered
@@ -510,7 +511,7 @@ rsyncOrCopyFile rsyncparams src dest p =
 commitOnCleanup :: Remote -> Annex a -> Annex a
 commitOnCleanup r a = go `after` a
   where
-	go = Annex.addCleanup (Git.repoLocation $ repo r) cleanup
+	go = Annex.addCleanup (RemoteCleanup $ uuid r) cleanup
 	cleanup
 		| not $ Git.repoIsUrl (repo r) = onLocal r $
 			doQuietSideAction $

Remote/Helper/Hooks.hs

@@ -13,6 +13,7 @@ import qualified Data.Map as M
 
 import Common.Annex
 import Types.Remote
+import Types.CleanupActions
 import qualified Annex
 import Annex.LockPool
 #ifndef mingw32_HOST_OS
@@ -74,7 +75,7 @@ runHooks r starthook stophook a = do
 		-- So, requiring idempotency is the right approach.
 		run starthook
 
-		Annex.addCleanup (remoteid ++ "-stop-command") $ runstop lck
+		Annex.addCleanup (StopHook $ uuid r) $ runstop lck
 	runstop lck = do
 		-- Drop any shared lock we have, and take an
 		-- exclusive lock, without blocking. If the lock

Types/CleanupActions.hs

@@ -0,0 +1,16 @@
+{- Enumeration of cleanup actions
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Types.CleanupActions where
+
+import Types.UUID
+
+data CleanupAction
+	= RemoteCleanup UUID
+	| StopHook UUID
+	| FsckCleanup
+	deriving (Eq, Ord)