finished hlint pass
This commit is contained in:
parent
185f0b6870
commit
6c396a256c
29 changed files with 114 additions and 115 deletions
|
@ -39,7 +39,7 @@ seek = [withFilesNotInGit start, withFilesUnlocked start]
|
|||
start :: CommandStartBackendFile
|
||||
start pair@(file, _) = notAnnexed file $ do
|
||||
s <- liftIO $ getSymbolicLinkStatus file
|
||||
if (isSymbolicLink s) || (not $ isRegularFile s)
|
||||
if isSymbolicLink s || not (isRegularFile s)
|
||||
then stop
|
||||
else do
|
||||
showStart "add" file
|
||||
|
@ -58,8 +58,8 @@ perform (file, backend) = do
|
|||
- This can be called before or after the symlink is in place. -}
|
||||
undo :: FilePath -> Key -> IOException -> Annex a
|
||||
undo file key e = do
|
||||
unlessM (inAnnex key) $ rethrow -- no cleanup to do
|
||||
liftIO $ whenM (doesFileExist file) $ do removeFile file
|
||||
unlessM (inAnnex key) rethrow -- no cleanup to do
|
||||
liftIO $ whenM (doesFileExist file) $ removeFile file
|
||||
handle tryharder $ fromAnnex key file
|
||||
logStatus key InfoMissing
|
||||
rethrow
|
||||
|
|
|
@ -49,7 +49,7 @@ start (unused, unusedbad, unusedtmp) s = notBareRepo $ search
|
|||
]
|
||||
where
|
||||
search [] = stop
|
||||
search ((m, a):rest) = do
|
||||
search ((m, a):rest) =
|
||||
case M.lookup s m of
|
||||
Nothing -> search rest
|
||||
Just key -> do
|
||||
|
@ -78,10 +78,9 @@ readUnusedLog prefix = do
|
|||
let f = gitAnnexUnusedLog prefix g
|
||||
e <- liftIO $ doesFileExist f
|
||||
if e
|
||||
then do
|
||||
l <- liftIO $ readFile f
|
||||
return $ M.fromList $ map parse $ lines l
|
||||
else return $ M.empty
|
||||
then return . M.fromList . map parse . lines
|
||||
=<< liftIO (readFile f)
|
||||
else return M.empty
|
||||
where
|
||||
parse line = (head ws, fromJust $ readKey $ unwords $ tail ws)
|
||||
where
|
||||
|
|
|
@ -94,7 +94,7 @@ fsckKey :: Backend Annex -> Key -> Maybe FilePath -> Maybe Int -> Annex Bool
|
|||
fsckKey backend key file numcopies = do
|
||||
size_ok <- checkKeySize key
|
||||
copies_ok <- checkKeyNumCopies key file numcopies
|
||||
backend_ok <-(Types.Backend.fsckKey backend) key
|
||||
backend_ok <- (Types.Backend.fsckKey backend) key
|
||||
return $ size_ok && copies_ok && backend_ok
|
||||
|
||||
{- The size of the data for a key is checked against the size encoded in
|
||||
|
|
|
@ -25,4 +25,4 @@ start key = do
|
|||
present <- inAnnex key
|
||||
if present
|
||||
then stop
|
||||
else liftIO $ exitFailure
|
||||
else liftIO exitFailure
|
||||
|
|
|
@ -24,7 +24,7 @@ import Messages
|
|||
command :: [Command]
|
||||
command = [repoCommand "initremote"
|
||||
(paramPair paramName $
|
||||
paramOptional $ paramRepeating $ paramKeyValue) seek
|
||||
paramOptional $ paramRepeating paramKeyValue) seek
|
||||
"sets up a special (non-git) remote"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
|
@ -32,7 +32,7 @@ seek = [withWords start]
|
|||
|
||||
start :: CommandStartWords
|
||||
start ws = do
|
||||
when (null ws) $ needname
|
||||
when (null ws) needname
|
||||
|
||||
(u, c) <- findByName name
|
||||
let fullconfig = M.union config c
|
||||
|
@ -69,7 +69,7 @@ findByName name = do
|
|||
maybe generate return $ findByName' name m
|
||||
where
|
||||
generate = do
|
||||
uuid <- liftIO $ genUUID
|
||||
uuid <- liftIO genUUID
|
||||
return (uuid, M.insert nameKey name M.empty)
|
||||
|
||||
findByName' :: String -> M.Map UUID R.RemoteConfig -> Maybe (UUID, R.RemoteConfig)
|
||||
|
@ -85,7 +85,7 @@ findByName' n m = if null matches then Nothing else Just $ head matches
|
|||
remoteNames :: Annex [String]
|
||||
remoteNames = do
|
||||
m <- RemoteLog.readRemoteLog
|
||||
return $ catMaybes $ map ((M.lookup nameKey) . snd) $ M.toList m
|
||||
return $ mapMaybe (M.lookup nameKey . snd) $ M.toList m
|
||||
|
||||
{- find the specified remote type -}
|
||||
findType :: R.RemoteConfig -> Annex (R.RemoteType Annex)
|
||||
|
|
|
@ -12,6 +12,7 @@ import Control.Exception.Extensible
|
|||
import System.Cmd.Utils
|
||||
import qualified Data.Map as M
|
||||
import Data.List.Utils
|
||||
import Data.Maybe
|
||||
|
||||
import Command
|
||||
import qualified Annex
|
||||
|
@ -58,7 +59,7 @@ start = do
|
|||
- the repositories first, followed by uuids that were not matched
|
||||
- to a repository.
|
||||
-}
|
||||
drawMap :: [Git.Repo] -> (M.Map UUID String) -> [UUID] -> String
|
||||
drawMap :: [Git.Repo] -> M.Map UUID String -> [UUID] -> String
|
||||
drawMap rs umap ts = Dot.graph $ repos ++ trusted ++ others
|
||||
where
|
||||
repos = map (node umap rs) rs
|
||||
|
@ -78,23 +79,23 @@ basehostname r = head $ split "." $ hostname r
|
|||
|
||||
{- A name to display for a repo. Uses the name from uuid.log if available,
|
||||
- or the remote name if not. -}
|
||||
repoName :: (M.Map UUID String) -> Git.Repo -> String
|
||||
repoName :: M.Map UUID String -> Git.Repo -> String
|
||||
repoName umap r
|
||||
| null repouuid = fallback
|
||||
| otherwise = M.findWithDefault fallback repouuid umap
|
||||
where
|
||||
repouuid = getUncachedUUID r
|
||||
fallback = maybe "unknown" id $ Git.repoRemoteName r
|
||||
fallback = fromMaybe "unknown" $ Git.repoRemoteName r
|
||||
|
||||
{- A unique id for the node for a repo. Uses the annex.uuid if available. -}
|
||||
nodeId :: Git.Repo -> String
|
||||
nodeId r =
|
||||
case (getUncachedUUID r) of
|
||||
case getUncachedUUID r of
|
||||
"" -> Git.repoLocation r
|
||||
u -> u
|
||||
|
||||
{- A node representing a repo. -}
|
||||
node :: (M.Map UUID String) -> [Git.Repo] -> Git.Repo -> String
|
||||
node :: M.Map UUID String -> [Git.Repo] -> Git.Repo -> String
|
||||
node umap fullinfo r = unlines $ n:edges
|
||||
where
|
||||
n = Dot.subGraph (hostname r) (basehostname r) "lightblue" $
|
||||
|
@ -105,14 +106,14 @@ node umap fullinfo r = unlines $ n:edges
|
|||
| otherwise = reachable
|
||||
|
||||
{- An edge between two repos. The second repo is a remote of the first. -}
|
||||
edge :: (M.Map UUID String) -> [Git.Repo] -> Git.Repo -> Git.Repo -> String
|
||||
edge :: M.Map UUID String -> [Git.Repo] -> Git.Repo -> Git.Repo -> String
|
||||
edge umap fullinfo from to =
|
||||
Dot.graphEdge (nodeId from) (nodeId fullto) edgename
|
||||
where
|
||||
-- get the full info for the remote, to get its UUID
|
||||
fullto = findfullinfo to
|
||||
findfullinfo n =
|
||||
case (filter (same n) fullinfo) of
|
||||
case filter (same n) fullinfo of
|
||||
[] -> n
|
||||
(n':_) -> n'
|
||||
{- Only name an edge if the name is different than the name
|
||||
|
@ -120,7 +121,7 @@ edge umap fullinfo from to =
|
|||
- different from its hostname. (This reduces visual clutter.) -}
|
||||
edgename = maybe Nothing calcname $ Git.repoRemoteName to
|
||||
calcname n
|
||||
| n == repoName umap fullto || n == hostname fullto = Nothing
|
||||
| n `elem` [repoName umap fullto, hostname fullto] = Nothing
|
||||
| otherwise = Just n
|
||||
|
||||
unreachable :: String -> String
|
||||
|
@ -188,7 +189,7 @@ tryScan r
|
|||
| otherwise = safely $ Git.configRead r
|
||||
where
|
||||
safely a = do
|
||||
result <- liftIO (try (a)::IO (Either SomeException Git.Repo))
|
||||
result <- liftIO (try a :: IO (Either SomeException Git.Repo))
|
||||
case result of
|
||||
Left _ -> return Nothing
|
||||
Right r' -> return $ Just r'
|
||||
|
|
|
@ -124,7 +124,7 @@ fromStart src move file = isAnnexed file $ \(key, _) -> do
|
|||
g <- Annex.gitRepo
|
||||
u <- getUUID g
|
||||
remotes <- Remote.keyPossibilities key
|
||||
if (u == Remote.uuid src) || (null $ filter (== src) remotes)
|
||||
if u == Remote.uuid src || not (any (== src) remotes)
|
||||
then stop
|
||||
else do
|
||||
showAction move file
|
||||
|
|
|
@ -16,7 +16,7 @@ import Content
|
|||
import Messages
|
||||
|
||||
command :: [Command]
|
||||
command = [repoCommand "setkey" (paramPath) seek
|
||||
command = [repoCommand "setkey" paramPath seek
|
||||
"sets annexed content for a key using a temp file"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
|
@ -34,7 +34,7 @@ perform file = do
|
|||
-- the file might be on a different filesystem, so mv is used
|
||||
-- rather than simply calling moveToObjectDir; disk space is also
|
||||
-- checked this way.
|
||||
ok <- getViaTmp key $ \dest -> do
|
||||
ok <- getViaTmp key $ \dest ->
|
||||
if dest /= file
|
||||
then liftIO $
|
||||
boolSystem "mv" [File file, File dest]
|
||||
|
|
|
@ -32,8 +32,8 @@ type Stat = StatState (Maybe (String, StatState String))
|
|||
|
||||
-- cached info that multiple Stats may need
|
||||
data StatInfo = StatInfo
|
||||
{ keysPresentCache :: (Maybe (SizeList Key))
|
||||
, keysReferencedCache :: (Maybe (SizeList Key))
|
||||
{ keysPresentCache :: Maybe (SizeList Key)
|
||||
, keysReferencedCache :: Maybe (SizeList Key)
|
||||
}
|
||||
|
||||
-- a state monad for running Stats in
|
||||
|
@ -84,7 +84,7 @@ stat :: String -> StatState String -> Stat
|
|||
stat desc a = return $ Just (desc, a)
|
||||
|
||||
nostat :: Stat
|
||||
nostat = return $ Nothing
|
||||
nostat = return Nothing
|
||||
|
||||
showStat :: Stat -> StatState ()
|
||||
showStat s = calc =<< s
|
||||
|
@ -144,7 +144,7 @@ cachedKeysPresent = do
|
|||
case keysPresentCache s of
|
||||
Just v -> return v
|
||||
Nothing -> do
|
||||
keys <- lift $ getKeysPresent
|
||||
keys <- lift getKeysPresent
|
||||
let v = sizeList keys
|
||||
put s { keysPresentCache = Just v }
|
||||
return v
|
||||
|
@ -155,7 +155,7 @@ cachedKeysReferenced = do
|
|||
case keysReferencedCache s of
|
||||
Just v -> return v
|
||||
Nothing -> do
|
||||
keys <- lift $ Command.Unused.getKeysReferenced
|
||||
keys <- lift Command.Unused.getKeysReferenced
|
||||
-- A given key may be referenced repeatedly.
|
||||
-- nub does not seem too slow (yet)..
|
||||
let v = sizeList $ nub keys
|
||||
|
@ -164,9 +164,9 @@ cachedKeysReferenced = do
|
|||
|
||||
keySizeSum :: SizeList Key -> StatState String
|
||||
keySizeSum (keys, len) = do
|
||||
let knownsize = catMaybes $ map keySize keys
|
||||
let total = roughSize storageUnits False $ foldl (+) 0 knownsize
|
||||
let missing = len - genericLength knownsize
|
||||
let knownsizes = mapMaybe keySize keys
|
||||
let total = roughSize storageUnits False $ sum knownsizes
|
||||
let missing = len - genericLength knownsizes
|
||||
return $ total ++
|
||||
if missing > 0
|
||||
then aside $ "but " ++ show missing ++ " keys have unknown size"
|
||||
|
|
|
@ -52,8 +52,9 @@ cleanup = do
|
|||
liftIO $ removeDirectoryRecursive (gitAnnexDir g)
|
||||
-- avoid normal shutdown
|
||||
saveState
|
||||
liftIO $ Git.run g "branch" [Param "-D", Param Branch.name]
|
||||
liftIO $ exitSuccess
|
||||
liftIO $ do
|
||||
Git.run g "branch" [Param "-D", Param Branch.name]
|
||||
exitSuccess
|
||||
|
||||
gitPreCommitHookUnWrite :: Git.Repo -> Annex ()
|
||||
gitPreCommitHookUnWrite repo = do
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
|
||||
module Command.Unused where
|
||||
|
||||
import Control.Monad (filterM, unless, forM_, when)
|
||||
import Control.Monad (filterM, unless, forM_)
|
||||
import Control.Monad.State (liftIO)
|
||||
import qualified Data.Set as S
|
||||
import Data.Maybe
|
||||
|
@ -55,9 +55,9 @@ checkUnused = do
|
|||
where
|
||||
list file msg l c = do
|
||||
let unusedlist = number c l
|
||||
when (not $ null l) $ do
|
||||
unless (null l) $ do
|
||||
showLongNote $ msg unusedlist
|
||||
showLongNote $ "\n"
|
||||
showLongNote "\n"
|
||||
writeUnusedFile file unusedlist
|
||||
return $ c + length l
|
||||
|
||||
|
@ -68,7 +68,7 @@ checkRemoteUnused name = do
|
|||
|
||||
checkRemoteUnused' :: Remote.Remote Annex -> Annex ()
|
||||
checkRemoteUnused' r = do
|
||||
showNote $ "checking for unused data..."
|
||||
showNote "checking for unused data..."
|
||||
referenced <- getKeysReferenced
|
||||
remotehas <- filterM isthere =<< loggedKeys
|
||||
let remoteunused = remotehas `exclude` referenced
|
||||
|
@ -76,7 +76,7 @@ checkRemoteUnused' r = do
|
|||
writeUnusedFile "" list
|
||||
unless (null remoteunused) $ do
|
||||
showLongNote $ remoteUnusedMsg r list
|
||||
showLongNote $ "\n"
|
||||
showLongNote "\n"
|
||||
where
|
||||
isthere k = do
|
||||
us <- keyLocations k
|
||||
|
@ -90,14 +90,14 @@ writeUnusedFile prefix l = do
|
|||
unlines $ map (\(n, k) -> show n ++ " " ++ show k) l
|
||||
|
||||
table :: [(Int, Key)] -> [String]
|
||||
table l = [" NUMBER KEY"] ++ map cols l
|
||||
table l = " NUMBER KEY" : map cols l
|
||||
where
|
||||
cols (n,k) = " " ++ pad 6 (show n) ++ " " ++ show k
|
||||
pad n s = s ++ replicate (n - length s) ' '
|
||||
|
||||
number :: Int -> [a] -> [(Int, a)]
|
||||
number _ [] = []
|
||||
number n (x:xs) = (n+1, x):(number (n+1) xs)
|
||||
number n (x:xs) = (n+1, x) : number (n+1) xs
|
||||
|
||||
staleTmpMsg :: [(Int, Key)] -> String
|
||||
staleTmpMsg t = unlines $
|
||||
|
@ -210,4 +210,4 @@ staleKeys dirspec = do
|
|||
contents <- liftIO $ getDirectoryContents dir
|
||||
files <- liftIO $ filterM doesFileExist $
|
||||
map (dir </>) contents
|
||||
return $ catMaybes $ map (fileKey . takeFileName) files
|
||||
return $ mapMaybe (fileKey . takeFileName) files
|
||||
|
|
|
@ -31,4 +31,4 @@ start = do
|
|||
liftIO $ putStrLn $ "upgrade supported from repository versions: " ++ vs upgradableVersions
|
||||
stop
|
||||
where
|
||||
vs l = join " " l
|
||||
vs = join " "
|
||||
|
|
|
@ -30,11 +30,11 @@ perform key = do
|
|||
uuids <- keyLocations key
|
||||
let num = length uuids
|
||||
showNote $ show num ++ " " ++ copiesplural num
|
||||
if null $ uuids
|
||||
if null uuids
|
||||
then stop
|
||||
else do
|
||||
pp <- prettyPrintUUIDs uuids
|
||||
showLongNote $ pp
|
||||
showLongNote pp
|
||||
showProgress
|
||||
next $ return True
|
||||
where
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue