summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-03-16 01:59:07 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-03-16 01:59:07 -0400
commit184a69171d5d983ee2f08cce28011d235f44cc5c (patch)
treeff85fc620618b55c8cbed0d8c99212e73004f5b5
parentc0c9991c9f5322aef05f4c97d2c3f3bdc3101e46 (diff)
removed another 10 lines via ifM
-rw-r--r--Git.hs24
-rw-r--r--Git/Branch.hs10
-rw-r--r--Git/Config.hs13
-rw-r--r--Git/Construct.hs59
-rw-r--r--Init.hs10
-rw-r--r--Logs/Presence.hs7
-rw-r--r--Logs/Remote.hs9
-rw-r--r--Upgrade/V0.hs13
-rw-r--r--Upgrade/V1.hs56
9 files changed, 95 insertions, 106 deletions
diff --git a/Git.hs b/Git.hs
index 9b7dccfeb..4278e9fcf 100644
--- a/Git.hs
+++ b/Git.hs
@@ -31,7 +31,6 @@ module Git (
import qualified Data.Map as M
import Data.Char
import Network.URI (uriPath, uriScheme, unEscapeString)
-import System.Directory
import System.Posix.Files
import Common
@@ -83,11 +82,14 @@ repoIsLocalBare r@(Repo { location = Dir _ }) = configAvail r && configBare r
repoIsLocalBare _ = False
assertLocal :: Repo -> a -> a
-assertLocal repo action =
- if not $ repoIsUrl repo
- then action
- else error $ "acting on non-local git repo " ++ repoDescribe repo ++
- " not supported"
+assertLocal repo action
+ | repoIsUrl repo = error $ unwords
+ [ "acting on non-local git repo"
+ , repoDescribe repo
+ , "not supported"
+ ]
+ | otherwise = action
+
configBare :: Repo -> Bool
configBare repo = maybe unknown (fromMaybe False . configTrue) $
M.lookup "core.bare" $ config repo
@@ -113,12 +115,10 @@ gitDir repo
hookPath :: String -> Repo -> IO (Maybe FilePath)
hookPath script repo = do
let hook = gitDir repo </> "hooks" </> script
- e <- doesFileExist hook
- if e
- then do
- m <- fileMode <$> getFileStatus hook
- return $ if isExecutable m then Just hook else Nothing
- else return Nothing
+ ifM (catchBoolIO $ isexecutable hook)
+ ( return $ Just hook , return Nothing )
+ where
+ isexecutable f = isExecutable . fileMode <$> getFileStatus f
{- Path to a repository's --work-tree, that is, its top.
-
diff --git a/Git/Branch.hs b/Git/Branch.hs
index cd9188228..6edc1c306 100644
--- a/Git/Branch.hs
+++ b/Git/Branch.hs
@@ -41,14 +41,14 @@ changed origbranch newbranch repo
-}
fastForward :: Branch -> [Ref] -> Repo -> IO Bool
fastForward _ [] _ = return True
-fastForward branch (first:rest) repo = do
+fastForward branch (first:rest) repo =
-- First, check that the branch does not contain any
-- new commits that are not in the first ref. If it does,
-- cannot fast-forward.
- diverged <- changed first branch repo
- if diverged
- then no_ff
- else maybe no_ff do_ff =<< findbest first rest
+ ifM (changed first branch repo)
+ ( no_ff
+ , maybe no_ff do_ff =<< findbest first rest
+ )
where
no_ff = return False
do_ff to = do
diff --git a/Git/Config.hs b/Git/Config.hs
index 0d73a0b9a..8190a62ad 100644
--- a/Git/Config.hs
+++ b/Git/Config.hs
@@ -26,16 +26,15 @@ getMaybe key repo = M.lookup key (config repo)
{- Runs git config and populates a repo with its config. -}
read :: Repo -> IO Repo
-read repo@(Repo { location = Dir d }) = do
+read repo@(Repo { location = Dir d }) = bracketcd d $
{- Cannot use pipeRead because it relies on the config having
been already read. Instead, chdir to the repo. -}
- cwd <- getCurrentDirectory
- if dirContains d cwd
- then go
- else bracket_ (changeWorkingDirectory d) (changeWorkingDirectory cwd) go
+ pOpen ReadFromPipe "git" ["config", "--null", "--list"] $ hRead repo
where
- go = pOpen ReadFromPipe "git" ["config", "--null", "--list"] $
- hRead repo
+ bracketcd to a = bracketcd' to a =<< getCurrentDirectory
+ bracketcd' to a cwd
+ | dirContains to cwd = a
+ | otherwise = bracket_ (changeWorkingDirectory to) (changeWorkingDirectory cwd) a
read r = assertLocal r $
error $ "internal error; trying to read config of " ++ show r
diff --git a/Git/Construct.hs b/Git/Construct.hs
index ef6094a21..49905f818 100644
--- a/Git/Construct.hs
+++ b/Git/Construct.hs
@@ -69,27 +69,25 @@ fromPath dir = fromAbsPath =<< absPath dir
- specified. -}
fromAbsPath :: FilePath -> IO Repo
fromAbsPath dir
- | "/" `isPrefixOf` dir = do
- -- Git always looks for "dir.git" in preference to
- -- to "dir", even if dir ends in a "/".
- let canondir = dropTrailingPathSeparator dir
- let dir' = canondir ++ ".git"
- e <- doesDirectoryExist dir'
- if e
- then ret dir'
- else if "/.git" `isSuffixOf` canondir
- then do
- -- When dir == "foo/.git", git looks
- -- for "foo/.git/.git", and failing
- -- that, uses "foo" as the repository.
- e' <- doesDirectoryExist $ dir </> ".git"
- if e'
- then ret dir
- else ret $ takeDirectory canondir
- else ret dir
- | otherwise = error $ "internal error, " ++ dir ++ " is not absolute"
+ | "/" `isPrefixOf` dir =
+ ifM (doesDirectoryExist dir') ( ret dir' , hunt )
+ | otherwise =
+ error $ "internal error, " ++ dir ++ " is not absolute"
where
ret = newFrom . Dir
+ {- Git always looks for "dir.git" in preference to
+ - to "dir", even if dir ends in a "/". -}
+ canondir = dropTrailingPathSeparator dir
+ dir' = canondir ++ ".git"
+ {- When dir == "foo/.git", git looks for "foo/.git/.git",
+ - and failing that, uses "foo" as the repository. -}
+ hunt
+ | "/.git" `isSuffixOf` canondir =
+ ifM (doesDirectoryExist $ dir </> ".git")
+ ( ret dir
+ , ret $ takeDirectory canondir
+ )
+ | otherwise = ret dir
{- Remote Repo constructor. Throws exception on invalid url.
-
@@ -229,27 +227,20 @@ expandTilde = expandt True
| otherwise = findname (n++[c]) cs
seekUp :: (FilePath -> IO Bool) -> FilePath -> IO (Maybe FilePath)
-seekUp want dir = do
- ok <- want dir
- if ok
- then return $ Just dir
- else case parentDir dir of
+seekUp want dir =
+ ifM (want dir)
+ ( return $ Just dir
+ , case parentDir dir of
"" -> return Nothing
d -> seekUp want d
+ )
isRepoTop :: FilePath -> IO Bool
-isRepoTop dir = do
- r <- isRepo
- if r
- then return r
- else isBareRepo
+isRepoTop dir = ifM isRepo ( return True , isBareRepo )
where
isRepo = gitSignature (".git" </> "config")
- isBareRepo = do
- e <- doesDirectoryExist (dir </> "objects")
- if not e
- then return e
- else gitSignature "config"
+ isBareRepo = ifM (doesDirectoryExist $ dir </> "objects")
+ ( gitSignature "config" , return False )
gitSignature file = doesFileExist (dir </> file)
newFrom :: RepoLocation -> IO Repo
diff --git a/Init.hs b/Init.hs
index f3d8bd017..9f1988a39 100644
--- a/Init.hs
+++ b/Init.hs
@@ -58,13 +58,13 @@ gitPreCommitHookWrite = unlessBare $ do
gitPreCommitHookUnWrite :: Annex ()
gitPreCommitHookUnWrite = unlessBare $ do
hook <- preCommitHook
- whenM (liftIO $ doesFileExist hook) $ do
- c <- liftIO $ readFile hook
- if c == preCommitScript
- then liftIO $ removeFile hook
- else warning $ "pre-commit hook (" ++ hook ++
+ whenM (liftIO $ doesFileExist hook) $
+ ifM (liftIO $ (==) preCommitScript <$> readFile hook)
+ ( liftIO $ removeFile hook
+ , warning $ "pre-commit hook (" ++ hook ++
") contents modified; not deleting." ++
" Edit it to remove call to git annex."
+ )
unlessBare :: Annex () -> Annex ()
unlessBare = unlessM $ fromRepo Git.repoIsLocalBare
diff --git a/Logs/Presence.hs b/Logs/Presence.hs
index 372af37d5..933426718 100644
--- a/Logs/Presence.hs
+++ b/Logs/Presence.hs
@@ -99,10 +99,9 @@ type LogMap = M.Map String LogLine
{- Inserts a log into a map of logs, if the log has better (ie, newer)
- information than the other logs in the map -}
mapLog :: LogLine -> LogMap -> LogMap
-mapLog l m =
- if better
- then M.insert i l m
- else m
+mapLog l m
+ | better = M.insert i l m
+ | otherwise = m
where
better = maybe True newer $ M.lookup i m
newer l' = date l' <= date l
diff --git a/Logs/Remote.hs b/Logs/Remote.hs
index ccfb4bb31..5c9d67df0 100644
--- a/Logs/Remote.hs
+++ b/Logs/Remote.hs
@@ -72,14 +72,15 @@ configUnEscape = unescape
unescape (c:rest)
| c == '&' = entity rest
| otherwise = c : unescape rest
- entity s = if ok
- then chr (Prelude.read num) : unescape rest
- else '&' : unescape s
+ entity s
+ | not (null num) && ";" `isPrefixOf` r =
+ chr (Prelude.read num) : unescape rest
+ | otherwise =
+ '&' : unescape s
where
num = takeWhile isNumber s
r = drop (length num) s
rest = drop 1 r
- ok = not (null num) && ";" `isPrefixOf` r
{- for quickcheck -}
prop_idempotent_configEscape :: String -> Bool
diff --git a/Upgrade/V0.hs b/Upgrade/V0.hs
index c439c7caa..8f3af337e 100644
--- a/Upgrade/V0.hs
+++ b/Upgrade/V0.hs
@@ -35,14 +35,11 @@ lookupFile0 :: FilePath -> Annex (Maybe (Key, Backend))
lookupFile0 = Upgrade.V1.lookupFile1
getKeysPresent0 :: FilePath -> Annex [Key]
-getKeysPresent0 dir = do
- exists <- liftIO $ doesDirectoryExist dir
- if not exists
- then return []
- else do
- contents <- liftIO $ getDirectoryContents dir
- files <- liftIO $ filterM present contents
- return $ map fileKey0 files
+getKeysPresent0 dir = ifM (liftIO $ doesDirectoryExist dir)
+ ( liftIO $ map fileKey0
+ <$> (filterM present =<< getDirectoryContents dir)
+ , return []
+ )
where
present d = do
result <- tryIO $
diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs
index ca2bff661..62e3b3b31 100644
--- a/Upgrade/V1.hs
+++ b/Upgrade/V1.hs
@@ -50,18 +50,18 @@ upgrade :: Annex Bool
upgrade = do
showAction "v1 to v2"
- bare <- fromRepo Git.repoIsLocalBare
- if bare
- then do
+ ifM (fromRepo Git.repoIsLocalBare)
+ ( do
moveContent
setVersion
- else do
+ , do
moveContent
updateSymlinks
moveLocationLogs
Annex.Queue.flush True
setVersion
+ )
Upgrade.V2.upgrade
@@ -104,12 +104,11 @@ moveLocationLogs = do
where
oldlocationlogs = do
dir <- fromRepo Upgrade.V2.gitStateDir
- exists <- liftIO $ doesDirectoryExist dir
- if exists
- then do
- contents <- liftIO $ getDirectoryContents dir
- return $ mapMaybe oldlog2key contents
- else return []
+ ifM (liftIO $ doesDirectoryExist dir)
+ ( mapMaybe oldlog2key
+ <$> (liftIO $ getDirectoryContents dir)
+ , return []
+ )
move (l, k) = do
dest <- fromRepo $ logFile2 k
dir <- fromRepo Upgrade.V2.gitStateDir
@@ -127,14 +126,13 @@ moveLocationLogs = do
Annex.Queue.add "rm" [Param "--quiet", Param "-f", Param "--"] [f]
oldlog2key :: FilePath -> Maybe (FilePath, Key)
-oldlog2key l =
- let len = length l - 4 in
- if drop len l == ".log"
- then let k = readKey1 (take len l) in
- if null (keyName k) || null (keyBackendName k)
- then Nothing
- else Just (l, k)
- else Nothing
+oldlog2key l
+ | drop len l == ".log" && sane = Just (l, k)
+ | otherwise = Nothing
+ where
+ len = length l - 4
+ k = readKey1 (take len l)
+ sane = (not . null $ keyName k) && (not . null $ keyBackendName k)
-- WORM backend keys: "WORM:mtime:size:filename"
-- all the rest: "backend:key"
@@ -143,10 +141,14 @@ oldlog2key l =
-- v2 and v1; that infelicity is worked around by treating the value
-- as the v2 key that it is.
readKey1 :: String -> Key
-readKey1 v =
- if mixup
- then fromJust $ readKey $ join ":" $ Prelude.tail bits
- else Key { keyName = n , keyBackendName = b, keySize = s, keyMtime = t }
+readKey1 v
+ | mixup = fromJust $ readKey $ join ":" $ Prelude.tail bits
+ | otherwise = Key
+ { keyName = n
+ , keyBackendName = b
+ , keySize = s
+ , keyMtime = t
+ }
where
bits = split ":" v
b = Prelude.head bits
@@ -205,14 +207,14 @@ lookupFile1 file = do
getKeyFilesPresent1 :: Annex [FilePath]
getKeyFilesPresent1 = getKeyFilesPresent1' =<< fromRepo gitAnnexObjectDir
getKeyFilesPresent1' :: FilePath -> Annex [FilePath]
-getKeyFilesPresent1' dir = do
- exists <- liftIO $ doesDirectoryExist dir
- if not exists
- then return []
- else do
+getKeyFilesPresent1' dir =
+ ifM (liftIO $ doesDirectoryExist dir)
+ ( do
dirs <- liftIO $ getDirectoryContents dir
let files = map (\d -> dir ++ "/" ++ d ++ "/" ++ takeFileName d) dirs
liftIO $ filterM present files
+ , return []
+ )
where
present f = do
result <- tryIO $ getFileStatus f