hlint
This commit is contained in:
parent
e7aaa55c53
commit
a1e52f0ce5
18 changed files with 36 additions and 37 deletions
|
@ -30,7 +30,7 @@ seek = [withField fromOption Remote.byName $ \from ->
|
|||
withFilesInGit $ whenAnnexed $ start from]
|
||||
|
||||
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
|
||||
Nothing -> startLocal file numcopies key
|
||||
Just remote -> do
|
||||
|
|
|
@ -36,7 +36,7 @@ seek :: [CommandSeek]
|
|||
seek = [withField formatOption formatconverter $ \f ->
|
||||
withFilesInGit $ whenAnnexed $ start f]
|
||||
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 format file (key, _) = do
|
||||
|
|
|
@ -23,7 +23,7 @@ seek = [withField Command.Move.fromOption Remote.byName $ \from ->
|
|||
|
||||
start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
|
||||
start from file (key, _) = stopUnless (not <$> inAnnex key) $
|
||||
autoCopies file key (<) $ \_numcopies -> do
|
||||
autoCopies file key (<) $ \_numcopies ->
|
||||
case from of
|
||||
Nothing -> go $ perform key
|
||||
Just src -> do
|
||||
|
@ -36,7 +36,7 @@ start from file (key, _) = stopUnless (not <$> inAnnex key) $
|
|||
next a
|
||||
|
||||
perform :: Key -> CommandPerform
|
||||
perform key = stopUnless (getViaTmp key $ getKeyFile key) $ do
|
||||
perform key = stopUnless (getViaTmp key $ getKeyFile key) $
|
||||
next $ return True -- no cleanup needed
|
||||
|
||||
{- 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"
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = [withValue (Remote.uuidDescriptions) $ \m ->
|
||||
seek = [withValue Remote.uuidDescriptions $ \m ->
|
||||
withValue (liftIO getCurrentTimeZone) $ \zone ->
|
||||
withValue (concat <$> mapM getoption passthruOptions) $ \os ->
|
||||
withFlag gourceOption $ \gource ->
|
||||
|
@ -65,7 +65,7 @@ seek = [withValue (Remote.uuidDescriptions) $ \m ->
|
|||
Annex.getField (Option.name o)
|
||||
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
|
||||
start m zone os gource file (key, _) = do
|
||||
showLog output =<< readLog <$> getLog key os
|
||||
|
@ -91,7 +91,7 @@ showLog outputter ps = do
|
|||
catObject ref
|
||||
|
||||
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
|
||||
where
|
||||
time = showTimeStamp zone ts
|
||||
|
@ -100,7 +100,7 @@ normalOutput lookupdescription file zone present ts us = do
|
|||
fromUUID u ++ " -- " ++ lookupdescription u ]
|
||||
|
||||
gourceOutput :: (UUID -> String) -> FilePath -> Outputter
|
||||
gourceOutput lookupdescription file present ts us = do
|
||||
gourceOutput lookupdescription file present ts us =
|
||||
liftIO $ mapM_ (putStrLn . intercalate "|" . format) us
|
||||
where
|
||||
time = takeWhile isDigit $ show ts
|
||||
|
|
|
@ -23,7 +23,7 @@ seek = [withWords start]
|
|||
start :: [FilePath] -> CommandStart
|
||||
start (src:dest:[])
|
||||
| src == dest = stop
|
||||
| otherwise = do
|
||||
| otherwise =
|
||||
ifAnnexed src
|
||||
(error $ "cannot used annexed file as src: " ++ src)
|
||||
go
|
||||
|
|
|
@ -33,7 +33,7 @@ seek :: CommandSeek
|
|||
seek rs = do
|
||||
!branch <- fromMaybe nobranch <$> inRepo Git.Branch.current
|
||||
remotes <- syncRemotes rs
|
||||
return $ concat $
|
||||
return $ concat
|
||||
[ [ commit ]
|
||||
, [ mergeLocal branch ]
|
||||
, [ pullRemote remote branch | remote <- remotes ]
|
||||
|
@ -137,9 +137,9 @@ pushRemote remote branch = go =<< needpush
|
|||
showStart "push" (Remote.name remote)
|
||||
next $ next $ do
|
||||
showOutput
|
||||
inRepo $ Git.Command.runBool "push" $
|
||||
inRepo $ Git.Command.runBool "push"
|
||||
[ Param (Remote.name remote)
|
||||
, Param (show $ Annex.Branch.name)
|
||||
, Param (show Annex.Branch.name)
|
||||
, Param refspec
|
||||
]
|
||||
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"
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = [withNothing $ start]
|
||||
seek = [withNothing start]
|
||||
|
||||
{- Finds unused content in the annex. -}
|
||||
start :: CommandStart
|
||||
|
|
|
@ -22,12 +22,12 @@ seek :: [CommandSeek]
|
|||
seek = [withValue (remoteMap id) $ \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
|
||||
showStart "whereis" file
|
||||
next $ perform remotemap key
|
||||
|
||||
perform :: (M.Map UUID Remote) -> Key -> CommandPerform
|
||||
perform :: M.Map UUID Remote -> Key -> CommandPerform
|
||||
perform remotemap key = do
|
||||
locations <- keyLocations key
|
||||
(untrustedlocations, safelocations) <- trustPartition UnTrusted locations
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue