hlinted a few files
This commit is contained in:
parent
016b6a59e7
commit
a3519c365f
5 changed files with 32 additions and 34 deletions
4
Annex.hs
4
Annex.hs
|
@ -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
|
||||
|
|
13
Backend.hs
13
Backend.hs
|
@ -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
14
Core.hs
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
31
GitRepo.hs
31
GitRepo.hs
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue