finished hlinting
This commit is contained in:
parent
57adb0347b
commit
eeae910242
23 changed files with 144 additions and 159 deletions
|
@ -28,7 +28,7 @@ seek = [withFilesNotInGit start, withFilesUnlocked start]
|
|||
start :: SubCmdStartBackendFile
|
||||
start pair@(file, _) = notAnnexed file $ do
|
||||
s <- liftIO $ getSymbolicLinkStatus file
|
||||
if ((isSymbolicLink s) || (not $ isRegularFile s))
|
||||
if (isSymbolicLink s) || (not $ isRegularFile s)
|
||||
then return Nothing
|
||||
else do
|
||||
showStart "add" file
|
||||
|
@ -37,7 +37,7 @@ start pair@(file, _) = notAnnexed file $ do
|
|||
perform :: (FilePath, Maybe Backend) -> SubCmdPerform
|
||||
perform (file, backend) = do
|
||||
stored <- Backend.storeFileKey file backend
|
||||
case (stored) of
|
||||
case stored of
|
||||
Nothing -> return Nothing
|
||||
Just (key, _) -> return $ Just $ cleanup file key
|
||||
|
||||
|
|
|
@ -24,7 +24,7 @@ seek = [withFilesInGit start]
|
|||
start :: SubCmdStartString
|
||||
start file = isAnnexed file $ \(key, backend) -> do
|
||||
inbackend <- Backend.hasKey key
|
||||
if (not inbackend)
|
||||
if not inbackend
|
||||
then return Nothing
|
||||
else do
|
||||
showStart "drop" file
|
||||
|
@ -33,13 +33,13 @@ start file = isAnnexed file $ \(key, backend) -> do
|
|||
perform :: Key -> Backend -> SubCmdPerform
|
||||
perform key backend = do
|
||||
success <- Backend.removeKey backend key
|
||||
if (success)
|
||||
if success
|
||||
then return $ Just $ cleanup key
|
||||
else return Nothing
|
||||
|
||||
cleanup :: Key -> SubCmdCleanup
|
||||
cleanup key = do
|
||||
inannex <- inAnnex key
|
||||
when (inannex) $ removeAnnex key
|
||||
when inannex $ removeAnnex key
|
||||
logStatus key ValueMissing
|
||||
return True
|
||||
|
|
|
@ -22,12 +22,12 @@ seek = [withKeys start]
|
|||
start :: SubCmdStartString
|
||||
start keyname = do
|
||||
backends <- Backend.list
|
||||
let key = genKey (backends !! 0) keyname
|
||||
let key = genKey (head backends) keyname
|
||||
present <- inAnnex key
|
||||
force <- Annex.flagIsSet "force"
|
||||
if (not present)
|
||||
if not present
|
||||
then return Nothing
|
||||
else if (not force)
|
||||
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" keyname
|
||||
|
|
|
@ -20,5 +20,5 @@ seek = [withDefault "." withFilesInGit start]
|
|||
start :: SubCmdStartString
|
||||
start file = isAnnexed file $ \(key, _) -> do
|
||||
exists <- inAnnex key
|
||||
when (exists) $ liftIO $ putStrLn file
|
||||
when exists $ liftIO $ putStrLn file
|
||||
return Nothing
|
||||
|
|
|
@ -25,7 +25,7 @@ start :: SubCmdStartString
|
|||
start file = isAnnexed file $ \(key, _) -> do
|
||||
link <- calcGitLink file key
|
||||
l <- liftIO $ readSymbolicLink file
|
||||
if (link == l)
|
||||
if link == l
|
||||
then return Nothing
|
||||
else do
|
||||
showStart "fix" file
|
||||
|
|
|
@ -29,10 +29,10 @@ start file = do
|
|||
keyname <- Annex.flagGet "key"
|
||||
when (null keyname) $ error "please specify the key with --key"
|
||||
backends <- Backend.list
|
||||
let key = genKey (backends !! 0) keyname
|
||||
let key = genKey (head backends) keyname
|
||||
|
||||
inbackend <- Backend.hasKey key
|
||||
unless (inbackend) $ error $
|
||||
unless inbackend $ error $
|
||||
"key ("++keyname++") is not present in backend"
|
||||
showStart "fromkey" file
|
||||
return $ Just $ perform file key
|
||||
|
|
|
@ -24,6 +24,6 @@ start file = isAnnexed file $ \(key, backend) -> do
|
|||
perform :: Key -> Backend -> SubCmdPerform
|
||||
perform key backend = do
|
||||
success <- Backend.fsckKey backend key
|
||||
if (success)
|
||||
if success
|
||||
then return $ Just $ return True
|
||||
else return Nothing
|
||||
|
|
|
@ -24,6 +24,6 @@ start file = isAnnexed file $ \(key, backend) -> do
|
|||
perform :: Key -> Backend -> SubCmdPerform
|
||||
perform key backend = do
|
||||
success <- Backend.fsckKey backend key
|
||||
if (success)
|
||||
if success
|
||||
then return $ Just $ return True
|
||||
else return Nothing
|
||||
|
|
|
@ -20,7 +20,7 @@ seek = [withFilesInGit start]
|
|||
start :: SubCmdStartString
|
||||
start file = isAnnexed file $ \(key, backend) -> do
|
||||
inannex <- inAnnex key
|
||||
if (inannex)
|
||||
if inannex
|
||||
then return Nothing
|
||||
else do
|
||||
showStart "get" file
|
||||
|
@ -29,7 +29,7 @@ start file = isAnnexed file $ \(key, backend) -> do
|
|||
perform :: Key -> Backend -> SubCmdPerform
|
||||
perform key backend = do
|
||||
ok <- getViaTmp key (Backend.retrieveKeyFile backend key)
|
||||
if (ok)
|
||||
if ok
|
||||
then return $ Just $ return True -- no cleanup needed
|
||||
else return Nothing
|
||||
|
||||
|
|
|
@ -25,8 +25,8 @@ seek = [withString start]
|
|||
{- Stores description for the repository etc. -}
|
||||
start :: SubCmdStartString
|
||||
start description = do
|
||||
when (null description) $ error $
|
||||
"please specify a description of this repository\n"
|
||||
when (null description) $
|
||||
error "please specify a description of this repository\n"
|
||||
showStart "init" description
|
||||
return $ Just $ perform description
|
||||
|
||||
|
@ -38,7 +38,7 @@ perform description = do
|
|||
setVersion
|
||||
liftIO $ gitAttributes g
|
||||
liftIO $ gitPreCommitHook g
|
||||
return $ Just $ cleanup
|
||||
return $ Just cleanup
|
||||
|
||||
cleanup :: SubCmdCleanup
|
||||
cleanup = do
|
||||
|
@ -53,7 +53,7 @@ cleanup = do
|
|||
gitAttributes :: Git.Repo -> IO ()
|
||||
gitAttributes repo = do
|
||||
exists <- doesFileExist attributes
|
||||
if (not exists)
|
||||
if not exists
|
||||
then do
|
||||
writeFile attributes $ attrLine ++ "\n"
|
||||
commit
|
||||
|
@ -76,7 +76,7 @@ gitPreCommitHook repo = do
|
|||
let hook = Git.workTree repo ++ "/" ++ Git.gitDir repo ++
|
||||
"/hooks/pre-commit"
|
||||
exists <- doesFileExist hook
|
||||
if (exists)
|
||||
if exists
|
||||
then putStrLn $ "pre-commit hook (" ++ hook ++ ") already exists, not configuring"
|
||||
else do
|
||||
writeFile hook $ "#!/bin/sh\n" ++
|
||||
|
|
|
@ -7,8 +7,7 @@
|
|||
|
||||
module Command.Move where
|
||||
|
||||
import Control.Monad.State (liftIO)
|
||||
import Monad (when)
|
||||
import Control.Monad.State (liftIO, when)
|
||||
|
||||
import Command
|
||||
import qualified Command.Drop
|
||||
|
@ -53,7 +52,7 @@ start file = do
|
|||
moveToStart :: SubCmdStartString
|
||||
moveToStart file = isAnnexed file $ \(key, _) -> do
|
||||
ishere <- inAnnex key
|
||||
if (not ishere)
|
||||
if not ishere
|
||||
then return Nothing -- not here, so nothing to do
|
||||
else do
|
||||
showStart "move" file
|
||||
|
@ -68,10 +67,10 @@ moveToPerform key = do
|
|||
showNote $ show err
|
||||
return Nothing
|
||||
Right False -> do
|
||||
showNote $ "moving to " ++ (Git.repoDescribe remote) ++ "..."
|
||||
let tmpfile = (annexTmpLocation remote) ++ (keyFile key)
|
||||
showNote $ "moving to " ++ Git.repoDescribe remote ++ "..."
|
||||
let tmpfile = annexTmpLocation remote ++ keyFile key
|
||||
ok <- Remotes.copyToRemote remote key tmpfile
|
||||
if (ok)
|
||||
if ok
|
||||
then return $ Just $ moveToCleanup remote key tmpfile
|
||||
else return Nothing -- failed
|
||||
Right True -> return $ Just $ Command.Drop.cleanup key
|
||||
|
@ -79,7 +78,7 @@ moveToCleanup :: Git.Repo -> Key -> FilePath -> SubCmdCleanup
|
|||
moveToCleanup remote key tmpfile = do
|
||||
-- Tell remote to use the transferred content.
|
||||
ok <- Remotes.runCmd remote "git-annex" ["setkey", "--quiet",
|
||||
"--backend=" ++ (backendName key),
|
||||
"--backend=" ++ backendName key,
|
||||
"--key=" ++ keyName key,
|
||||
tmpfile]
|
||||
if ok
|
||||
|
@ -104,7 +103,7 @@ moveFromStart :: SubCmdStartString
|
|||
moveFromStart file = isAnnexed file $ \(key, _) -> do
|
||||
remote <- Remotes.commandLineRemote
|
||||
l <- Remotes.keyPossibilities key
|
||||
if (null $ filter (\r -> Remotes.same r remote) l)
|
||||
if null $ filter (\r -> Remotes.same r remote) l
|
||||
then return Nothing
|
||||
else do
|
||||
showStart "move" file
|
||||
|
@ -113,18 +112,18 @@ moveFromPerform :: Key -> SubCmdPerform
|
|||
moveFromPerform key = do
|
||||
remote <- Remotes.commandLineRemote
|
||||
ishere <- inAnnex key
|
||||
if (ishere)
|
||||
if ishere
|
||||
then return $ Just $ moveFromCleanup remote key
|
||||
else do
|
||||
showNote $ "moving from " ++ (Git.repoDescribe remote) ++ "..."
|
||||
ok <- getViaTmp key (Remotes.copyFromRemote remote key)
|
||||
if (ok)
|
||||
showNote $ "moving from " ++ Git.repoDescribe remote ++ "..."
|
||||
ok <- getViaTmp key $ Remotes.copyFromRemote remote key
|
||||
if ok
|
||||
then return $ Just $ moveFromCleanup remote key
|
||||
else return Nothing -- fail
|
||||
moveFromCleanup :: Git.Repo -> Key -> SubCmdCleanup
|
||||
moveFromCleanup remote key = do
|
||||
ok <- Remotes.runCmd remote "git-annex" ["dropkey", "--quiet", "--force",
|
||||
"--backend=" ++ (backendName key),
|
||||
"--backend=" ++ backendName key,
|
||||
keyName key]
|
||||
when ok $ do
|
||||
-- Record locally that the key is not on the remote.
|
||||
|
|
|
@ -28,7 +28,7 @@ start file = return $ Just $ perform file
|
|||
perform :: FilePath -> SubCmdPerform
|
||||
perform file = do
|
||||
pairs <- Backend.chooseBackends [file]
|
||||
ok <- doSubCmd $ Command.Add.start $ pairs !! 0
|
||||
ok <- doSubCmd $ Command.Add.start $ head pairs
|
||||
if ok
|
||||
then return $ Just $ cleanup file
|
||||
else error $ "failed to add " ++ file ++ "; canceling commit"
|
||||
|
|
|
@ -28,7 +28,7 @@ start file = do
|
|||
keyname <- Annex.flagGet "key"
|
||||
when (null keyname) $ error "please specify the key with --key"
|
||||
backends <- Backend.list
|
||||
let key = genKey (backends !! 0) keyname
|
||||
let key = genKey (head backends) keyname
|
||||
showStart "setkey" file
|
||||
return $ Just $ perform file key
|
||||
perform :: FilePath -> Key -> SubCmdPerform
|
||||
|
|
|
@ -34,7 +34,7 @@ perform file key backend = do
|
|||
-- force backend to always remove
|
||||
Annex.flagChange "force" $ FlagBool True
|
||||
ok <- Backend.removeKey backend key
|
||||
if (ok)
|
||||
if ok
|
||||
then return $ Just $ cleanup file key
|
||||
else return Nothing
|
||||
|
||||
|
|
|
@ -35,7 +35,7 @@ checkUnused :: Annex Bool
|
|||
checkUnused = do
|
||||
showNote "checking for unused data..."
|
||||
unused <- unusedKeys
|
||||
if (null unused)
|
||||
if null unused
|
||||
then return True
|
||||
else do
|
||||
let list = number 1 unused
|
||||
|
@ -48,9 +48,10 @@ checkUnused = do
|
|||
w u = unlines $
|
||||
["Some annexed data is no longer pointed to by any files in the repository:",
|
||||
" NUMBER KEY"]
|
||||
++ (map (\(n, k) -> " " ++ (pad 6 $ show n) ++ " " ++ show k) u) ++
|
||||
++ map cols u ++
|
||||
["(To see where data was previously used, try: git log --stat -S'KEY')",
|
||||
"(To remove unwanted data: git-annex dropunused NUMBER)"]
|
||||
cols (n,k) = " " ++ pad 6 (show n) ++ " " ++ show k
|
||||
pad n s = s ++ replicate (n - length s) ' '
|
||||
|
||||
number :: Integer -> [a] -> [(Integer, a)]
|
||||
|
@ -71,8 +72,7 @@ unusedKeys = do
|
|||
let unused_m = remove referenced present_m
|
||||
return $ M.keys unused_m
|
||||
where
|
||||
remove [] m = m
|
||||
remove (x:xs) m = remove xs $ M.delete x m
|
||||
remove a b = foldl (flip M.delete) b a
|
||||
|
||||
existsMap :: Ord k => [k] -> M.Map k Int
|
||||
existsMap l = M.fromList $ map (\k -> (k, 1)) l
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue