cleanup

Command/Add.hs

@@ -38,11 +38,10 @@ start p@(_, file) = notBareRepo $ notAnnexed file $ do
 			next $ perform p
 
 perform :: BackendFile -> CommandPerform
-perform (backend, file) = do
+perform (backend, file) = Backend.genKey file backend >>= go
-	k <- Backend.genKey file backend
+	where
-	case k of
+		go Nothing = stop
-		Nothing -> stop
+		go (Just (key, _)) = do
-		Just (key, _) -> do
 			handle (undo file key) $ moveAnnex key file
 			next $ cleanup file key True
 
@@ -75,9 +74,9 @@ cleanup file key hascontent = do
 	
 			-- touch the symlink to have the same mtime as the
 			-- file it points to
-			s <- liftIO $ getFileStatus file
+			liftIO $ do
-			let mtime = modificationTime s
+				mtime <- modificationTime <$> getFileStatus file
-			liftIO $ touch file (TimeSpec mtime) False
+				touch file (TimeSpec mtime) False
 
 	force <- Annex.getState Annex.force
 	if force

Command/AddUrl.hs

@@ -26,15 +26,14 @@ seek :: [CommandSeek]
 seek = [withStrings start]
 
 start :: String -> CommandStart
-start s = notBareRepo $ do
+start s = notBareRepo $ go $ parseURI s
-	let u = parseURI s
+	where
-	case u of
+		go Nothing = error $ "bad url " ++ s
-		Nothing -> error $ "bad url " ++ s
+		go (Just url) = do
-		Just url -> do
 			file <- liftIO $ url2file url
 			showStart "addurl" file
 			next $ perform s file
-			
+
 perform :: String -> FilePath -> CommandPerform
 perform url file = do
 	fast <- Annex.getState Annex.fast
@@ -64,7 +63,6 @@ nodownload :: String -> FilePath -> CommandPerform
 nodownload url file = do
 	let key = Backend.URL.fromUrl url
 	setUrlPresent key url
-	
 	next $ Command.Add.cleanup file key False
 
 url2file :: URI -> IO FilePath

Command/Describe.hs

@@ -20,15 +20,11 @@ seek :: [CommandSeek]
 seek = [withWords start]
 
 start :: [String] -> CommandStart
-start ws = do
+start (name:description) = do
-	let (name, description) =
-		case ws of
-			(n:d) -> (n,unwords d)
-			_ -> error "Specify a repository and a description."
-	
 	showStart "describe" name
 	u <- Remote.nameToUUID name
-	next $ perform u description
+	next $ perform u $ unwords description
+start _ = do error "Specify a repository and a description."	
 
 perform :: UUID -> String -> CommandPerform
 perform u description = do

Command/DropKey.hs

@@ -23,14 +23,16 @@ seek = [withKeys start]
 start :: Key -> CommandStart
 start key = do
 	present <- inAnnex key
-	force <- Annex.getState Annex.force
 	if not present
 		then stop
-		else if not force
+		else do
-			then error "dropkey is can cause data loss; use --force if you're sure you want to do this"
+			checkforced
-			else do
+			showStart "dropkey" (show key)
-				showStart "dropkey" (show key)
+			next $ perform key
-				next $ perform key
+	where
+		checkforced = 
+			unlessM (Annex.getState Annex.force) $
+				error "dropkey can cause data loss; use --force if you're sure you want to do this"
 
 perform :: Key -> CommandPerform
 perform key = do

Command/DropUnused.hs

@@ -71,8 +71,7 @@ readUnusedLog prefix = do
 	let f = gitAnnexUnusedLog prefix g
 	e <- liftIO $ doesFileExist f
 	if e
-		then return . M.fromList . map parse . lines
+		then M.fromList . map parse . lines <$> liftIO (readFile f)
-			=<< liftIO (readFile f)
 		else return M.empty
 	where
 		parse line = (head ws, fromJust $ readKey $ unwords $ tail ws)

Command/InitRemote.hs

@@ -67,7 +67,9 @@ findByName name = do
 			return (uuid, M.insert nameKey name M.empty)
 
 findByName' :: String ->  M.Map UUID R.RemoteConfig -> Maybe (UUID, R.RemoteConfig)
-findByName' n m = if null matches then Nothing else Just $ head matches
+findByName' n m
+	| null matches = Nothing
+	| otherwise = Just $ head matches
 	where
 		matches = filter (matching . snd) $ M.toList m
 		matching c = case M.lookup nameKey c of

Command/Migrate.hs

@@ -56,11 +56,7 @@ perform file oldkey newbackend = do
 	case k of
 		Nothing -> stop
 		Just (newkey, _) -> do
-			ok <- getViaTmpUnchecked newkey $ \t -> do
+			ok <- link src newkey
-				-- Make a hard link to the old backend's
-				-- cached key, to avoid wasting disk space.
-				liftIO $ unlessM (doesFileExist t) $ createLink src t
-				return True
 			if ok
 				then do
 					-- Update symlink to use the new key.
@@ -77,3 +73,8 @@ perform file oldkey newbackend = do
 				else stop
 	where
 		cleantmp t = whenM (doesFileExist t) $ removeFile t
+		link src newkey = getViaTmpUnchecked newkey $ \t -> do
+			-- Make a hard link to the old backend's
+			-- cached key, to avoid wasting disk space.
+			liftIO $ unlessM (doesFileExist t) $ createLink src t
+			return True	

Command/Reinject.hs

@@ -21,9 +21,11 @@ seek :: [CommandSeek]
 seek = [withWords start]
 
 start :: [FilePath] -> CommandStart
-start (src:dest:[]) = do
+start (src:dest:[])
-	showStart "reinject" dest
+	| src == dest = stop
-	next $ perform src dest
+	| otherwise = do
+		showStart "reinject" dest
+		next $ perform src dest
 start _ = error "specify a src file and a dest file"
 
 perform :: FilePath -> FilePath -> CommandPerform
@@ -36,9 +38,7 @@ perform src dest = isAnnexed dest $ \(key, backend) -> do
 		-- moveToObjectDir; disk space is also
 		-- checked this way.
 		move key = getViaTmp key $ \tmp ->
-			if dest /= src
+			liftIO $ boolSystem "mv" [File src, File tmp]
-			then liftIO $ boolSystem "mv" [File src, File tmp]
-			else return True
 
 cleanup :: Key -> Backend Annex -> CommandCleanup
 cleanup key backend = do

Command/Version.hs

@@ -21,12 +21,13 @@ seek = [withNothing start]
 
 start :: CommandStart
 start = do
-	liftIO $ putStrLn $ "git-annex version: " ++ SysConfig.packageversion
 	v <- getVersion
-	liftIO $ putStrLn $ "local repository version: " ++ fromMaybe "unknown" v
+	liftIO $ do
-	liftIO $ putStrLn $ "default repository version: " ++ defaultVersion
+		putStrLn $ "git-annex version: " ++ SysConfig.packageversion
-	liftIO $ putStrLn $ "supported repository versions: " ++ vs supportedVersions
+		putStrLn $ "local repository version: " ++ fromMaybe "unknown" v
-	liftIO $ putStrLn $ "upgrade supported from repository versions: " ++ vs upgradableVersions
+		putStrLn $ "default repository version: " ++ defaultVersion
+		putStrLn $ "supported repository versions: " ++ vs supportedVersions
+		putStrLn $ "upgrade supported from repository versions: " ++ vs upgradableVersions
 	stop
 	where
 		vs = join " "

Command/Whereis.hs

@@ -31,11 +31,9 @@ perform key = do
 	let num = length safelocations
 	showNote $ show num ++ " " ++ copiesplural num
 	pp <- prettyPrintUUIDs "whereis" safelocations
-	unless (null safelocations) $
+	unless (null safelocations) $ showLongNote pp
-		showLongNote pp
 	pp' <- prettyPrintUUIDs "untrusted" untrustedlocations
-	unless (null untrustedlocations) $
+	unless (null untrustedlocations) $ showLongNote $ untrustedheader ++ pp'
-		showLongNote $ untrustedheader ++ pp'
 	if null safelocations then stop else next $ return True
 	where
 		copiesplural 1 = "copy"

Init.hs

@@ -65,9 +65,7 @@ gitPreCommitHookUnWrite = unlessBare $ do
 				" Edit it to remove call to git annex."
 
 unlessBare :: Annex () -> Annex ()
-unlessBare a = do
+unlessBare = unlessM $ Git.repoIsLocalBare <$> gitRepo
-	g <- gitRepo
-	unless (Git.repoIsLocalBare g) a
 
 preCommitHook :: Annex FilePath
 preCommitHook = do