{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Eventlog.Data (generateJson, generateJsonValidate, generateJsonData, EventlogType(..) ) where

import Prelude hiding (readFile)
import Data.Aeson (Value(..), (.=), object)
import qualified Data.Map as Map

import Eventlog.Args (Args(..))
import Eventlog.Bands (bands)
import qualified Eventlog.Events as E
import qualified Eventlog.HeapProf as H
import Eventlog.Prune
import Eventlog.Vega
import Eventlog.Types (Header(..), ProfData(..), HeapProfBreakdown(..))
import Data.List
import Data.Ord
import Eventlog.Trie
import Eventlog.Detailed
import Text.Blaze.Html
import Eventlog.Ticky
import Data.Word


data EventlogType = HeapProfile  (Header, Value, Maybe Value, Maybe Html)
                  | TickyProfile (Header, Word64, Double, Html)

generateJsonData :: Args -> ProfData -> IO (Header, Value, Maybe Value, Maybe Html)
generateJsonData :: Args -> ProfData -> IO (Header, Value, Maybe Value, Maybe Html)
generateJsonData Args
a (ProfData Header
h Map Bucket BucketInfo
binfo Map Word32 CostCentre
ccMap [Frame]
fs [Trace]
traces HeapInfo
heap_info Map InfoTablePtr InfoTableLoc
ipes Map TickyCounterId TickyCounter
_ticky_counter [TickySample]
_ticky_samples Word64
_total_allocs) = do
  let keeps :: Map Bucket (Int, BucketInfo)
keeps = Args -> Map Bucket BucketInfo -> Map Bucket (Int, BucketInfo)
pruneBands Args
a Map Bucket BucketInfo
binfo
      bs :: (UArray Int Double, UArray (Int, Int) Double)
bs = Header
-> Map Bucket Int
-> [Frame]
-> (UArray Int Double, UArray (Int, Int) Double)
bands Header
h (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall a b. (a, b) -> a
fst Map Bucket (Int, BucketInfo)
keeps) [Frame]
fs
      combinedJson :: Value
combinedJson = [Pair] -> Value
object [
          Key
"samples" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map Bucket (Int, BucketInfo)
-> (UArray Int Double, UArray (Int, Int) Double) -> [VegaEntry]
bandsToVega Map Bucket (Int, BucketInfo)
keeps (UArray Int Double, UArray (Int, Int) Double)
bs
        , Key
"traces"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Trace] -> [VegaTrace]
tracesToVega [Trace]
traces
        , Key
"heap"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= HeapInfo -> [VegaHeap]
heapToVega HeapInfo
heap_info
        ]
      mdescs :: [(Bucket, (Int, BucketInfo))]
mdescs =
        forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd))) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList Map Bucket (Int, BucketInfo)
keeps
      -- Only supply the cost centre view in cost centre profiling mode.
      cc_descs :: Maybe Value
cc_descs = case Header -> Maybe HeapProfBreakdown
hHeapProfileType Header
h of
                Just HeapProfBreakdown
HeapProfBreakdownCostCentre -> forall a. a -> Maybe a
Just (Map Word32 CostCentre -> [(Bucket, (Int, BucketInfo))] -> Value
outputTree Map Word32 CostCentre
ccMap [(Bucket, (Int, BucketInfo))]
mdescs)
                Maybe HeapProfBreakdown
_ -> forall a. Maybe a
Nothing

  let use_ipes :: Maybe (Map InfoTablePtr InfoTableLoc)
use_ipes = case Header -> Maybe HeapProfBreakdown
hHeapProfileType Header
h of
                   Just HeapProfBreakdown
HeapProfBreakdownInfoTable -> forall a. a -> Maybe a
Just Map InfoTablePtr InfoTableLoc
ipes
                   Maybe HeapProfBreakdown
_ -> forall a. Maybe a
Nothing
      desc_buckets :: Map Bucket (Int, BucketInfo)
desc_buckets = Args -> Map Bucket BucketInfo -> Map Bucket (Int, BucketInfo)
pruneDetailed Args
a Map Bucket BucketInfo
binfo
      bs' :: (UArray Int Double, UArray (Int, Int) Double)
bs' = Header
-> Map Bucket Int
-> [Frame]
-> (UArray Int Double, UArray (Int, Int) Double)
bands Header
h (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall a b. (a, b) -> a
fst Map Bucket (Int, BucketInfo)
desc_buckets) [Frame]
fs
      closure_table :: Maybe Html
closure_table =
        case Args -> Maybe Int
detailedLimit Args
a of
          Just Int
0 ->  forall a. Maybe a
Nothing
          Maybe Int
_ -> forall a. a -> Maybe a
Just ((UArray Int Double, UArray (Int, Int) Double)
-> Maybe (Map InfoTablePtr InfoTableLoc)
-> Map Bucket (Int, BucketInfo)
-> Html
renderClosureInfo (UArray Int Double, UArray (Int, Int) Double)
bs' Maybe (Map InfoTablePtr InfoTableLoc)
use_ipes Map Bucket (Int, BucketInfo)
desc_buckets)
  forall (m :: * -> *) a. Monad m => a -> m a
return (Header
h, Value
combinedJson, Maybe Value
cc_descs, Maybe Html
closure_table)

generateJson :: FilePath -> Args -> IO EventlogType
generateJson :: FilePath -> Args -> IO EventlogType
generateJson = (ProfData -> IO ()) -> FilePath -> Args -> IO EventlogType
generateJsonValidate (forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return ()))

generateJsonValidate :: (ProfData -> IO ()) -> FilePath
                     -> Args -> IO EventlogType
generateJsonValidate :: (ProfData -> IO ()) -> FilePath -> Args -> IO EventlogType
generateJsonValidate ProfData -> IO ()
validate FilePath
file Args
a = do
  let chunk :: FilePath -> IO ProfData
chunk = if Args -> Bool
heapProfile Args
a then FilePath -> IO ProfData
H.chunk else Args -> FilePath -> IO ProfData
E.chunk Args
a
  ProfData
dat <- FilePath -> IO ProfData
chunk FilePath
file
  ProfData -> IO ()
validate ProfData
dat
  case ProfData -> [TickySample]
profTickySamples ProfData
dat of
    [] -> (Header, Value, Maybe Value, Maybe Html) -> EventlogType
HeapProfile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Args -> ProfData -> IO (Header, Value, Maybe Value, Maybe Html)
generateJsonData Args
a ProfData
dat
    -- If there are any ticky samples then generate a ticky profile
    [TickySample]
_  -> do
      let (Double
percen, Html
html) = Word64
-> Map TickyCounterId TickyCounter
-> Map InfoTablePtr InfoTableLoc
-> [TickySample]
-> (Double, Html)
renderTicky (ProfData -> Word64
profTotalAllocations ProfData
dat) (ProfData -> Map TickyCounterId TickyCounter
profTickyCounters ProfData
dat) (ProfData -> Map InfoTablePtr InfoTableLoc
profItl ProfData
dat) (ProfData -> [TickySample]
profTickySamples ProfData
dat)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Header, Word64, Double, Html) -> EventlogType
TickyProfile ( ProfData -> Header
profHeader ProfData
dat
                                , ProfData -> Word64
profTotalAllocations ProfData
dat
                                , Double
percen
                                , Html
html )