go go gadget hlint
This commit is contained in:
parent
9d26192350
commit
9f6b7935dd
21 changed files with 35 additions and 37 deletions
|
@ -111,7 +111,7 @@ chooseBackends :: [FilePath] -> Annex [BackendFile]
|
||||||
chooseBackends fs = do
|
chooseBackends fs = do
|
||||||
g <- Annex.gitRepo
|
g <- Annex.gitRepo
|
||||||
forced <- Annex.getState Annex.forcebackend
|
forced <- Annex.getState Annex.forcebackend
|
||||||
if forced /= Nothing
|
if isJust forced
|
||||||
then do
|
then do
|
||||||
l <- orderedList
|
l <- orderedList
|
||||||
return $ map (\f -> (Just $ head l, f)) fs
|
return $ map (\f -> (Just $ head l, f)) fs
|
||||||
|
|
|
@ -38,7 +38,7 @@ backends = catMaybes $ map genBackend sizes ++ map genBackendE sizes
|
||||||
|
|
||||||
genBackend :: SHASize -> Maybe (Backend Annex)
|
genBackend :: SHASize -> Maybe (Backend Annex)
|
||||||
genBackend size
|
genBackend size
|
||||||
| shaCommand size == Nothing = Nothing
|
| isNothing (shaCommand size) = Nothing
|
||||||
| otherwise = Just b
|
| otherwise = Just b
|
||||||
where
|
where
|
||||||
b = Types.Backend.Backend
|
b = Types.Backend.Backend
|
||||||
|
|
|
@ -162,7 +162,7 @@ withNothing a [] = return [a]
|
||||||
withNothing _ _ = error "This command takes no parameters."
|
withNothing _ _ = error "This command takes no parameters."
|
||||||
|
|
||||||
runFiltered :: (FilePath -> Annex (Maybe a)) -> Annex [FilePath] -> Annex [Annex (Maybe a)]
|
runFiltered :: (FilePath -> Annex (Maybe a)) -> Annex [FilePath] -> Annex [Annex (Maybe a)]
|
||||||
runFiltered a fs = runFilteredGen a id fs
|
runFiltered a = runFilteredGen a id
|
||||||
|
|
||||||
backendPairs :: (BackendFile -> CommandStart) -> CommandSeek
|
backendPairs :: (BackendFile -> CommandStart) -> CommandSeek
|
||||||
backendPairs a fs = runFilteredGen a snd (Backend.chooseBackends fs)
|
backendPairs a fs = runFilteredGen a snd (Backend.chooseBackends fs)
|
||||||
|
|
|
@ -28,7 +28,7 @@ import Utility.Path
|
||||||
import Utility.Conditional
|
import Utility.Conditional
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
command = [repoCommand "addurl" (paramRepeating $ paramUrl) seek
|
command = [repoCommand "addurl" (paramRepeating paramUrl) seek
|
||||||
"add urls to annex"]
|
"add urls to annex"]
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
|
|
|
@ -35,7 +35,7 @@ start ws = do
|
||||||
when (null ws) needname
|
when (null ws) needname
|
||||||
|
|
||||||
(u, c) <- findByName name
|
(u, c) <- findByName name
|
||||||
let fullconfig = M.union config c
|
let fullconfig = config `M.union` c
|
||||||
t <- findType fullconfig
|
t <- findType fullconfig
|
||||||
|
|
||||||
showStart "initremote" name
|
showStart "initremote" name
|
||||||
|
|
|
@ -12,6 +12,7 @@ import Control.Applicative
|
||||||
import System.Posix.Files
|
import System.Posix.Files
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
|
import Data.Maybe
|
||||||
|
|
||||||
import Command
|
import Command
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
|
@ -48,7 +49,7 @@ start (b, file) = isAnnexed file $ \(key, oldbackend) -> do
|
||||||
{- Checks if a key is upgradable to a newer representation. -}
|
{- Checks if a key is upgradable to a newer representation. -}
|
||||||
{- Ideally, all keys have file size metadata. Old keys may not. -}
|
{- Ideally, all keys have file size metadata. Old keys may not. -}
|
||||||
upgradableKey :: Key -> Bool
|
upgradableKey :: Key -> Bool
|
||||||
upgradableKey key = Types.Key.keySize key == Nothing
|
upgradableKey key = isNothing $ Types.Key.keySize key
|
||||||
|
|
||||||
perform :: FilePath -> Key -> Backend Annex -> CommandPerform
|
perform :: FilePath -> Key -> Backend Annex -> CommandPerform
|
||||||
perform file oldkey newbackend = do
|
perform file oldkey newbackend = do
|
||||||
|
|
|
@ -94,11 +94,11 @@ supported_remote_types = stat "supported remote types" $
|
||||||
|
|
||||||
local_annex_size :: Stat
|
local_annex_size :: Stat
|
||||||
local_annex_size = stat "local annex size" $
|
local_annex_size = stat "local annex size" $
|
||||||
cachedKeysPresent >>= return . keySizeSum
|
keySizeSum <$> cachedKeysPresent
|
||||||
|
|
||||||
total_annex_size :: Stat
|
total_annex_size :: Stat
|
||||||
total_annex_size = stat "total annex size" $
|
total_annex_size = stat "total annex size" $
|
||||||
cachedKeysReferenced >>= return . keySizeSum
|
keySizeSum <$> cachedKeysReferenced
|
||||||
|
|
||||||
local_annex_keys :: Stat
|
local_annex_keys :: Stat
|
||||||
local_annex_keys = stat "local annex keys" $
|
local_annex_keys = stat "local annex keys" $
|
||||||
|
|
13
Git.hs
13
Git.hs
|
@ -62,7 +62,7 @@ module Git (
|
||||||
prop_idempotent_deencode
|
prop_idempotent_deencode
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (unless, when)
|
import Control.Monad (unless, when, liftM2)
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
|
@ -425,7 +425,7 @@ getSha :: String -> IO String -> IO String
|
||||||
getSha subcommand a = do
|
getSha subcommand a = do
|
||||||
t <- a
|
t <- a
|
||||||
let t' = if last t == '\n'
|
let t' = if last t == '\n'
|
||||||
then take (length t - 1) t
|
then init t
|
||||||
else t
|
else t
|
||||||
when (length t' /= shaSize) $
|
when (length t' /= shaSize) $
|
||||||
error $ "failed to read sha from git " ++ subcommand ++ " (" ++ t' ++ ")"
|
error $ "failed to read sha from git " ++ subcommand ++ " (" ++ t' ++ ")"
|
||||||
|
@ -576,7 +576,7 @@ decodeGitFile f@(c:s)
|
||||||
| otherwise = f
|
| otherwise = f
|
||||||
where
|
where
|
||||||
e = '\\'
|
e = '\\'
|
||||||
middle = take (length s - 1) s
|
middle = init s
|
||||||
unescape (b, []) = b
|
unescape (b, []) = b
|
||||||
-- look for escapes starting with '\'
|
-- look for escapes starting with '\'
|
||||||
unescape (b, v) = b ++ beginning ++ unescape (decode rest)
|
unescape (b, v) = b ++ beginning ++ unescape (decode rest)
|
||||||
|
@ -702,7 +702,6 @@ isRepoTop dir = do
|
||||||
where
|
where
|
||||||
isRepo = gitSignature ".git" ".git/config"
|
isRepo = gitSignature ".git" ".git/config"
|
||||||
isBareRepo = gitSignature "objects" "config"
|
isBareRepo = gitSignature "objects" "config"
|
||||||
gitSignature subdir file = do
|
gitSignature subdir file = liftM2 (&&)
|
||||||
s <- (doesDirectoryExist (dir ++ "/" ++ subdir))
|
(doesDirectoryExist (dir ++ "/" ++ subdir))
|
||||||
f <- (doesFileExist (dir ++ "/" ++ file))
|
(doesFileExist (dir ++ "/" ++ file))
|
||||||
return (s && f)
|
|
||||||
|
|
|
@ -108,11 +108,11 @@ options = commonOptions ++
|
||||||
"override trust setting to untrusted"
|
"override trust setting to untrusted"
|
||||||
, Option ['c'] ["config"] (ReqArg setgitconfig "NAME=VALUE")
|
, Option ['c'] ["config"] (ReqArg setgitconfig "NAME=VALUE")
|
||||||
"override git configuration setting"
|
"override git configuration setting"
|
||||||
, Option ['x'] ["exclude"] (ReqArg (Limit.addExclude) paramGlob)
|
, Option ['x'] ["exclude"] (ReqArg Limit.addExclude paramGlob)
|
||||||
"skip files matching the glob pattern"
|
"skip files matching the glob pattern"
|
||||||
, Option ['i'] ["in"] (ReqArg (Limit.addIn) paramRemote)
|
, Option ['i'] ["in"] (ReqArg Limit.addIn paramRemote)
|
||||||
"skip files not present in a remote"
|
"skip files not present in a remote"
|
||||||
, Option ['C'] ["copies"] (ReqArg (Limit.addCopies) paramNumber)
|
, Option ['C'] ["copies"] (ReqArg Limit.addCopies paramNumber)
|
||||||
"skip files with fewer copies"
|
"skip files with fewer copies"
|
||||||
] ++ matcherOptions
|
] ++ matcherOptions
|
||||||
where
|
where
|
||||||
|
|
3
Init.hs
3
Init.hs
|
@ -33,8 +33,7 @@ initialize = do
|
||||||
gitPreCommitHookWrite
|
gitPreCommitHookWrite
|
||||||
|
|
||||||
uninitialize :: Annex ()
|
uninitialize :: Annex ()
|
||||||
uninitialize = do
|
uninitialize = gitPreCommitHookUnWrite
|
||||||
gitPreCommitHookUnWrite
|
|
||||||
|
|
||||||
{- Will automatically initialize if there is already a git-annex
|
{- Will automatically initialize if there is already a git-annex
|
||||||
branch from somewhere. Otherwise, require a manual init
|
branch from somewhere. Otherwise, require a manual init
|
||||||
|
|
5
Limit.hs
5
Limit.hs
|
@ -69,7 +69,7 @@ addExclude glob = addLimit $ return . notExcluded
|
||||||
addIn :: String -> Annex ()
|
addIn :: String -> Annex ()
|
||||||
addIn name = do
|
addIn name = do
|
||||||
u <- Remote.nameToUUID name
|
u <- Remote.nameToUUID name
|
||||||
addLimit $ if name == "." then check local else check (remote u)
|
addLimit $ if name == "." then check inAnnex else check (remote u)
|
||||||
where
|
where
|
||||||
check a f = Backend.lookupFile f >>= handle a
|
check a f = Backend.lookupFile f >>= handle a
|
||||||
handle _ Nothing = return False
|
handle _ Nothing = return False
|
||||||
|
@ -77,12 +77,11 @@ addIn name = do
|
||||||
remote u key = do
|
remote u key = do
|
||||||
us <- keyLocations key
|
us <- keyLocations key
|
||||||
return $ u `elem` us
|
return $ u `elem` us
|
||||||
local key = inAnnex key
|
|
||||||
|
|
||||||
{- Adds a limit to skip files not believed to have the specified number
|
{- Adds a limit to skip files not believed to have the specified number
|
||||||
- of copies. -}
|
- of copies. -}
|
||||||
addCopies :: String -> Annex ()
|
addCopies :: String -> Annex ()
|
||||||
addCopies num = do
|
addCopies num =
|
||||||
case readMaybe num :: Maybe Int of
|
case readMaybe num :: Maybe Int of
|
||||||
Nothing -> error "bad number for --copies"
|
Nothing -> error "bad number for --copies"
|
||||||
Just n -> addLimit $ check n
|
Just n -> addLimit $ check n
|
||||||
|
|
|
@ -58,5 +58,5 @@ matcherOptions =
|
||||||
, shortopt ")" "close group of options"
|
, shortopt ")" "close group of options"
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
longopt o d = Option [] [o] (NoArg (addToken o)) d
|
longopt o = Option [] [o] $ NoArg $ addToken o
|
||||||
shortopt o d = Option o [] (NoArg (addToken o)) d
|
shortopt o = Option o [] $ NoArg $ addToken o
|
||||||
|
|
|
@ -81,7 +81,7 @@ tryGitConfigRead :: Git.Repo -> Annex Git.Repo
|
||||||
tryGitConfigRead r
|
tryGitConfigRead r
|
||||||
| not $ M.null $ Git.configMap r = return r -- already read
|
| not $ M.null $ Git.configMap r = return r -- already read
|
||||||
| Git.repoIsSsh r = store $ onRemote r (pipedconfig, r) "configlist" []
|
| Git.repoIsSsh r = store $ onRemote r (pipedconfig, r) "configlist" []
|
||||||
| Git.repoIsHttp r = store $ safely $ geturlconfig
|
| Git.repoIsHttp r = store $ safely geturlconfig
|
||||||
| Git.repoIsUrl r = return r
|
| Git.repoIsUrl r = return r
|
||||||
| otherwise = store $ safely $ do
|
| otherwise = store $ safely $ do
|
||||||
onLocal r ensureInitialized
|
onLocal r ensureInitialized
|
||||||
|
@ -101,7 +101,7 @@ tryGitConfigRead r
|
||||||
|
|
||||||
geturlconfig = do
|
geturlconfig = do
|
||||||
s <- Url.get (Git.repoLocation r ++ "/config")
|
s <- Url.get (Git.repoLocation r ++ "/config")
|
||||||
withTempFile "git-annex.tmp" $ \tmpfile -> \h -> do
|
withTempFile "git-annex.tmp" $ \tmpfile h -> do
|
||||||
hPutStr h s
|
hPutStr h s
|
||||||
hClose h
|
hClose h
|
||||||
pOpen ReadFromPipe "git" ["config", "--list", "--file", tmpfile] $
|
pOpen ReadFromPipe "git" ["config", "--list", "--file", tmpfile] $
|
||||||
|
|
|
@ -95,7 +95,7 @@ s3Setup u c = handlehost $ M.lookup "host" c
|
||||||
|
|
||||||
defaulthost = do
|
defaulthost = do
|
||||||
c' <- encryptionSetup c
|
c' <- encryptionSetup c
|
||||||
let fullconfig = M.union c' defaults
|
let fullconfig = c' `M.union` defaults
|
||||||
genBucket fullconfig
|
genBucket fullconfig
|
||||||
use fullconfig
|
use fullconfig
|
||||||
|
|
||||||
|
@ -209,7 +209,7 @@ s3Bool (Left e) = s3Warning e
|
||||||
|
|
||||||
s3Action :: Remote Annex -> a -> ((AWSConnection, String) -> Annex a) -> Annex a
|
s3Action :: Remote Annex -> a -> ((AWSConnection, String) -> Annex a) -> Annex a
|
||||||
s3Action r noconn action = do
|
s3Action r noconn action = do
|
||||||
when (config r == Nothing) $
|
when (isNothing $ config r) $
|
||||||
error $ "Missing configuration for special remote " ++ name r
|
error $ "Missing configuration for special remote " ++ name r
|
||||||
let bucket = M.lookup "bucket" $ fromJust $ config r
|
let bucket = M.lookup "bucket" $ fromJust $ config r
|
||||||
conn <- s3Connection $ fromJust $ config r
|
conn <- s3Connection $ fromJust $ config r
|
||||||
|
|
|
@ -173,7 +173,7 @@ readKey1 v =
|
||||||
then Just (read (bits !! 2) :: Integer)
|
then Just (read (bits !! 2) :: Integer)
|
||||||
else Nothing
|
else Nothing
|
||||||
wormy = head bits == "WORM"
|
wormy = head bits == "WORM"
|
||||||
mixup = wormy && (isUpper $ head $ bits !! 1)
|
mixup = wormy && isUpper (head $ bits !! 1)
|
||||||
|
|
||||||
showKey1 :: Key -> String
|
showKey1 :: Key -> String
|
||||||
showKey1 Key { keyName = n , keyBackendName = b, keySize = s, keyMtime = t } =
|
showKey1 Key { keyName = n , keyBackendName = b, keySize = s, keyMtime = t } =
|
||||||
|
@ -248,7 +248,7 @@ logFile' hasher repo key =
|
||||||
gitStateDir repo ++ hasher key ++ keyFile key ++ ".log"
|
gitStateDir repo ++ hasher key ++ keyFile key ++ ".log"
|
||||||
|
|
||||||
stateDir :: FilePath
|
stateDir :: FilePath
|
||||||
stateDir = addTrailingPathSeparator $ ".git-annex"
|
stateDir = addTrailingPathSeparator ".git-annex"
|
||||||
|
|
||||||
gitStateDir :: Git.Repo -> FilePath
|
gitStateDir :: Git.Repo -> FilePath
|
||||||
gitStateDir repo = addTrailingPathSeparator $ Git.workTree repo </> stateDir
|
gitStateDir repo = addTrailingPathSeparator $ Git.workTree repo </> stateDir
|
||||||
|
|
|
@ -19,7 +19,7 @@ import Text.JSON
|
||||||
later. -}
|
later. -}
|
||||||
start :: JSON a => [(String, a)] -> String
|
start :: JSON a => [(String, a)] -> String
|
||||||
start l
|
start l
|
||||||
| last s == endchar = take (length s - 1) s
|
| last s == endchar = init s
|
||||||
| otherwise = bad s
|
| otherwise = bad s
|
||||||
where
|
where
|
||||||
s = encodeStrict $ toJSObject l
|
s = encodeStrict $ toJSObject l
|
||||||
|
|
|
@ -63,7 +63,7 @@ consume m (t:ts) = go t
|
||||||
where
|
where
|
||||||
go And = cont $ m `MAnd` next
|
go And = cont $ m `MAnd` next
|
||||||
go Or = cont $ m `MOr` next
|
go Or = cont $ m `MOr` next
|
||||||
go Not = cont $ m `MAnd` (MNot next)
|
go Not = cont $ m `MAnd` MNot next
|
||||||
go Open = let (n, r) = consume next rest in (m `MAnd` n, r)
|
go Open = let (n, r) = consume next rest in (m `MAnd` n, r)
|
||||||
go Close = (m, ts)
|
go Close = (m, ts)
|
||||||
go (Operation o) = (m `MAnd` MOp o, ts)
|
go (Operation o) = (m `MAnd` MOp o, ts)
|
||||||
|
|
|
@ -19,7 +19,7 @@ import Control.Applicative
|
||||||
parentDir :: FilePath -> FilePath
|
parentDir :: FilePath -> FilePath
|
||||||
parentDir dir =
|
parentDir dir =
|
||||||
if not $ null dirs
|
if not $ null dirs
|
||||||
then slash ++ join s (take (length dirs - 1) dirs)
|
then slash ++ join s (init dirs)
|
||||||
else ""
|
else ""
|
||||||
where
|
where
|
||||||
dirs = filter (not . null) $ split s dir
|
dirs = filter (not . null) $ split s dir
|
||||||
|
|
|
@ -24,7 +24,7 @@ newtype TimeSpec = TimeSpec CTime
|
||||||
touchBoth :: FilePath -> TimeSpec -> TimeSpec -> Bool -> IO ()
|
touchBoth :: FilePath -> TimeSpec -> TimeSpec -> Bool -> IO ()
|
||||||
|
|
||||||
touch :: FilePath -> TimeSpec -> Bool -> IO ()
|
touch :: FilePath -> TimeSpec -> Bool -> IO ()
|
||||||
touch file mtime follow = touchBoth file mtime mtime follow
|
touch file mtime = touchBoth file mtime mtime
|
||||||
|
|
||||||
#include <sys/types.h>
|
#include <sys/types.h>
|
||||||
#include <sys/stat.h>
|
#include <sys/stat.h>
|
||||||
|
|
|
@ -51,7 +51,7 @@ getVersionString = do
|
||||||
let verline = head $ lines changelog
|
let verline = head $ lines changelog
|
||||||
return $ middle (words verline !! 1)
|
return $ middle (words verline !! 1)
|
||||||
where
|
where
|
||||||
middle s = drop 1 $ take (length s - 1) s
|
middle = drop 1 . init
|
||||||
|
|
||||||
{- Set up cabal file with version. -}
|
{- Set up cabal file with version. -}
|
||||||
cabalSetup :: IO ()
|
cabalSetup :: IO ()
|
||||||
|
|
|
@ -23,7 +23,7 @@ tmpIndex :: Git.Repo -> FilePath
|
||||||
tmpIndex g = Git.gitDir g </> "index.git-union-merge"
|
tmpIndex g = Git.gitDir g </> "index.git-union-merge"
|
||||||
|
|
||||||
setup :: Git.Repo -> IO ()
|
setup :: Git.Repo -> IO ()
|
||||||
setup g = cleanup g -- idempotency
|
setup = cleanup -- idempotency
|
||||||
|
|
||||||
cleanup :: Git.Repo -> IO ()
|
cleanup :: Git.Repo -> IO ()
|
||||||
cleanup g = do
|
cleanup g = do
|
||||||
|
|
Loading…
Reference in a new issue