hlinted a few files

This commit is contained in:
Joey Hess 2010-11-06 17:07:11 -04:00
parent 016b6a59e7
commit a3519c365f
5 changed files with 32 additions and 34 deletions

View file

@ -50,9 +50,9 @@ new gitrepo allbackends = do
{- performs an action in the Annex monad -}
run :: AnnexState -> StateT AnnexState IO a -> IO (a, AnnexState)
run state action = runStateT (action) state
run state action = runStateT action state
eval :: AnnexState -> StateT AnnexState IO a -> IO a
eval state action = evalStateT (action) state
eval state action = evalStateT action state
{- Returns the git repository being acted on -}
gitRepo :: Annex Git.Repo

View file

@ -53,7 +53,7 @@ list = do
let l' = if (not $ null backendflag)
then (lookupBackendName bs backendflag):defaults
else defaults
Annex.backendsChange $ l'
Annex.backendsChange l'
return l'
where
parseBackendList bs s =
@ -71,7 +71,7 @@ maybeLookupBackendName :: [Backend] -> String -> Maybe Backend
maybeLookupBackendName bs s =
if ((length matches) /= 1)
then Nothing
else Just $ matches !! 0
else Just $ head matches
where matches = filter (\b -> s == Internals.name b) bs
{- Attempts to store a file in one of the backends. -}
@ -88,14 +88,13 @@ storeFileKey' :: [Backend] -> FilePath -> FilePath -> Annex (Maybe (Key, Backend
storeFileKey' [] _ _ = return Nothing
storeFileKey' (b:bs) file relfile = do
result <- (Internals.getKey b) relfile
case (result) of
case result of
Nothing -> nextbackend
Just key -> do
stored <- (Internals.storeFileKey b) file key
if (not stored)
then nextbackend
else do
return $ Just (key, b)
else return $ Just (key, b)
where
nextbackend = storeFileKey' bs file relfile
@ -127,8 +126,8 @@ lookupFile file = do
getsymlink = do
l <- readSymbolicLink file
return $ takeFileName l
makekey bs l = do
case maybeLookupBackendName bs $ bname of
makekey bs l =
case maybeLookupBackendName bs bname of
Nothing -> do
unless (null kname || null bname) $
warning skip

14
Core.hs
View file

@ -13,7 +13,7 @@ import System.Directory
import Control.Monad.State (liftIO)
import System.Path
import Data.String.Utils
import Monad (when, unless)
import Control.Monad (when, unless)
import Types
import Locations
@ -40,7 +40,7 @@ tryRun' state errnum (a:as) = do
Right (True,state') -> tryRun' state' errnum as
Right (False,state') -> tryRun' state' (errnum + 1) as
tryRun' _ errnum [] =
when (errnum > 0) $ error $ (show errnum) ++ " failed"
when (errnum > 0) $ error $ show errnum ++ " failed"
{- Sets up a git repo for git-annex. -}
startup :: Annex Bool
@ -63,7 +63,7 @@ shutdown = do
-- the tmp directory itself
let tmp = annexTmpLocation g
exists <- liftIO $ doesDirectoryExist tmp
when (exists) $ liftIO $ removeDirectoryRecursive $ tmp
when (exists) $ liftIO $ removeDirectoryRecursive tmp
liftIO $ createDirectoryIfMissing True tmp
return True
@ -93,7 +93,7 @@ gitAttributes repo = do
{- set up a git pre-commit hook, if one is not already present -}
gitPreCommitHook :: Git.Repo -> IO ()
gitPreCommitHook repo = do
let hook = (Git.workTree repo) ++ "/" ++ (Git.gitDir repo) ++
let hook = Git.workTree repo ++ "/" ++ Git.gitDir repo ++
"/hooks/pre-commit"
exists <- doesFileExist hook
if (exists)
@ -120,7 +120,7 @@ calcGitLink file key = do
let absfile = case (absNormPath cwd file) of
Just f -> f
Nothing -> error $ "unable to normalize " ++ file
return $ (relPathDirToDir (parentDir absfile) (Git.workTree g)) ++
return $ relPathDirToDir (parentDir absfile) (Git.workTree g) ++
annexLocationRelative key
{- Updates the LocationLog when a key's presence changes. -}
@ -138,7 +138,7 @@ getViaTmp :: Key -> (FilePath -> Annex Bool) -> Annex Bool
getViaTmp key action = do
g <- Annex.gitRepo
let dest = annexLocation g key
let tmp = (annexTmpLocation g) ++ (keyFile key)
let tmp = annexTmpLocation g ++ keyFile key
liftIO $ createDirectoryIfMissing True (parentDir tmp)
success <- action tmp
if (success)
@ -165,7 +165,7 @@ showNote s = verbose $ do
liftIO $ putStr $ "(" ++ s ++ ") "
liftIO $ hFlush stdout
showProgress :: Annex ()
showProgress = verbose $ liftIO $ putStr $ "\n"
showProgress = verbose $ liftIO $ putStr "\n"
showLongNote :: String -> Annex ()
showLongNote s = verbose $ do
liftIO $ putStr $ "\n" ++ indented

View file

@ -16,7 +16,7 @@ import qualified Data.Map as M
import System.IO
import System.Cmd.Utils
import Data.String.Utils
import Monad (unless)
import Control.Monad (unless)
import qualified GitRepo as Git
@ -57,5 +57,5 @@ runAction repo action files = do
where
runxargs = pOpen WriteToPipe "xargs" ("-0":gitcmd) feedxargs
gitcmd = ["git"] ++ Git.gitCommandLine repo
((getSubcommand action):(getParams action))
(getSubcommand action:getParams action)
feedxargs h = hPutStr h $ join "\0" files

View file

@ -43,8 +43,8 @@ module GitRepo (
prop_idempotent_deencode
) where
import Monad (unless)
import Directory
import Control.Monad (unless)
import System.Directory
import System.Posix.Directory
import System.Path
import System.Cmd.Utils
@ -53,11 +53,11 @@ import Data.String.Utils
import System.IO
import qualified Data.Map as Map hiding (map, split)
import Network.URI
import Maybe
import Char
import Text.Printf
import Data.Maybe
import Data.Char
import Data.Word (Word8)
import Codec.Binary.UTF8.String (encode)
import Text.Printf
import Utility
@ -127,31 +127,31 @@ assertLocal :: Repo -> a -> a
assertLocal repo action =
if (not $ repoIsUrl repo)
then action
else error $ "acting on URL git repo " ++ (repoDescribe repo) ++
else error $ "acting on URL git repo " ++ repoDescribe repo ++
" not supported"
assertUrl :: Repo -> a -> a
assertUrl repo action =
if (repoIsUrl repo)
then action
else error $ "acting on local git repo " ++ (repoDescribe repo) ++
else error $ "acting on local git repo " ++ repoDescribe repo ++
" not supported"
assertSsh :: Repo -> a -> a
assertSsh repo action =
if (repoIsSsh repo)
then action
else error $ "unsupported url in repo " ++ (repoDescribe repo)
else error $ "unsupported url in repo " ++ repoDescribe repo
bare :: Repo -> Bool
bare repo = case Map.lookup "core.bare" $ config repo of
Just v -> configTrue v
Nothing -> error $ "it is not known if git repo " ++
(repoDescribe repo) ++
repoDescribe repo ++
" is a bare repository; config not read"
{- Path to a repository's gitattributes file. -}
attributes :: Repo -> String
attributes repo
| bare repo = (workTree repo) ++ "/info/.gitattributes"
| otherwise = (workTree repo) ++ "/.gitattributes"
| bare repo = workTree repo ++ "/info/.gitattributes"
| otherwise = workTree repo ++ "/.gitattributes"
{- Path to a repository's .git directory, relative to its workTree. -}
gitDir :: Repo -> String
@ -176,7 +176,7 @@ relative repo@(Repo { location = Dir d }) file = drop (length absrepo) absfile
-- will be substring of file
absrepo = case (absNormPath "/" d) of
Just f -> f ++ "/"
Nothing -> error $ "bad repo" ++ (repoDescribe repo)
Nothing -> error $ "bad repo" ++ repoDescribe repo
absfile = case (secureAbsNormPath absrepo file) of
Just f -> f
Nothing -> error $ file ++ " is not located inside git repository " ++ absrepo
@ -185,7 +185,7 @@ relative repo _ = assertLocal repo $ error "internal"
{- Hostname of an URL repo. (May include a username and/or port too.) -}
urlHost :: Repo -> String
urlHost Repo { location = Url u } = uriUserInfo a ++ uriRegName a ++ uriPort a
where a = fromJust $ uriAuthority $ u
where a = fromJust $ uriAuthority u
urlHost repo = assertUrl repo $ error "internal"
{- Path of an URL repo. -}
@ -204,14 +204,13 @@ gitCommandLine repo _ = assertLocal repo $ error "internal"
run :: Repo -> [String] -> IO ()
run repo params = assertLocal repo $ do
ok <- boolSystem "git" (gitCommandLine repo params)
unless (ok) $ error $ "git " ++ (show params) ++ " failed"
unless (ok) $ error $ "git " ++ show params ++ " failed"
{- Runs a git subcommand and returns its output. -}
pipeRead :: Repo -> [String] -> IO String
pipeRead repo params = assertLocal repo $ do
pOpen ReadFromPipe "git" (gitCommandLine repo params) $ \h -> do
ret <- hGetContentsStrict h
return ret
hGetContentsStrict h
{- Like pipeRead, but does not read output strictly; recommended
- for git commands that produce a lot of output that will be processed