mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

improved reporting

Browse source
This commit is contained in:
Joey Hess 2014-05-03 11:55:01 -03:00
parent a5c5704b54
commit f380085e26
1 changed files with 18 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

23
doc/design/assistant/syncing/simroutes.hs
View file

@ -55,7 +55,10 @@ numSteps = 100
-- IO code -- IO code
--main = putStrLn . summarize =<< evalRandIO (simulate numSteps =<< genNetwork) --main = putStrLn . summarize =<< evalRandIO (simulate numSteps =<< genNetwork)
main = putStrLn . summarize =<< evalRandIO (simulate numSteps =<< mocambos) main = do
initialnetwork <- evalRandIO mocambos
putStrLn . summarize initialnetwork
=<< evalRandIO (simulate numSteps initialnetwork)
-- Only pure code below :) -- Only pure code below :)
data Network = Network (M.Map NodeName ImmobileNode) [TransferNode] data Network = Network (M.Map NodeName ImmobileNode) [TransferNode]
@ -240,14 +243,16 @@ randomfrom l = do
i <- getRandomR (1, length l) i <- getRandomR (1, length l)
return $ l !! (i - 1) return $ l !! (i - 1)
summarize :: Network -> String summarize :: Network -> Network -> String
summarize (Network is _ts) = unlines $ map (\(d, s) -> d ++ ": " ++ s) summarize _initial@(Network origis _) _final@(Network is _ts) = format
[ ("Total wanted files", [ ("Total wanted files",
show (sum (overis (length . findoriginreqs . wantFiles . repo)))) show (sum (overis (length . findoriginreqs . wantFiles . repo))))
, ("Wanted files that were not transferred to requesting node", , ("Wanted files that were not transferred to requesting node",
show (sum (overis (S.size . findunsatisfied . repo)))) show (sum (overis (S.size . findunsatisfied . repo))))
--, ("List of files not transferred", show unsatisfied) , ("Nodes that failed to get files",
, ("Immobile nodes at end", show is) show (map withinitiallocs $ filter (not . S.null . snd)
(M.toList $ M.map (findunsatisfied . repo) is)))
--, ("Immobile nodes at end", show is)
] ]
where where
findoriginreqs = filter (\r -> requestTTL r == originTTL) findoriginreqs = filter (\r -> requestTTL r == originTTL)
@ -256,6 +261,14 @@ summarize (Network is _ts) = unlines $ map (\(d, s) -> d ++ ": " ++ s)
in S.difference wantedfs (haveFiles r) in S.difference wantedfs (haveFiles r)
repo (ImmobileNode r) = r repo (ImmobileNode r) = r
overis f = map f $ M.elems is overis f = map f $ M.elems is
format = unlines . map (\(d, s) -> d ++ ": " ++ s)
withinitiallocs (name, missingfiles) = (name, S.map addinitialloc missingfiles)
addinitialloc f = (f, M.lookup f initiallocs)
initiallocs = M.fromList $
concatMap (\(k, v) -> map (\f -> (f, k)) (S.toList $ haveFiles $ repo v)) $
M.toList origis
mocambos :: (RandomGen g) => Rand g Network mocambos :: (RandomGen g) => Rand g Network
mocambos = do mocambos = do