module Eventlog.Prune ( prune ) where import Data.List (sortBy) import Data.Ord (comparing) import Data.Map.Strict (Map, toList, fromList, (!)) import Eventlog.Types import Eventlog.Args (Args(..), Sort(..)) type Compare a = a -> a -> Ordering getComparison :: Args -> Compare (Bucket, BucketInfo) getComparison Args { sorting = Size, reversing = False } = cmpSizeDescending getComparison Args { sorting = Size, reversing = True } = cmpSizeAscending getComparison Args { sorting = StdDev, reversing = False } = cmpStdDevDescending getComparison Args { sorting = StdDev, reversing = True } = cmpStdDevAscending getComparison Args { sorting = Name, reversing = True } = cmpNameDescending getComparison Args { sorting = Name, reversing = False } = cmpNameAscending cmpNameAscending, cmpNameDescending, cmpStdDevAscending, cmpStdDevDescending, cmpSizeAscending, cmpSizeDescending :: Compare (Bucket, BucketInfo) cmpNameAscending = comparing fst cmpNameDescending = flip cmpNameAscending cmpStdDevAscending = comparing (bucketStddev . snd) cmpStdDevDescending = flip cmpStdDevAscending cmpSizeAscending = comparing (bucketTotal . snd) cmpSizeDescending = flip cmpSizeAscending prune :: Args -> Map Bucket BucketInfo -> Map Bucket (Int, BucketInfo) prune args ts = let ccTotals = sortBy cmpSizeDescending (toList ts) sizes = map (bucketTotal . snd) ccTotals limit = sum sizes bigs = takeWhile (< limit) . scanl (+) 0 $ sizes bands = zipWith const ccTotals $ take (bound $ nBands args) bigs ccs = map fst (sortBy (getComparison args) bands) res :: [(Bucket, (Int, BucketInfo))] res = zipWith (\b k -> (b, (k, ts ! b))) (reverse ccs) [1..] in fromList res bound :: Int -> Int bound n | n <= 0 = maxBound | otherwise = n