diff options
author | Joey Hess <joey@kitenet.net> | 2012-11-11 00:51:07 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-11-11 00:51:07 -0400 |
commit | 264bd9ebe37855d4005022df057da13ec8080afb (patch) | |
tree | f32f13646ece29c8f6336b8680cb07dd55187be5 /Logs | |
parent | d9f5cc9f73ea046fcd2b59b5e75d4600593ac05b (diff) |
where indenting
Diffstat (limited to 'Logs')
-rw-r--r-- | Logs/Group.hs | 8 | ||||
-rw-r--r-- | Logs/Location.hs | 18 | ||||
-rw-r--r-- | Logs/PreferredContent.hs | 14 | ||||
-rw-r--r-- | Logs/Presence.hs | 34 | ||||
-rw-r--r-- | Logs/Remote.hs | 50 | ||||
-rw-r--r-- | Logs/Transfer.hs | 153 | ||||
-rw-r--r-- | Logs/Trust.hs | 19 | ||||
-rw-r--r-- | Logs/UUID.hs | 48 | ||||
-rw-r--r-- | Logs/UUIDBased.hs | 58 | ||||
-rw-r--r-- | Logs/Unused.hs | 37 | ||||
-rw-r--r-- | Logs/Web.hs | 14 |
11 files changed, 224 insertions, 229 deletions
diff --git a/Logs/Group.hs b/Logs/Group.hs index de0d1e598..a069edcdf 100644 --- a/Logs/Group.hs +++ b/Logs/Group.hs @@ -64,10 +64,10 @@ groupMapLoad = do makeGroupMap :: M.Map UUID (S.Set Group) -> GroupMap makeGroupMap byuuid = GroupMap byuuid bygroup - where - bygroup = M.fromListWith S.union $ - concat $ map explode $ M.toList byuuid - explode (u, s) = map (\g -> (g, S.singleton u)) (S.toList s) + where + bygroup = M.fromListWith S.union $ + concat $ map explode $ M.toList byuuid + explode (u, s) = map (\g -> (g, S.singleton u)) (S.toList s) {- If a repository is in exactly one standard group, returns it. -} getStandardGroup :: S.Set Group -> Maybe StandardGroup diff --git a/Logs/Location.hs b/Logs/Location.hs index e27ece5d4..4273710fc 100644 --- a/Logs/Location.hs +++ b/Logs/Location.hs @@ -47,13 +47,13 @@ loggedKeys = mapMaybe (logFileKey . takeFileName) <$> Annex.Branch.files - they are present for the specified repository. -} loggedKeysFor :: UUID -> Annex [Key] loggedKeysFor u = filterM isthere =<< loggedKeys - where - {- This should run strictly to avoid the filterM - - building many thunks containing keyLocations data. -} - isthere k = do - us <- loggedLocations k - let !there = u `elem` us - return there + where + {- This should run strictly to avoid the filterM + - building many thunks containing keyLocations data. -} + isthere k = do + us <- loggedLocations k + let !there = u `elem` us + return there {- The filename of the log file for a given key. -} logFile :: Key -> String @@ -64,5 +64,5 @@ logFileKey :: FilePath -> Maybe Key logFileKey file | ext == ".log" = fileKey base | otherwise = Nothing - where - (base, ext) = splitAt (length file - 4) file + where + (base, ext) = splitAt (length file - 4) file diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs index 003efaeae..ddcc2acf8 100644 --- a/Logs/PreferredContent.hs +++ b/Logs/PreferredContent.hs @@ -90,8 +90,8 @@ makeMatcher groupmap u s | s == "standard" = standardMatcher groupmap u | null (lefts tokens) = Utility.Matcher.generate $ rights tokens | otherwise = matchAll - where - tokens = map (parseToken (Just u) groupmap) (tokenizeMatcher s) + where + tokens = map (parseToken (Just u) groupmap) (tokenizeMatcher s) {- Standard matchers are pre-defined for some groups. If none is defined, - or a repository is in multiple groups with standard matchers, match all. -} @@ -124,17 +124,17 @@ parseToken mu groupmap t , ("smallerthan", limitSize (<)) , ("inallgroup", limitInAllGroup groupmap) ] - where - (k, v) = separate (== '=') t - use a = Utility.Matcher.Operation <$> a v + where + (k, v) = separate (== '=') t + use a = Utility.Matcher.Operation <$> a v {- This is really dumb tokenization; there's no support for quoted values. - Open and close parens are always treated as standalone tokens; - otherwise tokens must be separated by whitespace. -} tokenizeMatcher :: String -> [String] tokenizeMatcher = filter (not . null ) . concatMap splitparens . words - where - splitparens = segmentDelim (`elem` "()") + where + splitparens = segmentDelim (`elem` "()") {- Puts a UUID in a standard group, and sets its preferred content to use - the standard expression for that group, unless something is already set. -} diff --git a/Logs/Presence.hs b/Logs/Presence.hs index e75e1e4e6..ce5dd5780 100644 --- a/Logs/Presence.hs +++ b/Logs/Presence.hs @@ -53,23 +53,23 @@ readLog = parseLog <$$> Annex.Branch.get {- Parses a log file. Unparseable lines are ignored. -} parseLog :: String -> [LogLine] parseLog = mapMaybe (parseline . words) . lines - where - parseline (a:b:c:_) = do - d <- parseTime defaultTimeLocale "%s%Qs" a - s <- parsestatus b - Just $ LogLine (utcTimeToPOSIXSeconds d) s c - parseline _ = Nothing - parsestatus "1" = Just InfoPresent - parsestatus "0" = Just InfoMissing - parsestatus _ = Nothing + where + parseline (a:b:c:_) = do + d <- parseTime defaultTimeLocale "%s%Qs" a + s <- parsestatus b + Just $ LogLine (utcTimeToPOSIXSeconds d) s c + parseline _ = Nothing + parsestatus "1" = Just InfoPresent + parsestatus "0" = Just InfoMissing + parsestatus _ = Nothing {- Generates a log file. -} showLog :: [LogLine] -> String showLog = unlines . map genline - where - genline (LogLine d s i) = unwords [show d, genstatus s, i] - genstatus InfoPresent = "1" - genstatus InfoMissing = "0" + where + genline (LogLine d s i) = unwords [show d, genstatus s, i] + genstatus InfoPresent = "1" + genstatus InfoMissing = "0" {- Generates a new LogLine with the current date. -} logNow :: LogStatus -> String -> Annex LogLine @@ -102,7 +102,7 @@ mapLog :: LogLine -> LogMap -> LogMap mapLog l m | better = M.insert i l m | otherwise = m - where - better = maybe True newer $ M.lookup i m - newer l' = date l' <= date l - i = info l + where + better = maybe True newer $ M.lookup i m + newer l' = date l' <= date l + i = info l diff --git a/Logs/Remote.hs b/Logs/Remote.hs index d4991e272..3348059b4 100644 --- a/Logs/Remote.hs +++ b/Logs/Remote.hs @@ -48,40 +48,40 @@ showConfig = unwords . configToKeyVal {- Given Strings like "key=value", generates a RemoteConfig. -} keyValToConfig :: [String] -> RemoteConfig keyValToConfig ws = M.fromList $ map (/=/) ws - where - (/=/) s = (k, v) - where - k = takeWhile (/= '=') s - v = configUnEscape $ drop (1 + length k) s + where + (/=/) s = (k, v) + where + k = takeWhile (/= '=') s + v = configUnEscape $ drop (1 + length k) s configToKeyVal :: M.Map String String -> [String] configToKeyVal m = map toword $ sort $ M.toList m - where - toword (k, v) = k ++ "=" ++ configEscape v + where + toword (k, v) = k ++ "=" ++ configEscape v configEscape :: String -> String configEscape = concatMap escape - where - escape c - | isSpace c || c `elem` "&" = "&" ++ show (ord c) ++ ";" - | otherwise = [c] + where + escape c + | isSpace c || c `elem` "&" = "&" ++ show (ord c) ++ ";" + | otherwise = [c] configUnEscape :: String -> String configUnEscape = unescape - where - unescape [] = [] - unescape (c:rest) - | c == '&' = entity rest - | otherwise = c : unescape rest - entity s - | not (null num) && ";" `isPrefixOf` r = - chr (Prelude.read num) : unescape rest - | otherwise = - '&' : unescape s - where - num = takeWhile isNumber s - r = drop (length num) s - rest = drop 1 r + where + unescape [] = [] + unescape (c:rest) + | c == '&' = entity rest + | otherwise = c : unescape rest + entity s + | not (null num) && ";" `isPrefixOf` r = + chr (Prelude.read num) : unescape rest + | otherwise = + '&' : unescape s + where + num = takeWhile isNumber s + r = drop (length num) s + rest = drop 1 r {- for quickcheck -} prop_idempotent_configEscape :: String -> Bool diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index 99b5a9bba..0135f32dd 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -109,43 +109,42 @@ runTransfer t file shouldretry a = do bracketIO (prep tfile mode info) (cleanup tfile) (a meter) unless ok $ failed info return ok - where - prep tfile mode info = catchMaybeIO $ do - fd <- openFd (transferLockFile tfile) ReadWrite (Just mode) - defaultFileFlags { trunc = True } - locked <- catchMaybeIO $ - setLock fd (WriteLock, AbsoluteSeek, 0, 0) - when (locked == Nothing) $ - error $ "transfer already in progress" - writeTransferInfoFile info tfile - return fd - cleanup _ Nothing = noop - cleanup tfile (Just fd) = do - void $ tryIO $ removeFile tfile - void $ tryIO $ removeFile $ transferLockFile tfile - closeFd fd - failed info = do - failedtfile <- fromRepo $ failedTransferFile t - createAnnexDirectory $ takeDirectory failedtfile - liftIO $ writeTransferInfoFile info failedtfile - retry oldinfo metervar run = do - v <- tryAnnex run - case v of - Right b -> return b - Left _ -> do - b <- getbytescomplete metervar - let newinfo = oldinfo { bytesComplete = Just b } - if shouldretry oldinfo newinfo - then retry newinfo metervar run - else return False - getbytescomplete metervar - | transferDirection t == Upload = - liftIO $ readMVar metervar - | otherwise = do - f <- fromRepo $ gitAnnexTmpLocation (transferKey t) - liftIO $ catchDefaultIO 0 $ - fromIntegral . fileSize - <$> getFileStatus f + where + prep tfile mode info = catchMaybeIO $ do + fd <- openFd (transferLockFile tfile) ReadWrite (Just mode) + defaultFileFlags { trunc = True } + locked <- catchMaybeIO $ + setLock fd (WriteLock, AbsoluteSeek, 0, 0) + when (locked == Nothing) $ + error $ "transfer already in progress" + writeTransferInfoFile info tfile + return fd + cleanup _ Nothing = noop + cleanup tfile (Just fd) = do + void $ tryIO $ removeFile tfile + void $ tryIO $ removeFile $ transferLockFile tfile + closeFd fd + failed info = do + failedtfile <- fromRepo $ failedTransferFile t + createAnnexDirectory $ takeDirectory failedtfile + liftIO $ writeTransferInfoFile info failedtfile + retry oldinfo metervar run = do + v <- tryAnnex run + case v of + Right b -> return b + Left _ -> do + b <- getbytescomplete metervar + let newinfo = oldinfo { bytesComplete = Just b } + if shouldretry oldinfo newinfo + then retry newinfo metervar run + else return False + getbytescomplete metervar + | transferDirection t == Upload = + liftIO $ readMVar metervar + | otherwise = do + f <- fromRepo $ gitAnnexTmpLocation (transferKey t) + liftIO $ catchDefaultIO 0 $ + fromIntegral . fileSize <$> getFileStatus f {- Generates a callback that can be called as transfer progresses to update - the transfer info file. Also returns the file it'll be updating, and a @@ -156,20 +155,20 @@ mkProgressUpdater t info = do _ <- tryAnnex $ createAnnexDirectory $ takeDirectory tfile mvar <- liftIO $ newMVar 0 return (liftIO . updater tfile mvar, tfile, mvar) - where - updater tfile mvar bytes = modifyMVar_ mvar $ \oldbytes -> do - if (bytes - oldbytes >= mindelta) - then do - let info' = info { bytesComplete = Just bytes } - _ <- tryIO $ writeTransferInfoFile info' tfile - return bytes - else return oldbytes - {- The minimum change in bytesComplete that is worth - - updating a transfer info file for is 1% of the total - - keySize, rounded down. -} - mindelta = case keySize (transferKey t) of - Just sz -> sz `div` 100 - Nothing -> 100 * 1024 -- arbitrarily, 100 kb + where + updater tfile mvar bytes = modifyMVar_ mvar $ \oldbytes -> do + if (bytes - oldbytes >= mindelta) + then do + let info' = info { bytesComplete = Just bytes } + _ <- tryIO $ writeTransferInfoFile info' tfile + return bytes + else return oldbytes + {- The minimum change in bytesComplete that is worth + - updating a transfer info file for is 1% of the total + - keySize, rounded down. -} + mindelta = case keySize (transferKey t) of + Just sz -> sz `div` 100 + Nothing -> 100 * 1024 -- arbitrarily, 100 kb startTransferInfo :: Maybe FilePath -> IO TransferInfo startTransferInfo file = TransferInfo @@ -206,25 +205,23 @@ getTransfers = do infos <- mapM checkTransfer transfers return $ map (\(t, Just i) -> (t, i)) $ filter running $ zip transfers infos - where - findfiles = liftIO . mapM dirContentsRecursive - =<< mapM (fromRepo . transferDir) - [Download, Upload] - running (_, i) = isJust i + where + findfiles = liftIO . mapM dirContentsRecursive + =<< mapM (fromRepo . transferDir) [Download, Upload] + running (_, i) = isJust i {- Gets failed transfers for a given remote UUID. -} getFailedTransfers :: UUID -> Annex [(Transfer, TransferInfo)] getFailedTransfers u = catMaybes <$> (liftIO . getpairs =<< concat <$> findfiles) - where - getpairs = mapM $ \f -> do - let mt = parseTransferFile f - mi <- readTransferInfoFile Nothing f - return $ case (mt, mi) of - (Just t, Just i) -> Just (t, i) - _ -> Nothing - findfiles = liftIO . mapM dirContentsRecursive - =<< mapM (fromRepo . failedTransferDir u) - [Download, Upload] + where + getpairs = mapM $ \f -> do + let mt = parseTransferFile f + mi <- readTransferInfoFile Nothing f + return $ case (mt, mi) of + (Just t, Just i) -> Just (t, i) + _ -> Nothing + findfiles = liftIO . mapM dirContentsRecursive + =<< mapM (fromRepo . failedTransferDir u) [Download, Upload] removeFailedTransfer :: Transfer -> Annex () removeFailedTransfer t = do @@ -257,8 +254,8 @@ parseTransferFile file <*> pure (toUUID u) <*> fileKey key _ -> Nothing - where - bits = splitDirectories file + where + bits = splitDirectories file writeTransferInfoFile :: TransferInfo -> FilePath -> IO () writeTransferInfoFile info tfile = do @@ -295,16 +292,16 @@ readTransferInfo mpid s = TransferInfo <*> bytes <*> pure (if null filename then Nothing else Just filename) <*> pure False - where - (firstline, filename) = separate (== '\n') s - bits = split " " firstline - numbits = length bits - time = if numbits > 0 - then Just <$> parsePOSIXTime =<< headMaybe bits - else pure Nothing -- not failure - bytes = if numbits > 1 - then Just <$> readish =<< headMaybe (drop 1 bits) - else pure Nothing -- not failure + where + (firstline, filename) = separate (== '\n') s + bits = split " " firstline + numbits = length bits + time = if numbits > 0 + then Just <$> parsePOSIXTime =<< headMaybe bits + else pure Nothing -- not failure + bytes = if numbits > 1 + then Just <$> readish =<< headMaybe (drop 1 bits) + else pure Nothing -- not failure parsePOSIXTime :: String -> Maybe POSIXTime parsePOSIXTime s = utcTimeToPOSIXSeconds diff --git a/Logs/Trust.hs b/Logs/Trust.hs index f61966b9e..e5322e04e 100644 --- a/Logs/Trust.hs +++ b/Logs/Trust.hs @@ -87,11 +87,10 @@ trustMapLoad = do let m = M.union overrides $ M.union configured logged Annex.changeState $ \s -> s { Annex.trustmap = Just m } return m - where - configuredtrust r = - maybe Nothing (\l -> Just (Types.Remote.uuid r, l)) <$> - maybe Nothing readTrustLevel - <$> getTrustLevel (Types.Remote.repo r) + where + configuredtrust r = maybe Nothing (\l -> Just (Types.Remote.uuid r, l)) + <$> maybe Nothing readTrustLevel + <$> getTrustLevel (Types.Remote.repo r) {- Does not include forcetrust or git config values, just those from the - log file. -} @@ -103,11 +102,11 @@ trustMapRaw = simpleMap . parseLog (Just . parseTrustLog) - trust status, which is why this defaults to Trusted. -} parseTrustLog :: String -> TrustLevel parseTrustLog s = maybe Trusted parse $ headMaybe $ words s - where - parse "1" = Trusted - parse "0" = UnTrusted - parse "X" = DeadTrusted - parse _ = SemiTrusted + where + parse "1" = Trusted + parse "0" = UnTrusted + parse "X" = DeadTrusted + parse _ = SemiTrusted showTrustLog :: TrustLevel -> String showTrustLog Trusted = "1" diff --git a/Logs/UUID.hs b/Logs/UUID.hs index 7b7090223..2f24a388e 100644 --- a/Logs/UUID.hs +++ b/Logs/UUID.hs @@ -53,32 +53,32 @@ describeUUID uuid desc = do -} fixBadUUID :: Log String -> Log String fixBadUUID = M.fromList . map fixup . M.toList - where - fixup (k, v) - | isbad = (fixeduuid, LogEntry (Date $ newertime v) fixedvalue) - | otherwise = (k, v) - where - kuuid = fromUUID k - isbad = not (isuuid kuuid) && isuuid lastword - ws = words $ value v - lastword = Prelude.last ws - fixeduuid = toUUID lastword - fixedvalue = unwords $ kuuid: Prelude.init ws - -- For the fixed line to take precidence, it should be - -- slightly newer, but only slightly. - newertime (LogEntry (Date d) _) = d + minimumPOSIXTimeSlice - newertime (LogEntry Unknown _) = minimumPOSIXTimeSlice - minimumPOSIXTimeSlice = 0.000001 - isuuid s = length s == 36 && length (split "-" s) == 5 + where + fixup (k, v) + | isbad = (fixeduuid, LogEntry (Date $ newertime v) fixedvalue) + | otherwise = (k, v) + where + kuuid = fromUUID k + isbad = not (isuuid kuuid) && isuuid lastword + ws = words $ value v + lastword = Prelude.last ws + fixeduuid = toUUID lastword + fixedvalue = unwords $ kuuid: Prelude.init ws + -- For the fixed line to take precidence, it should be + -- slightly newer, but only slightly. + newertime (LogEntry (Date d) _) = d + minimumPOSIXTimeSlice + newertime (LogEntry Unknown _) = minimumPOSIXTimeSlice + minimumPOSIXTimeSlice = 0.000001 + isuuid s = length s == 36 && length (split "-" s) == 5 {- Records the uuid in the log, if it's not already there. -} recordUUID :: UUID -> Annex () recordUUID u = go . M.lookup u =<< uuidMap - where - go (Just "") = set - go Nothing = set - go _ = noop - set = describeUUID u "" + where + go (Just "") = set + go Nothing = set + go _ = noop + set = describeUUID u "" {- The map is cached for speed. -} uuidMap :: Annex UUIDMap @@ -95,5 +95,5 @@ uuidMapLoad = do let m' = M.insertWith' preferold u "" m Annex.changeState $ \s -> s { Annex.uuidmap = Just m' } return m' - where - preferold = flip const + where + preferold = flip const diff --git a/Logs/UUIDBased.hs b/Logs/UUIDBased.hs index 674ac2184..c1901eef7 100644 --- a/Logs/UUIDBased.hs +++ b/Logs/UUIDBased.hs @@ -50,36 +50,36 @@ tskey = "timestamp=" showLog :: (a -> String) -> Log a -> String showLog shower = unlines . map showpair . M.toList - where - showpair (k, LogEntry (Date p) v) = - unwords [fromUUID k, shower v, tskey ++ show p] - showpair (k, LogEntry Unknown v) = - unwords [fromUUID k, shower v] + where + showpair (k, LogEntry (Date p) v) = + unwords [fromUUID k, shower v, tskey ++ show p] + showpair (k, LogEntry Unknown v) = + unwords [fromUUID k, shower v] parseLog :: (String -> Maybe a) -> String -> Log a parseLog = parseLogWithUUID . const parseLogWithUUID :: (UUID -> String -> Maybe a) -> String -> Log a parseLogWithUUID parser = M.fromListWith best . mapMaybe parse . lines - where - parse line - | null ws = Nothing - | otherwise = parser u (unwords info) >>= makepair - where - makepair v = Just (u, LogEntry ts v) - ws = words line - u = toUUID $ Prelude.head ws - t = Prelude.last ws - ts - | tskey `isPrefixOf` t = - pdate $ drop 1 $ dropWhile (/= '=') t - | otherwise = Unknown - info - | ts == Unknown = drop 1 ws - | otherwise = drop 1 $ beginning ws - pdate s = case parseTime defaultTimeLocale "%s%Qs" s of - Nothing -> Unknown - Just d -> Date $ utcTimeToPOSIXSeconds d + where + parse line + | null ws = Nothing + | otherwise = parser u (unwords info) >>= makepair + where + makepair v = Just (u, LogEntry ts v) + ws = words line + u = toUUID $ Prelude.head ws + t = Prelude.last ws + ts + | tskey `isPrefixOf` t = + pdate $ drop 1 $ dropWhile (/= '=') t + | otherwise = Unknown + info + | ts == Unknown = drop 1 ws + | otherwise = drop 1 $ beginning ws + pdate s = case parseTime defaultTimeLocale "%s%Qs" s of + Nothing -> Unknown + Just d -> Date $ utcTimeToPOSIXSeconds d changeLog :: POSIXTime -> UUID -> a -> Log a -> Log a changeLog t u v = M.insert u $ LogEntry (Date t) v @@ -106,9 +106,9 @@ prop_TimeStamp_sane = Unknown < Date 1 prop_addLog_sane :: Bool prop_addLog_sane = newWins && newestWins - where - newWins = addLog (UUID "foo") (LogEntry (Date 1) "new") l == l2 - newestWins = addLog (UUID "foo") (LogEntry (Date 1) "newest") l2 /= l2 + where + newWins = addLog (UUID "foo") (LogEntry (Date 1) "new") l == l2 + newestWins = addLog (UUID "foo") (LogEntry (Date 1) "newest") l2 /= l2 - l = M.fromList [(UUID "foo", LogEntry (Date 0) "old")] - l2 = M.fromList [(UUID "foo", LogEntry (Date 1) "new")] + l = M.fromList [(UUID "foo", LogEntry (Date 0) "old")] + l2 = M.fromList [(UUID "foo", LogEntry (Date 1) "new")] diff --git a/Logs/Unused.hs b/Logs/Unused.hs index 522c523af..9f1278dd0 100644 --- a/Logs/Unused.hs +++ b/Logs/Unused.hs @@ -35,13 +35,12 @@ readUnusedLog prefix = do <$> liftIO (readFile f) , return M.empty ) - where - parse line = - case (readish tag, file2key rest) of - (Just num, Just key) -> Just (num, key) - _ -> Nothing - where - (tag, rest) = separate (== ' ') line + where + parse line = case (readish tag, file2key rest) of + (Just num, Just key) -> Just (num, key) + _ -> Nothing + where + (tag, rest) = separate (== ' ') line type UnusedMap = M.Map Int Key @@ -64,10 +63,10 @@ unusedSpec :: String -> [Int] unusedSpec spec | "-" `isInfixOf` spec = range $ separate (== '-') spec | otherwise = catMaybes [readish spec] - where - range (a, b) = case (readish a, readish b) of - (Just x, Just y) -> [x..y] - _ -> [] + where + range (a, b) = case (readish a, readish b) of + (Just x, Just y) -> [x..y] + _ -> [] {- Start action for unused content. Finds the number in the maps, and - calls either of 3 actions, depending on the type of unused file. -} @@ -81,11 +80,11 @@ startUnused message unused badunused tmpunused maps n = search , (unusedBadMap maps, badunused) , (unusedTmpMap maps, tmpunused) ] - where - search [] = stop - search ((m, a):rest) = - case M.lookup n m of - Nothing -> search rest - Just key -> do - showStart message (show n) - next $ a key + where + search [] = stop + search ((m, a):rest) = + case M.lookup n m of + Nothing -> search rest + Just key -> do + showStart message (show n) + next $ a key diff --git a/Logs/Web.hs b/Logs/Web.hs index 534bd5345..c2a4deb7d 100644 --- a/Logs/Web.hs +++ b/Logs/Web.hs @@ -37,13 +37,13 @@ oldurlLogs key = {- Gets all urls that a key might be available from. -} getUrls :: Key -> Annex [URLString] getUrls key = go $ urlLog key : oldurlLogs key - where - go [] = return [] - go (l:ls) = do - us <- currentLog l - if null us - then go ls - else return us + where + go [] = return [] + go (l:ls) = do + us <- currentLog l + if null us + then go ls + else return us {- Records a change in an url for a key. -} setUrl :: Key -> URLString -> LogStatus -> Annex () |