diff options
author | Joey Hess <joey@kitenet.net> | 2011-10-31 16:46:51 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-10-31 17:22:55 -0400 |
commit | 3d2a9f84051e9dc705ba4bb4828af691e479ae0e (patch) | |
tree | f99ff17d8fa860d1dcf2c8ebd8552e1e80bda8b3 /Command | |
parent | 00988bcf369671bdc3b78e95e3c2ae43f4835b1c (diff) |
cleanup
Diffstat (limited to 'Command')
-rw-r--r-- | Command/Add.hs | 15 | ||||
-rw-r--r-- | Command/AddUrl.hs | 12 | ||||
-rw-r--r-- | Command/Describe.hs | 10 | ||||
-rw-r--r-- | Command/DropKey.hs | 14 | ||||
-rw-r--r-- | Command/DropUnused.hs | 3 | ||||
-rw-r--r-- | Command/InitRemote.hs | 4 | ||||
-rw-r--r-- | Command/Migrate.hs | 11 | ||||
-rw-r--r-- | Command/Reinject.hs | 12 | ||||
-rw-r--r-- | Command/Version.hs | 11 | ||||
-rw-r--r-- | Command/Whereis.hs | 6 |
10 files changed, 47 insertions, 51 deletions
diff --git a/Command/Add.hs b/Command/Add.hs index cd18f6c72..a633db7b3 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -38,11 +38,10 @@ start p@(_, file) = notBareRepo $ notAnnexed file $ do next $ perform p perform :: BackendFile -> CommandPerform -perform (backend, file) = do - k <- Backend.genKey file backend - case k of - Nothing -> stop - Just (key, _) -> do +perform (backend, file) = Backend.genKey file backend >>= go + where + go Nothing = stop + go (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 - let mtime = modificationTime s - liftIO $ touch file (TimeSpec mtime) False + liftIO $ do + mtime <- modificationTime <$> getFileStatus file + touch file (TimeSpec mtime) False force <- Annex.getState Annex.force if force diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 4382a9c07..b717e271d 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -26,15 +26,14 @@ seek :: [CommandSeek] seek = [withStrings start] start :: String -> CommandStart -start s = notBareRepo $ do - let u = parseURI s - case u of - Nothing -> error $ "bad url " ++ s - Just url -> do +start s = notBareRepo $ go $ parseURI s + where + go Nothing = error $ "bad url " ++ s + go (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 diff --git a/Command/Describe.hs b/Command/Describe.hs index 882a0e1bb..1cc81bcbd 100644 --- a/Command/Describe.hs +++ b/Command/Describe.hs @@ -20,15 +20,11 @@ seek :: [CommandSeek] seek = [withWords start] start :: [String] -> CommandStart -start ws = do - let (name, description) = - case ws of - (n:d) -> (n,unwords d) - _ -> error "Specify a repository and a description." - +start (name:description) = do 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 diff --git a/Command/DropKey.hs b/Command/DropKey.hs index d00bb6c83..cac955b4a 100644 --- a/Command/DropKey.hs +++ b/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 - then error "dropkey is can cause data loss; use --force if you're sure you want to do this" - else do - showStart "dropkey" (show key) - next $ perform key + else do + checkforced + showStart "dropkey" (show 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 diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 07ae1b48c..70dcc4cc7 100644 --- a/Command/DropUnused.hs +++ b/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 - =<< liftIO (readFile f) + then M.fromList . map parse . lines <$> liftIO (readFile f) else return M.empty where parse line = (head ws, fromJust $ readKey $ unwords $ tail ws) diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index 4ba5b0787..600e17eb8 100644 --- a/Command/InitRemote.hs +++ b/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 diff --git a/Command/Migrate.hs b/Command/Migrate.hs index a68582996..2d4d24a22 100644 --- a/Command/Migrate.hs +++ b/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 - -- 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 + ok <- link src newkey 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 diff --git a/Command/Reinject.hs b/Command/Reinject.hs index 63309aa52..3de24f3fc 100644 --- a/Command/Reinject.hs +++ b/Command/Reinject.hs @@ -21,9 +21,11 @@ seek :: [CommandSeek] seek = [withWords start] start :: [FilePath] -> CommandStart -start (src:dest:[]) = do - showStart "reinject" dest - next $ perform src dest +start (src:dest:[]) + | src == dest = stop + | 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 - then liftIO $ boolSystem "mv" [File src, File tmp] - else return True + liftIO $ boolSystem "mv" [File src, File tmp] cleanup :: Key -> Backend Annex -> CommandCleanup cleanup key backend = do diff --git a/Command/Version.hs b/Command/Version.hs index 5a45fd77f..a58426482 100644 --- a/Command/Version.hs +++ b/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 $ putStrLn $ "default repository version: " ++ defaultVersion - liftIO $ putStrLn $ "supported repository versions: " ++ vs supportedVersions - liftIO $ putStrLn $ "upgrade supported from repository versions: " ++ vs upgradableVersions + liftIO $ do + putStrLn $ "git-annex version: " ++ SysConfig.packageversion + putStrLn $ "local repository version: " ++ fromMaybe "unknown" v + putStrLn $ "default repository version: " ++ defaultVersion + putStrLn $ "supported repository versions: " ++ vs supportedVersions + putStrLn $ "upgrade supported from repository versions: " ++ vs upgradableVersions stop where vs = join " " diff --git a/Command/Whereis.hs b/Command/Whereis.hs index 7799af08c..0681bfba1 100644 --- a/Command/Whereis.hs +++ b/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) $ - showLongNote pp + unless (null safelocations) $ showLongNote pp pp' <- prettyPrintUUIDs "untrusted" untrustedlocations - unless (null untrustedlocations) $ - showLongNote $ untrustedheader ++ pp' + unless (null untrustedlocations) $ showLongNote $ untrustedheader ++ pp' if null safelocations then stop else next $ return True where copiesplural 1 = "copy" |