hlint
This commit is contained in:
parent
e7aaa55c53
commit
a1e52f0ce5
18 changed files with 36 additions and 37 deletions
|
@ -116,7 +116,7 @@ updateTo pairs = do
|
||||||
-- check what needs updating before taking the lock
|
-- check what needs updating before taking the lock
|
||||||
dirty <- journalDirty
|
dirty <- journalDirty
|
||||||
(refs, branches) <- unzip <$> filterM isnewer pairs
|
(refs, branches) <- unzip <$> filterM isnewer pairs
|
||||||
if (not dirty && null refs)
|
if not dirty && null refs
|
||||||
then updateIndex branchref
|
then updateIndex branchref
|
||||||
else withIndex $ lockJournal $ do
|
else withIndex $ lockJournal $ do
|
||||||
when dirty stageJournal
|
when dirty stageJournal
|
||||||
|
@ -172,7 +172,7 @@ get' staleok file = fromcache =<< getCache file
|
||||||
- modifes the current content of the file on the branch.
|
- modifes the current content of the file on the branch.
|
||||||
-}
|
-}
|
||||||
change :: FilePath -> (String -> String) -> Annex ()
|
change :: FilePath -> (String -> String) -> Annex ()
|
||||||
change file a = lockJournal $ getStale file >>= return . a >>= set file
|
change file a = lockJournal $ a <$> getStale file >>= set file
|
||||||
|
|
||||||
{- Records new content of a file into the journal and cache. -}
|
{- Records new content of a file into the journal and cache. -}
|
||||||
set :: FilePath -> String -> Annex ()
|
set :: FilePath -> String -> Annex ()
|
||||||
|
|
|
@ -32,7 +32,7 @@ sshParams (host, port) opts = go =<< sshInfo (host, port)
|
||||||
-- If the lock pool is empty, this is the first ssh of this
|
-- If the lock pool is empty, this is the first ssh of this
|
||||||
-- run. There could be stale ssh connections hanging around
|
-- run. There could be stale ssh connections hanging around
|
||||||
-- from a previous git-annex run that was interrupted.
|
-- from a previous git-annex run that was interrupted.
|
||||||
cleanstale = whenM (null . filter isLock . M.keys <$> getPool) $
|
cleanstale = whenM (not . any isLock . M.keys <$> getPool) $
|
||||||
sshCleanup
|
sshCleanup
|
||||||
|
|
||||||
sshInfo :: (String, Maybe Integer) -> Annex (Maybe FilePath, [CommandParam])
|
sshInfo :: (String, Maybe Integer) -> Annex (Maybe FilePath, [CommandParam])
|
||||||
|
@ -40,9 +40,9 @@ sshInfo (host, port) = do
|
||||||
caching <- Git.configTrue <$> fromRepo (Git.Config.get "annex.sshcaching" "true")
|
caching <- Git.configTrue <$> fromRepo (Git.Config.get "annex.sshcaching" "true")
|
||||||
if caching
|
if caching
|
||||||
then do
|
then do
|
||||||
dir <- fromRepo $ gitAnnexSshDir
|
dir <- fromRepo gitAnnexSshDir
|
||||||
let socketfile = dir </> hostport2socket host port
|
let socketfile = dir </> hostport2socket host port
|
||||||
return $ (Just socketfile, cacheParams socketfile)
|
return (Just socketfile, cacheParams socketfile)
|
||||||
else return (Nothing, [])
|
else return (Nothing, [])
|
||||||
|
|
||||||
cacheParams :: FilePath -> [CommandParam]
|
cacheParams :: FilePath -> [CommandParam]
|
||||||
|
@ -58,7 +58,7 @@ portParams (Just port) = [Param "-p", Param $ show port]
|
||||||
{- Stop any unused ssh processes. -}
|
{- Stop any unused ssh processes. -}
|
||||||
sshCleanup :: Annex ()
|
sshCleanup :: Annex ()
|
||||||
sshCleanup = do
|
sshCleanup = do
|
||||||
dir <- fromRepo $ gitAnnexSshDir
|
dir <- fromRepo gitAnnexSshDir
|
||||||
liftIO $ createDirectoryIfMissing True dir
|
liftIO $ createDirectoryIfMissing True dir
|
||||||
sockets <- filter (not . isLock) <$> liftIO (dirContents dir)
|
sockets <- filter (not . isLock) <$> liftIO (dirContents dir)
|
||||||
forM_ sockets cleanup
|
forM_ sockets cleanup
|
||||||
|
|
|
@ -60,7 +60,7 @@ genKey file trybackend = do
|
||||||
genKey' :: [Backend] -> FilePath -> Annex (Maybe (Key, Backend))
|
genKey' :: [Backend] -> FilePath -> Annex (Maybe (Key, Backend))
|
||||||
genKey' [] _ = return Nothing
|
genKey' [] _ = return Nothing
|
||||||
genKey' (b:bs) file = do
|
genKey' (b:bs) file = do
|
||||||
r <- (B.getKey b) file
|
r <- B.getKey b file
|
||||||
case r of
|
case r of
|
||||||
Nothing -> genKey' bs file
|
Nothing -> genKey' bs file
|
||||||
Just k -> return $ Just (makesane k, b)
|
Just k -> return $ Just (makesane k, b)
|
||||||
|
|
|
@ -30,7 +30,7 @@ seek = [withField fromOption Remote.byName $ \from ->
|
||||||
withFilesInGit $ whenAnnexed $ start from]
|
withFilesInGit $ whenAnnexed $ start from]
|
||||||
|
|
||||||
start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
|
start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
|
||||||
start from file (key, _) = autoCopies file key (>) $ \numcopies -> do
|
start from file (key, _) = autoCopies file key (>) $ \numcopies ->
|
||||||
case from of
|
case from of
|
||||||
Nothing -> startLocal file numcopies key
|
Nothing -> startLocal file numcopies key
|
||||||
Just remote -> do
|
Just remote -> do
|
||||||
|
|
|
@ -36,7 +36,7 @@ seek :: [CommandSeek]
|
||||||
seek = [withField formatOption formatconverter $ \f ->
|
seek = [withField formatOption formatconverter $ \f ->
|
||||||
withFilesInGit $ whenAnnexed $ start f]
|
withFilesInGit $ whenAnnexed $ start f]
|
||||||
where
|
where
|
||||||
formatconverter = return . maybe Nothing (Just . Utility.Format.gen)
|
formatconverter = return . fmap Utility.Format.gen
|
||||||
|
|
||||||
start :: Maybe Utility.Format.Format -> FilePath -> (Key, Backend) -> CommandStart
|
start :: Maybe Utility.Format.Format -> FilePath -> (Key, Backend) -> CommandStart
|
||||||
start format file (key, _) = do
|
start format file (key, _) = do
|
||||||
|
|
|
@ -23,7 +23,7 @@ seek = [withField Command.Move.fromOption Remote.byName $ \from ->
|
||||||
|
|
||||||
start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
|
start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
|
||||||
start from file (key, _) = stopUnless (not <$> inAnnex key) $
|
start from file (key, _) = stopUnless (not <$> inAnnex key) $
|
||||||
autoCopies file key (<) $ \_numcopies -> do
|
autoCopies file key (<) $ \_numcopies ->
|
||||||
case from of
|
case from of
|
||||||
Nothing -> go $ perform key
|
Nothing -> go $ perform key
|
||||||
Just src -> do
|
Just src -> do
|
||||||
|
@ -36,7 +36,7 @@ start from file (key, _) = stopUnless (not <$> inAnnex key) $
|
||||||
next a
|
next a
|
||||||
|
|
||||||
perform :: Key -> CommandPerform
|
perform :: Key -> CommandPerform
|
||||||
perform key = stopUnless (getViaTmp key $ getKeyFile key) $ do
|
perform key = stopUnless (getViaTmp key $ getKeyFile key) $
|
||||||
next $ return True -- no cleanup needed
|
next $ return True -- no cleanup needed
|
||||||
|
|
||||||
{- Try to find a copy of the file in one of the remotes,
|
{- Try to find a copy of the file in one of the remotes,
|
||||||
|
|
|
@ -55,7 +55,7 @@ gourceOption :: Option
|
||||||
gourceOption = Option.flag [] "gource" "format output for gource"
|
gourceOption = Option.flag [] "gource" "format output for gource"
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withValue (Remote.uuidDescriptions) $ \m ->
|
seek = [withValue Remote.uuidDescriptions $ \m ->
|
||||||
withValue (liftIO getCurrentTimeZone) $ \zone ->
|
withValue (liftIO getCurrentTimeZone) $ \zone ->
|
||||||
withValue (concat <$> mapM getoption passthruOptions) $ \os ->
|
withValue (concat <$> mapM getoption passthruOptions) $ \os ->
|
||||||
withFlag gourceOption $ \gource ->
|
withFlag gourceOption $ \gource ->
|
||||||
|
@ -65,7 +65,7 @@ seek = [withValue (Remote.uuidDescriptions) $ \m ->
|
||||||
Annex.getField (Option.name o)
|
Annex.getField (Option.name o)
|
||||||
use o v = [Param ("--" ++ Option.name o), Param v]
|
use o v = [Param ("--" ++ Option.name o), Param v]
|
||||||
|
|
||||||
start :: (M.Map UUID String) -> TimeZone -> [CommandParam] -> Bool ->
|
start :: M.Map UUID String -> TimeZone -> [CommandParam] -> Bool ->
|
||||||
FilePath -> (Key, Backend) -> CommandStart
|
FilePath -> (Key, Backend) -> CommandStart
|
||||||
start m zone os gource file (key, _) = do
|
start m zone os gource file (key, _) = do
|
||||||
showLog output =<< readLog <$> getLog key os
|
showLog output =<< readLog <$> getLog key os
|
||||||
|
@ -91,7 +91,7 @@ showLog outputter ps = do
|
||||||
catObject ref
|
catObject ref
|
||||||
|
|
||||||
normalOutput :: (UUID -> String) -> FilePath -> TimeZone -> Outputter
|
normalOutput :: (UUID -> String) -> FilePath -> TimeZone -> Outputter
|
||||||
normalOutput lookupdescription file zone present ts us = do
|
normalOutput lookupdescription file zone present ts us =
|
||||||
liftIO $ mapM_ (putStrLn . format) us
|
liftIO $ mapM_ (putStrLn . format) us
|
||||||
where
|
where
|
||||||
time = showTimeStamp zone ts
|
time = showTimeStamp zone ts
|
||||||
|
@ -100,7 +100,7 @@ normalOutput lookupdescription file zone present ts us = do
|
||||||
fromUUID u ++ " -- " ++ lookupdescription u ]
|
fromUUID u ++ " -- " ++ lookupdescription u ]
|
||||||
|
|
||||||
gourceOutput :: (UUID -> String) -> FilePath -> Outputter
|
gourceOutput :: (UUID -> String) -> FilePath -> Outputter
|
||||||
gourceOutput lookupdescription file present ts us = do
|
gourceOutput lookupdescription file present ts us =
|
||||||
liftIO $ mapM_ (putStrLn . intercalate "|" . format) us
|
liftIO $ mapM_ (putStrLn . intercalate "|" . format) us
|
||||||
where
|
where
|
||||||
time = takeWhile isDigit $ show ts
|
time = takeWhile isDigit $ show ts
|
||||||
|
|
|
@ -23,7 +23,7 @@ seek = [withWords start]
|
||||||
start :: [FilePath] -> CommandStart
|
start :: [FilePath] -> CommandStart
|
||||||
start (src:dest:[])
|
start (src:dest:[])
|
||||||
| src == dest = stop
|
| src == dest = stop
|
||||||
| otherwise = do
|
| otherwise =
|
||||||
ifAnnexed src
|
ifAnnexed src
|
||||||
(error $ "cannot used annexed file as src: " ++ src)
|
(error $ "cannot used annexed file as src: " ++ src)
|
||||||
go
|
go
|
||||||
|
|
|
@ -33,7 +33,7 @@ seek :: CommandSeek
|
||||||
seek rs = do
|
seek rs = do
|
||||||
!branch <- fromMaybe nobranch <$> inRepo Git.Branch.current
|
!branch <- fromMaybe nobranch <$> inRepo Git.Branch.current
|
||||||
remotes <- syncRemotes rs
|
remotes <- syncRemotes rs
|
||||||
return $ concat $
|
return $ concat
|
||||||
[ [ commit ]
|
[ [ commit ]
|
||||||
, [ mergeLocal branch ]
|
, [ mergeLocal branch ]
|
||||||
, [ pullRemote remote branch | remote <- remotes ]
|
, [ pullRemote remote branch | remote <- remotes ]
|
||||||
|
@ -137,9 +137,9 @@ pushRemote remote branch = go =<< needpush
|
||||||
showStart "push" (Remote.name remote)
|
showStart "push" (Remote.name remote)
|
||||||
next $ next $ do
|
next $ next $ do
|
||||||
showOutput
|
showOutput
|
||||||
inRepo $ Git.Command.runBool "push" $
|
inRepo $ Git.Command.runBool "push"
|
||||||
[ Param (Remote.name remote)
|
[ Param (Remote.name remote)
|
||||||
, Param (show $ Annex.Branch.name)
|
, Param (show Annex.Branch.name)
|
||||||
, Param refspec
|
, Param refspec
|
||||||
]
|
]
|
||||||
refspec = show (Git.Ref.base branch) ++ ":" ++ show (Git.Ref.base syncbranch)
|
refspec = show (Git.Ref.base branch) ++ ":" ++ show (Git.Ref.base syncbranch)
|
||||||
|
|
|
@ -39,7 +39,7 @@ fromOption :: Option
|
||||||
fromOption = Option.field ['f'] "from" paramRemote "remote to check for unused content"
|
fromOption = Option.field ['f'] "from" paramRemote "remote to check for unused content"
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withNothing $ start]
|
seek = [withNothing start]
|
||||||
|
|
||||||
{- Finds unused content in the annex. -}
|
{- Finds unused content in the annex. -}
|
||||||
start :: CommandStart
|
start :: CommandStart
|
||||||
|
|
|
@ -22,12 +22,12 @@ seek :: [CommandSeek]
|
||||||
seek = [withValue (remoteMap id) $ \m ->
|
seek = [withValue (remoteMap id) $ \m ->
|
||||||
withFilesInGit $ whenAnnexed $ start m]
|
withFilesInGit $ whenAnnexed $ start m]
|
||||||
|
|
||||||
start :: (M.Map UUID Remote) -> FilePath -> (Key, Backend) -> CommandStart
|
start :: M.Map UUID Remote -> FilePath -> (Key, Backend) -> CommandStart
|
||||||
start remotemap file (key, _) = do
|
start remotemap file (key, _) = do
|
||||||
showStart "whereis" file
|
showStart "whereis" file
|
||||||
next $ perform remotemap key
|
next $ perform remotemap key
|
||||||
|
|
||||||
perform :: (M.Map UUID Remote) -> Key -> CommandPerform
|
perform :: M.Map UUID Remote -> Key -> CommandPerform
|
||||||
perform remotemap key = do
|
perform remotemap key = do
|
||||||
locations <- keyLocations key
|
locations <- keyLocations key
|
||||||
(untrustedlocations, safelocations) <- trustPartition UnTrusted locations
|
(untrustedlocations, safelocations) <- trustPartition UnTrusted locations
|
||||||
|
|
2
Init.hs
2
Init.hs
|
@ -68,7 +68,7 @@ gitPreCommitHookUnWrite = unlessBare $ do
|
||||||
" Edit it to remove call to git annex."
|
" Edit it to remove call to git annex."
|
||||||
|
|
||||||
unlessBare :: Annex () -> Annex ()
|
unlessBare :: Annex () -> Annex ()
|
||||||
unlessBare = unlessM $ fromRepo $ Git.repoIsLocalBare
|
unlessBare = unlessM $ fromRepo Git.repoIsLocalBare
|
||||||
|
|
||||||
preCommitHook :: Annex FilePath
|
preCommitHook :: Annex FilePath
|
||||||
preCommitHook = (</>) <$> fromRepo Git.gitDir <*> pure "hooks/pre-commit"
|
preCommitHook = (</>) <$> fromRepo Git.gitDir <*> pure "hooks/pre-commit"
|
||||||
|
|
|
@ -79,7 +79,7 @@ configUnEscape = unescape
|
||||||
num = takeWhile isNumber s
|
num = takeWhile isNumber s
|
||||||
r = drop (length num) s
|
r = drop (length num) s
|
||||||
rest = drop 1 r
|
rest = drop 1 r
|
||||||
ok = not (null num) && take 1 r == ";"
|
ok = not (null num) && ":" `isPrefixOf` r
|
||||||
|
|
||||||
{- for quickcheck -}
|
{- for quickcheck -}
|
||||||
prop_idempotent_configEscape :: String -> Bool
|
prop_idempotent_configEscape :: String -> Bool
|
||||||
|
|
|
@ -132,7 +132,7 @@ handle json normal = Annex.getState Annex.output >>= go
|
||||||
where
|
where
|
||||||
go Annex.NormalOutput = liftIO normal
|
go Annex.NormalOutput = liftIO normal
|
||||||
go Annex.QuietOutput = q
|
go Annex.QuietOutput = q
|
||||||
go Annex.JSONOutput = liftIO $ flushed $ json
|
go Annex.JSONOutput = liftIO $ flushed json
|
||||||
|
|
||||||
q :: Monad m => m ()
|
q :: Monad m => m ()
|
||||||
q = return ()
|
q = return ()
|
||||||
|
|
|
@ -37,7 +37,7 @@ common =
|
||||||
"allow verbose output (default)"
|
"allow verbose output (default)"
|
||||||
, Option ['j'] ["json"] (NoArg (setoutput Annex.JSONOutput))
|
, Option ['j'] ["json"] (NoArg (setoutput Annex.JSONOutput))
|
||||||
"enable JSON output"
|
"enable JSON output"
|
||||||
, Option ['d'] ["debug"] (NoArg (setdebug))
|
, Option ['d'] ["debug"] (NoArg setdebug)
|
||||||
"show debug messages"
|
"show debug messages"
|
||||||
, Option ['b'] ["backend"] (ReqArg setforcebackend paramName)
|
, Option ['b'] ["backend"] (ReqArg setforcebackend paramName)
|
||||||
"specify key-value backend to use"
|
"specify key-value backend to use"
|
||||||
|
|
|
@ -215,4 +215,4 @@ forceTrust level remotename = do
|
||||||
- key to the remote, or removing the key from it *may* log the change
|
- key to the remote, or removing the key from it *may* log the change
|
||||||
- on the remote, but this cannot always be relied on. -}
|
- on the remote, but this cannot always be relied on. -}
|
||||||
logStatus :: Remote -> Key -> LogStatus -> Annex ()
|
logStatus :: Remote -> Key -> LogStatus -> Annex ()
|
||||||
logStatus remote key present = logChange key (uuid remote) present
|
logStatus remote key = logChange key (uuid remote)
|
||||||
|
|
|
@ -94,7 +94,7 @@ gen = filter (not . empty) . fuse [] . scan [] . decode_c
|
||||||
| i < 0 = LeftJustified (-1 * i)
|
| i < 0 = LeftJustified (-1 * i)
|
||||||
| otherwise = RightJustified i
|
| otherwise = RightJustified i
|
||||||
novar v = "${" ++ reverse v
|
novar v = "${" ++ reverse v
|
||||||
foundvar f v p cs = scan (Var (reverse v) p : f) cs
|
foundvar f v p = scan (Var (reverse v) p : f)
|
||||||
|
|
||||||
empty :: Frag -> Bool
|
empty :: Frag -> Bool
|
||||||
empty (Const "") = True
|
empty (Const "") = True
|
||||||
|
|
|
@ -108,8 +108,7 @@ request url requesttype = go 5 url
|
||||||
(3,0,x) | x /= 5 -> redir (n - 1) u rsp
|
(3,0,x) | x /= 5 -> redir (n - 1) u rsp
|
||||||
_ -> return rsp
|
_ -> return rsp
|
||||||
ignore = const $ return ()
|
ignore = const $ return ()
|
||||||
redir n u rsp = do
|
redir n u rsp = case retrieveHeaders HdrLocation rsp of
|
||||||
case retrieveHeaders HdrLocation rsp of
|
|
||||||
[] -> return rsp
|
[] -> return rsp
|
||||||
(Header _ newu:_) ->
|
(Header _ newu:_) ->
|
||||||
case parseURIReference newu of
|
case parseURIReference newu of
|
||||||
|
|
Loading…
Reference in a new issue