diff options
-rw-r--r-- | Annex/Branch.hs | 4 | ||||
-rw-r--r-- | Annex/Ssh.hs | 8 | ||||
-rw-r--r-- | Backend.hs | 2 | ||||
-rw-r--r-- | Command/Drop.hs | 2 | ||||
-rw-r--r-- | Command/Find.hs | 2 | ||||
-rw-r--r-- | Command/Get.hs | 4 | ||||
-rw-r--r-- | Command/Log.hs | 8 | ||||
-rw-r--r-- | Command/Reinject.hs | 2 | ||||
-rw-r--r-- | Command/Sync.hs | 6 | ||||
-rw-r--r-- | Command/Unused.hs | 2 | ||||
-rw-r--r-- | Command/Whereis.hs | 4 | ||||
-rw-r--r-- | Init.hs | 2 | ||||
-rw-r--r-- | Logs/Remote.hs | 2 | ||||
-rw-r--r-- | Messages.hs | 2 | ||||
-rw-r--r-- | Option.hs | 2 | ||||
-rw-r--r-- | Remote.hs | 2 | ||||
-rw-r--r-- | Utility/Format.hs | 2 | ||||
-rw-r--r-- | Utility/Url.hs | 17 |
18 files changed, 36 insertions, 37 deletions
diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 388cbc12d..acab417fb 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -116,7 +116,7 @@ updateTo pairs = do -- check what needs updating before taking the lock dirty <- journalDirty (refs, branches) <- unzip <$> filterM isnewer pairs - if (not dirty && null refs) + if not dirty && null refs then updateIndex branchref else withIndex $ lockJournal $ do when dirty stageJournal @@ -172,7 +172,7 @@ get' staleok file = fromcache =<< getCache file - modifes the current content of the file on the branch. -} 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. -} set :: FilePath -> String -> Annex () diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs index 184eb92ca..df9f0e410 100644 --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -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 -- run. There could be stale ssh connections hanging around -- 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 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") if caching then do - dir <- fromRepo $ gitAnnexSshDir + dir <- fromRepo gitAnnexSshDir let socketfile = dir </> hostport2socket host port - return $ (Just socketfile, cacheParams socketfile) + return (Just socketfile, cacheParams socketfile) else return (Nothing, []) cacheParams :: FilePath -> [CommandParam] @@ -58,7 +58,7 @@ portParams (Just port) = [Param "-p", Param $ show port] {- Stop any unused ssh processes. -} sshCleanup :: Annex () sshCleanup = do - dir <- fromRepo $ gitAnnexSshDir + dir <- fromRepo gitAnnexSshDir liftIO $ createDirectoryIfMissing True dir sockets <- filter (not . isLock) <$> liftIO (dirContents dir) forM_ sockets cleanup diff --git a/Backend.hs b/Backend.hs index 4c28f1c77..6810c3a44 100644 --- a/Backend.hs +++ b/Backend.hs @@ -60,7 +60,7 @@ genKey file trybackend = do genKey' :: [Backend] -> FilePath -> Annex (Maybe (Key, Backend)) genKey' [] _ = return Nothing genKey' (b:bs) file = do - r <- (B.getKey b) file + r <- B.getKey b file case r of Nothing -> genKey' bs file Just k -> return $ Just (makesane k, b) diff --git a/Command/Drop.hs b/Command/Drop.hs index 9eb36a22f..28a52d626 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -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 diff --git a/Command/Find.hs b/Command/Find.hs index 902f50d2e..33f512e39 100644 --- a/Command/Find.hs +++ b/Command/Find.hs @@ -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 diff --git a/Command/Get.hs b/Command/Get.hs index 928ab0f1b..9b12b9599 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -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, diff --git a/Command/Log.hs b/Command/Log.hs index 4013b535e..d78b60206 100644 --- a/Command/Log.hs +++ b/Command/Log.hs @@ -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 diff --git a/Command/Reinject.hs b/Command/Reinject.hs index 480806e11..bb277af2c 100644 --- a/Command/Reinject.hs +++ b/Command/Reinject.hs @@ -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 diff --git a/Command/Sync.hs b/Command/Sync.hs index 3d541c4de..8e237ae84 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -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) diff --git a/Command/Unused.hs b/Command/Unused.hs index 1c82b9ae4..58a99882e 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -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 diff --git a/Command/Whereis.hs b/Command/Whereis.hs index f62d34642..d4d268d93 100644 --- a/Command/Whereis.hs +++ b/Command/Whereis.hs @@ -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 @@ -68,7 +68,7 @@ gitPreCommitHookUnWrite = unlessBare $ do " Edit it to remove call to git annex." unlessBare :: Annex () -> Annex () -unlessBare = unlessM $ fromRepo $ Git.repoIsLocalBare +unlessBare = unlessM $ fromRepo Git.repoIsLocalBare preCommitHook :: Annex FilePath preCommitHook = (</>) <$> fromRepo Git.gitDir <*> pure "hooks/pre-commit" diff --git a/Logs/Remote.hs b/Logs/Remote.hs index d9b41d8c4..c38a05c18 100644 --- a/Logs/Remote.hs +++ b/Logs/Remote.hs @@ -79,7 +79,7 @@ configUnEscape = unescape num = takeWhile isNumber s r = drop (length num) s rest = drop 1 r - ok = not (null num) && take 1 r == ";" + ok = not (null num) && ":" `isPrefixOf` r {- for quickcheck -} prop_idempotent_configEscape :: String -> Bool diff --git a/Messages.hs b/Messages.hs index 982b9313c..1b51cf23e 100644 --- a/Messages.hs +++ b/Messages.hs @@ -132,7 +132,7 @@ handle json normal = Annex.getState Annex.output >>= go where go Annex.NormalOutput = liftIO normal go Annex.QuietOutput = q - go Annex.JSONOutput = liftIO $ flushed $ json + go Annex.JSONOutput = liftIO $ flushed json q :: Monad m => m () q = return () @@ -37,7 +37,7 @@ common = "allow verbose output (default)" , Option ['j'] ["json"] (NoArg (setoutput Annex.JSONOutput)) "enable JSON output" - , Option ['d'] ["debug"] (NoArg (setdebug)) + , Option ['d'] ["debug"] (NoArg setdebug) "show debug messages" , Option ['b'] ["backend"] (ReqArg setforcebackend paramName) "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 - on the remote, but this cannot always be relied on. -} logStatus :: Remote -> Key -> LogStatus -> Annex () -logStatus remote key present = logChange key (uuid remote) present +logStatus remote key = logChange key (uuid remote) diff --git a/Utility/Format.hs b/Utility/Format.hs index 79e94ae96..1d96695ed 100644 --- a/Utility/Format.hs +++ b/Utility/Format.hs @@ -94,7 +94,7 @@ gen = filter (not . empty) . fuse [] . scan [] . decode_c | i < 0 = LeftJustified (-1 * i) | otherwise = RightJustified i 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 (Const "") = True diff --git a/Utility/Url.hs b/Utility/Url.hs index dfdebaf06..8a43cf788 100644 --- a/Utility/Url.hs +++ b/Utility/Url.hs @@ -108,12 +108,11 @@ request url requesttype = go 5 url (3,0,x) | x /= 5 -> redir (n - 1) u rsp _ -> return rsp ignore = const $ return () - redir n u rsp = do - case retrieveHeaders HdrLocation rsp of - [] -> return rsp - (Header _ newu:_) -> - case parseURIReference newu of - Nothing -> return rsp - Just newURI -> go n newURI_abs - where - newURI_abs = fromMaybe newURI (newURI `relativeTo` u) + redir n u rsp = case retrieveHeaders HdrLocation rsp of + [] -> return rsp + (Header _ newu:_) -> + case parseURIReference newu of + Nothing -> return rsp + Just newURI -> go n newURI_abs + where + newURI_abs = fromMaybe newURI (newURI `relativeTo` u) |