summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-10-31 16:46:51 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-10-31 17:22:55 -0400
commit3d2a9f84051e9dc705ba4bb4828af691e479ae0e (patch)
treef99ff17d8fa860d1dcf2c8ebd8552e1e80bda8b3
parent00988bcf369671bdc3b78e95e3c2ae43f4835b1c (diff)
cleanup
-rw-r--r--Command/Add.hs15
-rw-r--r--Command/AddUrl.hs12
-rw-r--r--Command/Describe.hs10
-rw-r--r--Command/DropKey.hs14
-rw-r--r--Command/DropUnused.hs3
-rw-r--r--Command/InitRemote.hs4
-rw-r--r--Command/Migrate.hs11
-rw-r--r--Command/Reinject.hs12
-rw-r--r--Command/Version.hs11
-rw-r--r--Command/Whereis.hs6
-rw-r--r--Init.hs4
11 files changed, 48 insertions, 54 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"
diff --git a/Init.hs b/Init.hs
index 6e024e9fc..1fac80820 100644
--- a/Init.hs
+++ b/Init.hs
@@ -65,9 +65,7 @@ gitPreCommitHookUnWrite = unlessBare $ do
" Edit it to remove call to git annex."
unlessBare :: Annex () -> Annex ()
-unlessBare a = do
- g <- gitRepo
- unless (Git.repoIsLocalBare g) a
+unlessBare = unlessM $ Git.repoIsLocalBare <$> gitRepo
preCommitHook :: Annex FilePath
preCommitHook = do