{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeApplications #-}
module Eventlog.Prune
  ( pruneBands, pruneDetailed
  ) where

import Data.List (sortBy)
import Data.Ord (comparing)
import Eventlog.Types
import Data.Map (Map, fromList, (!), toList)

import Eventlog.Args (Args(..), Sort(..))
import Data.Maybe
import Data.Word (Word64)
import Text.Read (readMaybe)
import qualified Data.Text as T

type Compare a = a -> a -> Ordering

getComparison :: Args -> Compare (Bucket, BucketInfo)
getComparison :: Args -> Compare (Bucket, BucketInfo)
getComparison Args { sorting :: Args -> Sort
sorting = Sort
Size,   reversing :: Args -> Bool
reversing = Bool
False }  = Compare (Bucket, BucketInfo)
cmpSizeDescending
getComparison Args { sorting :: Args -> Sort
sorting = Sort
Size,   reversing :: Args -> Bool
reversing = Bool
True } = Compare (Bucket, BucketInfo)
cmpSizeAscending
getComparison Args { sorting :: Args -> Sort
sorting = Sort
StdDev, reversing :: Args -> Bool
reversing = Bool
False }  = Compare (Bucket, BucketInfo)
cmpStdDevDescending
getComparison Args { sorting :: Args -> Sort
sorting = Sort
StdDev, reversing :: Args -> Bool
reversing = Bool
True } = Compare (Bucket, BucketInfo)
cmpStdDevAscending
getComparison Args { sorting :: Args -> Sort
sorting = Sort
Name,   reversing :: Args -> Bool
reversing = Bool
True }  = Compare (Bucket, BucketInfo)
cmpNameDescending
getComparison Args { sorting :: Args -> Sort
sorting = Sort
Name,   reversing :: Args -> Bool
reversing = Bool
False } = Compare (Bucket, BucketInfo)
cmpNameAscending
getComparison Args { sorting :: Args -> Sort
sorting = Sort
Number,   reversing :: Args -> Bool
reversing = Bool
True }  = Compare (Bucket, BucketInfo)
cmpNumberDescending
getComparison Args { sorting :: Args -> Sort
sorting = Sort
Number,   reversing :: Args -> Bool
reversing = Bool
False } = Compare (Bucket, BucketInfo)
cmpNumberAscending
getComparison Args { sorting :: Args -> Sort
sorting = Sort
Gradient,   reversing :: Args -> Bool
reversing = Bool
True }  = Compare (Bucket, BucketInfo)
cmpGradientAscending
getComparison Args { sorting :: Args -> Sort
sorting = Sort
Gradient,   reversing :: Args -> Bool
reversing = Bool
False } = Compare (Bucket, BucketInfo)
cmpGradientDescending

cmpNameAscending, cmpNameDescending,
  cmpNumberAscending, cmpNumberDescending,
  cmpStdDevAscending, cmpStdDevDescending,
  cmpSizeAscending, cmpSizeDescending,
  cmpGradientAscending, cmpGradientDescending :: Compare (Bucket, BucketInfo)
cmpNameAscending :: Compare (Bucket, BucketInfo)
cmpNameAscending = ((Bucket, BucketInfo) -> Bucket) -> Compare (Bucket, BucketInfo)
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Bucket, BucketInfo) -> Bucket
forall a b. (a, b) -> a
fst
cmpNameDescending :: Compare (Bucket, BucketInfo)
cmpNameDescending = Compare (Bucket, BucketInfo) -> Compare (Bucket, BucketInfo)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Compare (Bucket, BucketInfo)
cmpNameAscending
cmpNumberAscending :: Compare (Bucket, BucketInfo)
cmpNumberAscending (Bucket Text
a, BucketInfo
_) (Bucket Text
b, BucketInfo
_) = (Text -> Maybe Word64) -> Text -> Text -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (forall a. Read a => String -> Maybe a
readMaybe @Word64 (String -> Maybe Word64)
-> (Text -> String) -> Text -> Maybe Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) Text
a Text
b Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
a Text
b
cmpNumberDescending :: Compare (Bucket, BucketInfo)
cmpNumberDescending = Compare (Bucket, BucketInfo) -> Compare (Bucket, BucketInfo)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Compare (Bucket, BucketInfo)
cmpNumberAscending
cmpStdDevAscending :: Compare (Bucket, BucketInfo)
cmpStdDevAscending = ((Bucket, BucketInfo) -> Double) -> Compare (Bucket, BucketInfo)
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (BucketInfo -> Double
bucketStddev (BucketInfo -> Double)
-> ((Bucket, BucketInfo) -> BucketInfo)
-> (Bucket, BucketInfo)
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bucket, BucketInfo) -> BucketInfo
forall a b. (a, b) -> b
snd)
cmpStdDevDescending :: Compare (Bucket, BucketInfo)
cmpStdDevDescending = Compare (Bucket, BucketInfo) -> Compare (Bucket, BucketInfo)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Compare (Bucket, BucketInfo)
cmpStdDevAscending
cmpSizeAscending :: Compare (Bucket, BucketInfo)
cmpSizeAscending = ((Bucket, BucketInfo) -> Double) -> Compare (Bucket, BucketInfo)
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (BucketInfo -> Double
bucketTotal (BucketInfo -> Double)
-> ((Bucket, BucketInfo) -> BucketInfo)
-> (Bucket, BucketInfo)
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bucket, BucketInfo) -> BucketInfo
forall a b. (a, b) -> b
snd)
cmpSizeDescending :: Compare (Bucket, BucketInfo)
cmpSizeDescending = Compare (Bucket, BucketInfo) -> Compare (Bucket, BucketInfo)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Compare (Bucket, BucketInfo)
cmpSizeAscending
cmpGradientAscending :: Compare (Bucket, BucketInfo)
cmpGradientAscending = ((Bucket, BucketInfo) -> Maybe Double)
-> Compare (Bucket, BucketInfo)
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (((Double, Double, Double) -> Double)
-> Maybe (Double, Double, Double) -> Maybe Double
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double, Double, Double) -> Double
forall {a} {b} {c}. (a, b, c) -> b
getGradient (Maybe (Double, Double, Double) -> Maybe Double)
-> ((Bucket, BucketInfo) -> Maybe (Double, Double, Double))
-> (Bucket, BucketInfo)
-> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BucketInfo -> Maybe (Double, Double, Double)
bucketGradient (BucketInfo -> Maybe (Double, Double, Double))
-> ((Bucket, BucketInfo) -> BucketInfo)
-> (Bucket, BucketInfo)
-> Maybe (Double, Double, Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bucket, BucketInfo) -> BucketInfo
forall a b. (a, b) -> b
snd)
 where
   getGradient :: (a, b, c) -> b
getGradient (a
_a, b
b, c
_r2) = b
b
cmpGradientDescending :: Compare (Bucket, BucketInfo)
cmpGradientDescending = Compare (Bucket, BucketInfo) -> Compare (Bucket, BucketInfo)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Compare (Bucket, BucketInfo)
cmpGradientAscending

prune :: Int
      -> Args
      -> Map Bucket BucketInfo
      -> Map Bucket (Int, BucketInfo)
prune :: Int
-> Args -> Map Bucket BucketInfo -> Map Bucket (Int, BucketInfo)
prune Int
limit Args
args Map Bucket BucketInfo
ts =
  let ccTotals :: [(Bucket, BucketInfo)]
ccTotals = Compare (Bucket, BucketInfo)
-> [(Bucket, BucketInfo)] -> [(Bucket, BucketInfo)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Compare (Bucket, BucketInfo)
cmpSizeDescending
                  (Map Bucket BucketInfo -> [(Bucket, BucketInfo)]
forall k a. Map k a -> [(k, a)]
toList Map Bucket BucketInfo
ts)
      bands :: [(Bucket, BucketInfo)]
bands = Int -> [(Bucket, BucketInfo)] -> [(Bucket, BucketInfo)]
forall a. Int -> [a] -> [a]
take Int
limit [(Bucket, BucketInfo)]
ccTotals
      ccs :: [Bucket]
ccs = ((Bucket, BucketInfo) -> Bucket)
-> [(Bucket, BucketInfo)] -> [Bucket]
forall a b. (a -> b) -> [a] -> [b]
map (Bucket, BucketInfo) -> Bucket
forall a b. (a, b) -> a
fst (Compare (Bucket, BucketInfo)
-> [(Bucket, BucketInfo)] -> [(Bucket, BucketInfo)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Args -> Compare (Bucket, BucketInfo)
getComparison Args
args) [(Bucket, BucketInfo)]
bands)
      res :: [(Bucket, (Int, BucketInfo))]
      res :: [(Bucket, (Int, BucketInfo))]
res = (Bucket -> Int -> (Bucket, (Int, BucketInfo)))
-> [Bucket] -> [Int] -> [(Bucket, (Int, BucketInfo))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Bucket
b Int
k -> (Bucket
b, (Int
k, Map Bucket BucketInfo
ts Map Bucket BucketInfo -> Bucket -> BucketInfo
forall k a. Ord k => Map k a -> k -> a
! Bucket
b))) ([Bucket] -> [Bucket]
forall a. [a] -> [a]
reverse [Bucket]
ccs) [Int
1..]
  in  [(Bucket, (Int, BucketInfo))] -> Map Bucket (Int, BucketInfo)
forall k a. Ord k => [(k, a)] -> Map k a
fromList [(Bucket, (Int, BucketInfo))]
res

pruneBands, pruneDetailed :: Args -> Map Bucket BucketInfo -> Map Bucket (Int, BucketInfo)
pruneBands :: Args -> Map Bucket BucketInfo -> Map Bucket (Int, BucketInfo)
pruneBands Args
as = Int
-> Args -> Map Bucket BucketInfo -> Map Bucket (Int, BucketInfo)
prune (Int -> Int
bound (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Args -> Int
nBands Args
as) Args
as
pruneDetailed :: Args -> Map Bucket BucketInfo -> Map Bucket (Int, BucketInfo)
pruneDetailed Args
as = Int
-> Args -> Map Bucket BucketInfo -> Map Bucket (Int, BucketInfo)
prune (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
forall a. Bounded a => a
maxBound (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Args -> Maybe Int
detailedLimit Args
as) Args
as


bound :: Int -> Int
bound :: Int -> Int
bound Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Int
forall a. Bounded a => a
maxBound
  | Bool
otherwise = Int
n