{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE LambdaCase #-}
module GHC.Prof.Parser
  ( profile

  , timestamp
  , title
  , commandLine
  , totalTime
  , totalAlloc
  , topCostCentres
  , aggregatedCostCentre
  , costCentres
  , costCentre
  ) where
import Control.Applicative (Alternative((<|>)), optional)
import Control.Monad
import Data.Char (isDigit, isSpace)
import Data.Foldable (asum, foldl')
import Data.Maybe
import Data.Time

import Data.Text (Text)
import Data.Attoparsec.Text as A
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Read as TR

import Control.Monad.Extras (seqM)
import GHC.Prof.Types

#if MIN_VERSION_containers(0, 5, 0)
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Map.Strict as Map
#else
import qualified Data.IntMap as IntMap
import qualified Data.Map as Map
#endif

-- | Parse a GHC time-allocation profiling report
profile :: Parser Profile
profile :: Parser Profile
profile = do
  Parser ()
skipHorizontalSpace
  LocalTime
profileTimestamp <- Parser LocalTime
timestamp; Parser ()
skipSpace
  Parser Text Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Text Text
title; Parser ()
skipSpace
  Text
profileCommandLine <- Parser Text Text
commandLine; Parser ()
skipSpace
  TotalTime
profileTotalTime <- Parser TotalTime
totalTime; Parser ()
skipSpace
  TotalAlloc
profileTotalAlloc <- Parser TotalAlloc
totalAlloc; Parser ()
skipSpace
  [AggregatedCostCentre]
profileTopCostCentres <- Parser [AggregatedCostCentre]
topCostCentres; Parser ()
skipSpace
  CostCentreTree
profileCostCentreTree <- Parser CostCentreTree
costCentres; Parser ()
skipSpace
  Parser ()
forall t. Chunk t => Parser t ()
endOfInput
  Profile -> Parser Profile
forall (m :: * -> *) a. Monad m => a -> m a
return (Profile -> Parser Profile) -> Profile -> Parser Profile
forall a b. (a -> b) -> a -> b
$! Profile :: LocalTime
-> Text
-> TotalTime
-> TotalAlloc
-> [AggregatedCostCentre]
-> CostCentreTree
-> Profile
Profile {[AggregatedCostCentre]
Text
LocalTime
CostCentreTree
TotalAlloc
TotalTime
profileCostCentreTree :: CostCentreTree
profileTopCostCentres :: [AggregatedCostCentre]
profileTotalAlloc :: TotalAlloc
profileTotalTime :: TotalTime
profileCommandLine :: Text
profileTimestamp :: LocalTime
profileCostCentreTree :: CostCentreTree
profileTopCostCentres :: [AggregatedCostCentre]
profileTotalAlloc :: TotalAlloc
profileTotalTime :: TotalTime
profileCommandLine :: Text
profileTimestamp :: LocalTime
..}

-- | Parse the timestamp in a header as local time
timestamp :: Parser LocalTime
timestamp :: Parser LocalTime
timestamp = do
  Parser Text Text
parseDayOfTheWeek Parser Text Text -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
skipSpace
  Int
month <- Parser Text Int
parseMonth; Parser ()
skipSpace
  Int
day <- Parser Text Int
parseDay; Parser ()
skipSpace
  TimeOfDay
tod <- Parser Text TimeOfDay
parseTimeOfDay; Parser ()
skipSpace
  Integer
year <- Parser Integer
parseYear; Parser ()
skipSpace
  LocalTime -> Parser LocalTime
forall (m :: * -> *) a. Monad m => a -> m a
return (LocalTime -> Parser LocalTime) -> LocalTime -> Parser LocalTime
forall a b. (a -> b) -> a -> b
$! LocalTime :: Day -> TimeOfDay -> LocalTime
LocalTime
    { localDay :: Day
localDay = Integer -> Int -> Int -> Day
fromGregorian Integer
year Int
month Int
day
    , localTimeOfDay :: TimeOfDay
localTimeOfDay = TimeOfDay
tod
    }
  where
    parseYear :: Parser Integer
parseYear = Parser Integer
forall a. Integral a => Parser a
decimal
    parseMonth :: Parser Text Int
parseMonth = Int -> Parser Text Text
A.take Int
3 Parser Text Text -> (Text -> Parser Text Int) -> Parser Text Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser Text Int
forall a (m :: * -> *) a.
(Eq a, IsString a, Num a, MonadFail m, Show a) =>
a -> m a
nameToInt
      where
        nameToInt :: a -> m a
nameToInt a
name = case a
name of
          a
"Jan" -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
1; a
"Feb" -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
2; a
"Mar" -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
3
          a
"Apr" -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
4; a
"May" -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
5; a
"Jun" -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
6
          a
"Jul" -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
7; a
"Aug" -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
8; a
"Sep" -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
9
          a
"Oct" -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
10; a
"Nov" -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
11; a
"Dec" -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
12
          a
_ -> String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"timestamp.toNum: invalid month - " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
name
    parseDay :: Parser Text Int
parseDay = Parser Text Int
forall a. Integral a => Parser a
decimal
    parseTimeOfDay :: Parser Text TimeOfDay
parseTimeOfDay = Int -> Int -> Pico -> TimeOfDay
TimeOfDay
      (Int -> Int -> Pico -> TimeOfDay)
-> Parser Text Int -> Parser Text (Int -> Pico -> TimeOfDay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Int
forall a. Integral a => Parser a
decimal Parser Text (Int -> Pico -> TimeOfDay)
-> Parser Text Text -> Parser Text (Int -> Pico -> TimeOfDay)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
string Text
":"
      Parser Text (Int -> Pico -> TimeOfDay)
-> Parser Text Int -> Parser Text (Pico -> TimeOfDay)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Int
forall a. Integral a => Parser a
decimal
      Parser Text (Pico -> TimeOfDay)
-> Parser Text Pico -> Parser Text TimeOfDay
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pico -> Parser Text Pico
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pico
0
    parseDayOfTheWeek :: Parser Text Text
parseDayOfTheWeek = (Char -> Bool) -> Parser Text Text
takeTill Char -> Bool
isSpace

title :: Parser Text
title :: Parser Text Text
title = Text -> Parser Text Text
string Text
"Time and Allocation Profiling Report  (Final)"

commandLine :: Parser Text
commandLine :: Parser Text Text
commandLine = (Char -> Bool) -> Parser Text Text
A.takeWhile ((Char -> Bool) -> Parser Text Text)
-> (Char -> Bool) -> Parser Text Text
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isEndOfLine

totalTime :: Parser TotalTime
totalTime :: Parser TotalTime
totalTime = do
  Parser Text Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text Text -> Parser ()) -> Parser Text Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text Text
string Text
"total time  ="; Parser ()
skipSpace
  DiffTime
elapsed <- Parser DiffTime
forall a. Fractional a => Parser a
rational
  Parser Text Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text Text -> Parser ()) -> Parser Text Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text Text
string Text
" secs"; Parser ()
skipSpace
  (Integer
ticks, Integer
resolution, Maybe Int
processors) <- Parser (Integer, Integer, Maybe Int)
-> Parser (Integer, Integer, Maybe Int)
forall a. Parser a -> Parser a
parens (Parser (Integer, Integer, Maybe Int)
 -> Parser (Integer, Integer, Maybe Int))
-> Parser (Integer, Integer, Maybe Int)
-> Parser (Integer, Integer, Maybe Int)
forall a b. (a -> b) -> a -> b
$ (,,)
    (Integer -> Integer -> Maybe Int -> (Integer, Integer, Maybe Int))
-> Parser Integer
-> Parser
     Text (Integer -> Maybe Int -> (Integer, Integer, Maybe Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Integer
forall a. Integral a => Parser a
decimal Parser Text (Integer -> Maybe Int -> (Integer, Integer, Maybe Int))
-> Parser Text Text
-> Parser
     Text (Integer -> Maybe Int -> (Integer, Integer, Maybe Int))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
string Text
" ticks @ "
    Parser Text (Integer -> Maybe Int -> (Integer, Integer, Maybe Int))
-> Parser Integer
-> Parser Text (Maybe Int -> (Integer, Integer, Maybe Int))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Integer
picoSeconds
    Parser Text (Maybe Int -> (Integer, Integer, Maybe Int))
-> Parser Text (Maybe Int) -> Parser (Integer, Integer, Maybe Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Int -> Parser Text (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> Parser Text Text
string Text
", " Parser Text Text -> Parser Text Int -> Parser Text Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Int
forall a. Integral a => Parser a
decimal Parser Text Int -> Parser Text String -> Parser Text Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 (Char -> Parser Text Char
notChar Char
')'))
  TotalTime -> Parser TotalTime
forall (m :: * -> *) a. Monad m => a -> m a
return (TotalTime -> Parser TotalTime) -> TotalTime -> Parser TotalTime
forall a b. (a -> b) -> a -> b
$! TotalTime :: DiffTime -> Integer -> DiffTime -> Maybe Int -> TotalTime
TotalTime
    { totalTimeElapsed :: DiffTime
totalTimeElapsed = DiffTime
elapsed
    , totalTimeTicks :: Integer
totalTimeTicks = Integer
ticks
    , totalTimeResolution :: DiffTime
totalTimeResolution = Integer -> DiffTime
picosecondsToDiffTime Integer
resolution
    , totalTimeProcessors :: Maybe Int
totalTimeProcessors = Maybe Int
processors
    }
  where
    picoSeconds :: Parser Integer
picoSeconds = [Parser Integer] -> Parser Integer
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ ((Integer
10 Integer -> Int -> Integer
`pow` Int
3)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*) (Integer -> Integer) -> Parser Integer -> Parser Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Integer
forall a. Integral a => Parser a
decimal Parser Integer -> Parser Text Text -> Parser Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
string Text
" us"
      , ((Integer
10 Integer -> Int -> Integer
`pow` Int
6)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*) (Integer -> Integer) -> Parser Integer -> Parser Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Integer
forall a. Integral a => Parser a
decimal Parser Integer -> Parser Text Text -> Parser Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
string Text
" ms"
      ]
    pow :: Integer -> Int -> Integer
    pow :: Integer -> Int -> Integer
pow = Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
(^)

totalAlloc :: Parser TotalAlloc
totalAlloc :: Parser TotalAlloc
totalAlloc = do
  Text -> Parser Text Text
string Text
"total alloc =" Parser Text Text -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
skipSpace
  !Integer
n <- Parser Integer
groupedDecimal
  Text -> Parser Text Text
string Text
" bytes" Parser Text Text -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
skipSpace
  Parser () -> Parser ()
forall a. Parser a -> Parser a
parens (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser Text Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text Text -> Parser ()) -> Parser Text Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text Text
string Text
"excludes profiling overheads"
  TotalAlloc -> Parser TotalAlloc
forall (m :: * -> *) a. Monad m => a -> m a
return TotalAlloc :: Integer -> TotalAlloc
TotalAlloc { totalAllocBytes :: Integer
totalAllocBytes = Integer
n }
  where
    groupedDecimal :: Parser Integer
groupedDecimal = do
      [Integer]
ds <- Parser Integer
forall a. Integral a => Parser a
decimal Parser Integer -> Parser Text Char -> Parser Text [Integer]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` Char -> Parser Text Char
char Char
','
      Integer -> Parser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Parser Integer) -> Integer -> Parser Integer
forall a b. (a -> b) -> a -> b
$! (Integer -> Integer -> Integer) -> Integer -> [Integer] -> Integer
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
go Integer
0 [Integer]
ds
      where
        go :: a -> a -> a
go a
z a
n = a
z a -> a -> a
forall a. Num a => a -> a -> a
* a
1000 a -> a -> a
forall a. Num a => a -> a -> a
+ a
n

newtype HeaderParams = HeaderParams
  { HeaderParams -> Bool
headerHasSrc :: Bool -- ^ SRC column exists
  } deriving Int -> HeaderParams -> String -> String
[HeaderParams] -> String -> String
HeaderParams -> String
(Int -> HeaderParams -> String -> String)
-> (HeaderParams -> String)
-> ([HeaderParams] -> String -> String)
-> Show HeaderParams
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [HeaderParams] -> String -> String
$cshowList :: [HeaderParams] -> String -> String
show :: HeaderParams -> String
$cshow :: HeaderParams -> String
showsPrec :: Int -> HeaderParams -> String -> String
$cshowsPrec :: Int -> HeaderParams -> String -> String
Show

header :: Parser HeaderParams
header :: Parser HeaderParams
header = do
  Parser () -> Parser ()
forall a. Parser a -> Parser ()
optional_ (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> Parser Text Text
string Text
"individual" Parser Text Text -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
skipHorizontalSpace
    Text -> Parser Text Text
string Text
"inherited" Parser Text Text -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
skipSpace
  Text -> Parser Text Text
string Text
"COST CENTRE" Parser Text Text -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
skipHorizontalSpace
  Text -> Parser Text Text
string Text
"MODULE" Parser Text Text -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
skipHorizontalSpace
  Bool
headerHasSrc <- Bool -> Parser Text Bool -> Parser Text Bool
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Bool
False (Parser Text Bool -> Parser Text Bool)
-> Parser Text Bool -> Parser Text Bool
forall a b. (a -> b) -> a -> b
$ Bool
True Bool -> Parser Text Text -> Parser Text Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"SRC"; Parser ()
skipHorizontalSpace
  Parser () -> Parser ()
forall a. Parser a -> Parser ()
optional_ (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text Text
string Text
"no." Parser Text Text -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
skipHorizontalSpace
  Parser () -> Parser ()
forall a. Parser a -> Parser ()
optional_ (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text Text
string Text
"entries" Parser Text Text -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
skipHorizontalSpace
  Text -> Parser Text Text
string Text
"%time" Parser Text Text -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
skipHorizontalSpace
  Text -> Parser Text Text
string Text
"%alloc" Parser Text Text -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
skipHorizontalSpace
  Parser () -> Parser ()
forall a. Parser a -> Parser ()
optional_ (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> Parser Text Text
string Text
"%time" Parser Text Text -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
skipHorizontalSpace
    Text -> Parser Text Text
string Text
"%alloc" Parser Text Text -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
skipHorizontalSpace
  Parser () -> Parser ()
forall a. Parser a -> Parser ()
optional_ (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> Parser Text Text
string Text
"ticks" Parser Text Text -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
skipHorizontalSpace
    Text -> Parser Text Text
string Text
"bytes" Parser Text Text -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
skipHorizontalSpace
  HeaderParams -> Parser HeaderParams
forall (m :: * -> *) a. Monad m => a -> m a
return HeaderParams :: Bool -> HeaderParams
HeaderParams
    {Bool
headerHasSrc :: Bool
headerHasSrc :: Bool
..}

topCostCentres :: Parser [AggregatedCostCentre]
topCostCentres :: Parser [AggregatedCostCentre]
topCostCentres = do
  HeaderParams
params <- Parser HeaderParams
header; Parser ()
skipSpace
  HeaderParams -> Parser AggregatedCostCentre
aggregatedCostCentre HeaderParams
params Parser AggregatedCostCentre
-> Parser () -> Parser [AggregatedCostCentre]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Parser ()
endOfLine

aggregatedCostCentre :: HeaderParams -> Parser AggregatedCostCentre
aggregatedCostCentre :: HeaderParams -> Parser AggregatedCostCentre
aggregatedCostCentre HeaderParams {Bool
headerHasSrc :: Bool
headerHasSrc :: HeaderParams -> Bool
..} = Text
-> Text
-> Maybe Text
-> Maybe Integer
-> Scientific
-> Scientific
-> Maybe Integer
-> Maybe Integer
-> AggregatedCostCentre
AggregatedCostCentre
  (Text
 -> Text
 -> Maybe Text
 -> Maybe Integer
 -> Scientific
 -> Scientific
 -> Maybe Integer
 -> Maybe Integer
 -> AggregatedCostCentre)
-> Parser Text Text
-> Parser
     Text
     (Text
      -> Maybe Text
      -> Maybe Integer
      -> Scientific
      -> Scientific
      -> Maybe Integer
      -> Maybe Integer
      -> AggregatedCostCentre)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
symbol Parser
  Text
  (Text
   -> Maybe Text
   -> Maybe Integer
   -> Scientific
   -> Scientific
   -> Maybe Integer
   -> Maybe Integer
   -> AggregatedCostCentre)
-> Parser ()
-> Parser
     Text
     (Text
      -> Maybe Text
      -> Maybe Integer
      -> Scientific
      -> Scientific
      -> Maybe Integer
      -> Maybe Integer
      -> AggregatedCostCentre)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipHorizontalSpace -- name
  Parser
  Text
  (Text
   -> Maybe Text
   -> Maybe Integer
   -> Scientific
   -> Scientific
   -> Maybe Integer
   -> Maybe Integer
   -> AggregatedCostCentre)
-> Parser Text Text
-> Parser
     Text
     (Maybe Text
      -> Maybe Integer
      -> Scientific
      -> Scientific
      -> Maybe Integer
      -> Maybe Integer
      -> AggregatedCostCentre)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Text
symbol Parser
  Text
  (Maybe Text
   -> Maybe Integer
   -> Scientific
   -> Scientific
   -> Maybe Integer
   -> Maybe Integer
   -> AggregatedCostCentre)
-> Parser ()
-> Parser
     Text
     (Maybe Text
      -> Maybe Integer
      -> Scientific
      -> Scientific
      -> Maybe Integer
      -> Maybe Integer
      -> AggregatedCostCentre)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipHorizontalSpace -- module
  Parser
  Text
  (Maybe Text
   -> Maybe Integer
   -> Scientific
   -> Scientific
   -> Maybe Integer
   -> Maybe Integer
   -> AggregatedCostCentre)
-> Parser Text (Maybe Text)
-> Parser
     Text
     (Maybe Integer
      -> Scientific
      -> Scientific
      -> Maybe Integer
      -> Maybe Integer
      -> AggregatedCostCentre)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text (Maybe Text)
source Parser
  Text
  (Maybe Integer
   -> Scientific
   -> Scientific
   -> Maybe Integer
   -> Maybe Integer
   -> AggregatedCostCentre)
-> Parser ()
-> Parser
     Text
     (Maybe Integer
      -> Scientific
      -> Scientific
      -> Maybe Integer
      -> Maybe Integer
      -> AggregatedCostCentre)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipHorizontalSpace -- src
  Parser
  Text
  (Maybe Integer
   -> Scientific
   -> Scientific
   -> Maybe Integer
   -> Maybe Integer
   -> AggregatedCostCentre)
-> Parser Text (Maybe Integer)
-> Parser
     Text
     (Scientific
      -> Scientific
      -> Maybe Integer
      -> Maybe Integer
      -> AggregatedCostCentre)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Integer -> Parser Text (Maybe Integer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Integer
forall a. Maybe a
Nothing -- entries
  Parser
  Text
  (Scientific
   -> Scientific
   -> Maybe Integer
   -> Maybe Integer
   -> AggregatedCostCentre)
-> Parser Text Scientific
-> Parser
     Text
     (Scientific
      -> Maybe Integer -> Maybe Integer -> AggregatedCostCentre)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Scientific
scientific Parser
  Text
  (Scientific
   -> Maybe Integer -> Maybe Integer -> AggregatedCostCentre)
-> Parser ()
-> Parser
     Text
     (Scientific
      -> Maybe Integer -> Maybe Integer -> AggregatedCostCentre)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipHorizontalSpace -- %time
  Parser
  Text
  (Scientific
   -> Maybe Integer -> Maybe Integer -> AggregatedCostCentre)
-> Parser Text Scientific
-> Parser
     Text (Maybe Integer -> Maybe Integer -> AggregatedCostCentre)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Scientific
scientific Parser
  Text (Maybe Integer -> Maybe Integer -> AggregatedCostCentre)
-> Parser ()
-> Parser
     Text (Maybe Integer -> Maybe Integer -> AggregatedCostCentre)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipHorizontalSpace -- %alloc
  Parser
  Text (Maybe Integer -> Maybe Integer -> AggregatedCostCentre)
-> Parser Text (Maybe Integer)
-> Parser Text (Maybe Integer -> AggregatedCostCentre)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Integer -> Parser Text (Maybe Integer)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Integer
forall a. Integral a => Parser a
decimal Parser Text (Maybe Integer -> AggregatedCostCentre)
-> Parser () -> Parser Text (Maybe Integer -> AggregatedCostCentre)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipHorizontalSpace -- ticks
  Parser Text (Maybe Integer -> AggregatedCostCentre)
-> Parser Text (Maybe Integer) -> Parser AggregatedCostCentre
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Integer -> Parser Text (Maybe Integer)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Integer
forall a. Integral a => Parser a
decimal Parser AggregatedCostCentre
-> Parser () -> Parser AggregatedCostCentre
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipHorizontalSpace -- bytes
  where
    source :: Parser Text (Maybe Text)
source
      | Bool
headerHasSrc = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> Parser Text Text -> Parser Text (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
sourceSpan
      | Bool
otherwise = Maybe Text -> Parser Text (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing

costCentres :: Parser CostCentreTree
costCentres :: Parser CostCentreTree
costCentres = do
  HeaderParams
params <- Parser HeaderParams
header; Parser ()
skipSpace
  HeaderParams -> Parser CostCentreTree
costCentreTree HeaderParams
params

costCentre :: HeaderParams -> Parser CostCentre
costCentre :: HeaderParams -> Parser CostCentre
costCentre HeaderParams
params = do
  Text
name <- Parser Text Text
symbol; Parser ()
skipHorizontalSpace
  (Text
modName, Maybe Text
src, Int
no, (Integer
entries, Scientific
indTime, Scientific
indAlloc, Scientific
inhTime, Scientific
inhAlloc, Maybe (Integer, Integer)
optInfo))
    <- HeaderParams
-> Parser
     Text
     (Text, Maybe Text, Int,
      (Integer, Scientific, Scientific, Scientific, Scientific,
       Maybe (Integer, Integer)))
forall c.
Integral c =>
HeaderParams
-> Parser
     Text
     (Text, Maybe Text, c,
      (Integer, Scientific, Scientific, Scientific, Scientific,
       Maybe (Integer, Integer)))
validCostCentre HeaderParams
params Parser
  Text
  (Text, Maybe Text, Int,
   (Integer, Scientific, Scientific, Scientific, Scientific,
    Maybe (Integer, Integer)))
-> Parser
     Text
     (Text, Maybe Text, Int,
      (Integer, Scientific, Scientific, Scientific, Scientific,
       Maybe (Integer, Integer)))
-> Parser
     Text
     (Text, Maybe Text, Int,
      (Integer, Scientific, Scientific, Scientific, Scientific,
       Maybe (Integer, Integer)))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser
  Text
  (Text, Maybe Text, Int,
   (Integer, Scientific, Scientific, Scientific, Scientific,
    Maybe (Integer, Integer)))
forall a.
Parser
  Text
  (Text, Maybe a, Int,
   (Integer, Scientific, Scientific, Scientific, Scientific,
    Maybe (Integer, Integer)))
jammedCostCentre
  CostCentre -> Parser CostCentre
forall (m :: * -> *) a. Monad m => a -> m a
return (CostCentre -> Parser CostCentre)
-> CostCentre -> Parser CostCentre
forall a b. (a -> b) -> a -> b
$! CostCentre :: Int
-> Text
-> Text
-> Maybe Text
-> Integer
-> Scientific
-> Scientific
-> Scientific
-> Scientific
-> Maybe Integer
-> Maybe Integer
-> CostCentre
CostCentre
    { costCentreName :: Text
costCentreName = Text
name
    , costCentreModule :: Text
costCentreModule = Text
modName
    , costCentreSrc :: Maybe Text
costCentreSrc = Maybe Text
src
    , costCentreNo :: Int
costCentreNo = Int
no
    , costCentreEntries :: Integer
costCentreEntries = Integer
entries
    , costCentreIndTime :: Scientific
costCentreIndTime = Scientific
indTime
    , costCentreIndAlloc :: Scientific
costCentreIndAlloc = Scientific
indAlloc
    , costCentreInhTime :: Scientific
costCentreInhTime = Scientific
inhTime
    , costCentreInhAlloc :: Scientific
costCentreInhAlloc = Scientific
inhAlloc
    , costCentreTicks :: Maybe Integer
costCentreTicks = (Integer, Integer) -> Integer
forall a b. (a, b) -> a
fst ((Integer, Integer) -> Integer)
-> Maybe (Integer, Integer) -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Integer, Integer)
optInfo
    , costCentreBytes :: Maybe Integer
costCentreBytes = (Integer, Integer) -> Integer
forall a b. (a, b) -> b
snd ((Integer, Integer) -> Integer)
-> Maybe (Integer, Integer) -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Integer, Integer)
optInfo
    }
  where
    validCostCentre :: HeaderParams
-> Parser
     Text
     (Text, Maybe Text, c,
      (Integer, Scientific, Scientific, Scientific, Scientific,
       Maybe (Integer, Integer)))
validCostCentre HeaderParams {Bool
headerHasSrc :: Bool
headerHasSrc :: HeaderParams -> Bool
..} = do
      Text
modName <- Parser Text Text
symbol; Parser ()
skipHorizontalSpace
      Maybe Text
src <- if Bool
headerHasSrc
        then do
          !Text
sym <- Parser Text Text
sourceSpan
          Maybe Text -> Parser Text (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> Parser Text (Maybe Text))
-> Maybe Text -> Parser Text (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
sym
        else Maybe Text -> Parser Text (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
      Parser ()
skipHorizontalSpace
      c
no <- Parser c
forall a. Integral a => Parser a
decimal; Parser ()
skipHorizontalSpace
      (Integer, Scientific, Scientific, Scientific, Scientific,
 Maybe (Integer, Integer))
vals <- Parser
  Text
  (Integer, Scientific, Scientific, Scientific, Scientific,
   Maybe (Integer, Integer))
metrics
      (Text, Maybe Text, c,
 (Integer, Scientific, Scientific, Scientific, Scientific,
  Maybe (Integer, Integer)))
-> Parser
     Text
     (Text, Maybe Text, c,
      (Integer, Scientific, Scientific, Scientific, Scientific,
       Maybe (Integer, Integer)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
modName, Maybe Text
src, c
no, (Integer, Scientific, Scientific, Scientific, Scientific,
 Maybe (Integer, Integer))
vals)
    -- Workaround for https://ghc.haskell.org/trac/ghc/ticket/8811.
    -- This bug had been fixed before the SRC column was implemented so
    -- @sourceSpan@ isn't parsed here.
    -- Caveat: This parser can be confused if module name contains digits and
    -- the digits are jammed with the cost centre number. In such cases, all
    -- the digits are parsed as a number of entries.
    jammedCostCentre :: Parser
  Text
  (Text, Maybe a, Int,
   (Integer, Scientific, Scientific, Scientific, Scientific,
    Maybe (Integer, Integer)))
jammedCostCentre = do
      Text
jammed <- Parser Text Text
symbol; Parser ()
skipHorizontalSpace
      let modName :: Text
modName = (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
isDigit Text
jammed
      Int
no <- (String -> Parser Text Int)
-> ((Int, Text) -> Parser Text Int)
-> Either String (Int, Text)
-> Parser Text Int
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser Text Int
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Int -> Parser Text Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Parser Text Int)
-> ((Int, Text) -> Int) -> (Int, Text) -> Parser Text Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Text) -> Int
forall a b. (a, b) -> a
fst) (Either String (Int, Text) -> Parser Text Int)
-> Either String (Int, Text) -> Parser Text Int
forall a b. (a -> b) -> a -> b
$ Reader Int
forall a. Integral a => Reader a
TR.decimal Reader Int -> Reader Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhileEnd Char -> Bool
isDigit Text
jammed
      (Integer, Scientific, Scientific, Scientific, Scientific,
 Maybe (Integer, Integer))
vals <- Parser
  Text
  (Integer, Scientific, Scientific, Scientific, Scientific,
   Maybe (Integer, Integer))
metrics
      (Text, Maybe a, Int,
 (Integer, Scientific, Scientific, Scientific, Scientific,
  Maybe (Integer, Integer)))
-> Parser
     Text
     (Text, Maybe a, Int,
      (Integer, Scientific, Scientific, Scientific, Scientific,
       Maybe (Integer, Integer)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
modName, Maybe a
forall a. Maybe a
Nothing, Int
no, (Integer, Scientific, Scientific, Scientific, Scientific,
 Maybe (Integer, Integer))
vals)
    metrics :: Parser
  Text
  (Integer, Scientific, Scientific, Scientific, Scientific,
   Maybe (Integer, Integer))
metrics = do
      Integer
entries <- Parser Integer
forall a. Integral a => Parser a
decimal; Parser ()
skipHorizontalSpace
      Scientific
indTime <- Parser Text Scientific
scientific; Parser ()
skipHorizontalSpace
      Scientific
indAlloc <- Parser Text Scientific
scientific; Parser ()
skipHorizontalSpace
      Scientific
inhTime <- Parser Text Scientific
scientific; Parser ()
skipHorizontalSpace
      Scientific
inhAlloc <- Parser Text Scientific
scientific; Parser ()
skipHorizontalSpace
      Maybe (Integer, Integer)
optInfo <- Parser Text (Integer, Integer)
-> Parser Text (Maybe (Integer, Integer))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text (Integer, Integer)
 -> Parser Text (Maybe (Integer, Integer)))
-> Parser Text (Integer, Integer)
-> Parser Text (Maybe (Integer, Integer))
forall a b. (a -> b) -> a -> b
$ do
        !Integer
ticks <- Parser Integer
forall a. Integral a => Parser a
decimal; Parser ()
skipHorizontalSpace
        !Integer
bytes <- Parser Integer
forall a. Integral a => Parser a
decimal
        (Integer, Integer) -> Parser Text (Integer, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
ticks, Integer
bytes)
      (Integer, Scientific, Scientific, Scientific, Scientific,
 Maybe (Integer, Integer))
-> Parser
     Text
     (Integer, Scientific, Scientific, Scientific, Scientific,
      Maybe (Integer, Integer))
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
entries, Scientific
indTime, Scientific
indAlloc, Scientific
inhTime, Scientific
inhAlloc, Maybe (Integer, Integer)
optInfo)

costCentreTree :: HeaderParams -> Parser CostCentreTree
costCentreTree :: HeaderParams -> Parser CostCentreTree
costCentreTree HeaderParams
params = [(Int, CostCentre)] -> CostCentreTree
buildTree ([(Int, CostCentre)] -> CostCentreTree)
-> Parser Text [(Int, CostCentre)] -> Parser CostCentreTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text [(Int, CostCentre)]
costCentreList
  where
    costCentreList :: Parser Text [(Int, CostCentre)]
costCentreList = Parser Text (Int, CostCentre)
nestedCostCentre Parser Text (Int, CostCentre)
-> Parser () -> Parser Text [(Int, CostCentre)]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Parser ()
endOfLine
    nestedCostCentre :: Parser Text (Int, CostCentre)
nestedCostCentre = (,)
      (Int -> CostCentre -> (Int, CostCentre))
-> Parser Text Int -> Parser Text (CostCentre -> (Int, CostCentre))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Int
nestLevel
      Parser Text (CostCentre -> (Int, CostCentre))
-> Parser CostCentre -> Parser Text (Int, CostCentre)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HeaderParams -> Parser CostCentre
costCentre HeaderParams
params
      Parser Text (Int, CostCentre)
-> Parser () -> Parser Text (Int, CostCentre)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipHorizontalSpace
    nestLevel :: Parser Text Int
nestLevel = Parser Text Char -> Parser Text Int
forall a. Parser a -> Parser Text Int
howMany Parser Text Char
space

type Level = Int

-- | TreePath represents a path to a node in a cost centre tree.
--
-- Invariant: @'treePathLevel' == length 'treePath'@
data TreePath = TreePath
  { TreePath -> Int
treePathLevel :: !Level
  -- ^ Current depth of the path
  , TreePath -> [Int]
treePath :: [CostCentreNo]
  -- ^ Path to the node
  }

push :: CostCentreNo -> TreePath -> TreePath
push :: Int -> TreePath -> TreePath
push Int
ccNo path :: TreePath
path@TreePath {Int
[Int]
treePath :: [Int]
treePathLevel :: Int
treePath :: TreePath -> [Int]
treePathLevel :: TreePath -> Int
..} = TreePath
path
  { treePathLevel :: Int
treePathLevel = Int
treePathLevel Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  , treePath :: [Int]
treePath = Int
ccNoInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
treePath
  }

popTo :: Level -> TreePath -> TreePath
popTo :: Int -> TreePath -> TreePath
popTo Int
level path :: TreePath
path@TreePath {Int
[Int]
treePath :: [Int]
treePathLevel :: Int
treePath :: TreePath -> [Int]
treePathLevel :: TreePath -> Int
..} = TreePath
path
  { treePathLevel :: Int
treePathLevel = Int
level
  , treePath :: [Int]
treePath = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop (Int
treePathLevel Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
level) [Int]
treePath
  }

currentNo :: TreePath -> Maybe CostCentreNo
currentNo :: TreePath -> Maybe Int
currentNo TreePath {[Int]
treePath :: [Int]
treePath :: TreePath -> [Int]
treePath} = [Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe [Int]
treePath

buildTree :: [(Level, CostCentre)] -> CostCentreTree
buildTree :: [(Int, CostCentre)] -> CostCentreTree
buildTree = (TreePath, CostCentreTree) -> CostCentreTree
forall a b. (a, b) -> b
snd ((TreePath, CostCentreTree) -> CostCentreTree)
-> ([(Int, CostCentre)] -> (TreePath, CostCentreTree))
-> [(Int, CostCentre)]
-> CostCentreTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TreePath, CostCentreTree)
 -> (Int, CostCentre) -> (TreePath, CostCentreTree))
-> (TreePath, CostCentreTree)
-> [(Int, CostCentre)]
-> (TreePath, CostCentreTree)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (TreePath, CostCentreTree)
-> (Int, CostCentre) -> (TreePath, CostCentreTree)
go (Int -> [Int] -> TreePath
TreePath Int
0 [], CostCentreTree
emptyCostCentreTree)
  where
    go
      :: (TreePath, CostCentreTree)
      -> (Level, CostCentre)
      -> (TreePath, CostCentreTree)
    go :: (TreePath, CostCentreTree)
-> (Int, CostCentre) -> (TreePath, CostCentreTree)
go (!TreePath
path, !CostCentreTree {IntMap Int
IntMap (Set CostCentre)
IntMap CostCentre
Map (Text, Text) (Set CostCentre)
Map Text (Map Text AggregatedCostCentre)
costCentreAggregate :: CostCentreTree -> Map Text (Map Text AggregatedCostCentre)
costCentreCallSites :: CostCentreTree -> Map (Text, Text) (Set CostCentre)
costCentreChildren :: CostCentreTree -> IntMap (Set CostCentre)
costCentreParents :: CostCentreTree -> IntMap Int
costCentreNodes :: CostCentreTree -> IntMap CostCentre
costCentreAggregate :: Map Text (Map Text AggregatedCostCentre)
costCentreCallSites :: Map (Text, Text) (Set CostCentre)
costCentreChildren :: IntMap (Set CostCentre)
costCentreParents :: IntMap Int
costCentreNodes :: IntMap CostCentre
..}) (Int
level, CostCentre
node) = (TreePath
path', CostCentreTree
tree')
      where
        ccNo :: Int
ccNo = CostCentre -> Int
costCentreNo CostCentre
node
        parentPath :: TreePath
parentPath = Int -> TreePath -> TreePath
popTo Int
level TreePath
path
        parentNo :: Maybe Int
parentNo = TreePath -> Maybe Int
currentNo TreePath
parentPath
        path' :: TreePath
path' = Int -> TreePath -> TreePath
push Int
ccNo TreePath
parentPath
        tree' :: CostCentreTree
tree' = CostCentreTree :: IntMap CostCentre
-> IntMap Int
-> IntMap (Set CostCentre)
-> Map (Text, Text) (Set CostCentre)
-> Map Text (Map Text AggregatedCostCentre)
-> CostCentreTree
CostCentreTree
          { costCentreNodes :: IntMap CostCentre
costCentreNodes = Int -> CostCentre -> IntMap CostCentre -> IntMap CostCentre
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
ccNo CostCentre
node IntMap CostCentre
costCentreNodes
          , costCentreParents :: IntMap Int
costCentreParents = IntMap Int -> (Int -> IntMap Int) -> Maybe Int -> IntMap Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IntMap Int
costCentreParents
            (\Int
parent -> Int -> Int -> IntMap Int -> IntMap Int
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
ccNo Int
parent IntMap Int
costCentreParents)
            Maybe Int
parentNo
          , costCentreChildren :: IntMap (Set CostCentre)
costCentreChildren = IntMap (Set CostCentre)
-> (Int -> IntMap (Set CostCentre))
-> Maybe Int
-> IntMap (Set CostCentre)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IntMap (Set CostCentre)
costCentreChildren
            (\Int
parent -> (Set CostCentre -> Set CostCentre -> Set CostCentre)
-> Int
-> Set CostCentre
-> IntMap (Set CostCentre)
-> IntMap (Set CostCentre)
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IntMap.insertWith Set CostCentre -> Set CostCentre -> Set CostCentre
forall a. Ord a => Set a -> Set a -> Set a
Set.union Int
parent
              (CostCentre -> Set CostCentre
forall a. a -> Set a
Set.singleton CostCentre
node)
              IntMap (Set CostCentre)
costCentreChildren)
            Maybe Int
parentNo
          , costCentreCallSites :: Map (Text, Text) (Set CostCentre)
costCentreCallSites = (Set CostCentre -> Set CostCentre -> Set CostCentre)
-> (Text, Text)
-> Set CostCentre
-> Map (Text, Text) (Set CostCentre)
-> Map (Text, Text) (Set CostCentre)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Set CostCentre -> Set CostCentre -> Set CostCentre
forall a. Ord a => Set a -> Set a -> Set a
Set.union
            (CostCentre -> Text
costCentreName CostCentre
node, CostCentre -> Text
costCentreModule CostCentre
node)
            (CostCentre -> Set CostCentre
forall a. a -> Set a
Set.singleton CostCentre
node)
            Map (Text, Text) (Set CostCentre)
costCentreCallSites
          , costCentreAggregate :: Map Text (Map Text AggregatedCostCentre)
costCentreAggregate = (Maybe (Map Text AggregatedCostCentre)
 -> Maybe (Map Text AggregatedCostCentre))
-> Text
-> Map Text (Map Text AggregatedCostCentre)
-> Map Text (Map Text AggregatedCostCentre)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter
            (Map Text AggregatedCostCentre
-> Maybe (Map Text AggregatedCostCentre)
forall a. a -> Maybe a
Just (Map Text AggregatedCostCentre
 -> Maybe (Map Text AggregatedCostCentre))
-> (Maybe (Map Text AggregatedCostCentre)
    -> Map Text AggregatedCostCentre)
-> Maybe (Map Text AggregatedCostCentre)
-> Maybe (Map Text AggregatedCostCentre)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Map Text AggregatedCostCentre)
-> Map Text AggregatedCostCentre
updateCostCentre)
            (CostCentre -> Text
costCentreModule CostCentre
node)
            Map Text (Map Text AggregatedCostCentre)
costCentreAggregate
          }
        aggregate :: AggregatedCostCentre
aggregate = AggregatedCostCentre :: Text
-> Text
-> Maybe Text
-> Maybe Integer
-> Scientific
-> Scientific
-> Maybe Integer
-> Maybe Integer
-> AggregatedCostCentre
AggregatedCostCentre
          { aggregatedCostCentreName :: Text
aggregatedCostCentreName = CostCentre -> Text
costCentreName CostCentre
node
          , aggregatedCostCentreModule :: Text
aggregatedCostCentreModule = CostCentre -> Text
costCentreModule CostCentre
node
          , aggregatedCostCentreSrc :: Maybe Text
aggregatedCostCentreSrc = CostCentre -> Maybe Text
costCentreSrc CostCentre
node
          , aggregatedCostCentreEntries :: Maybe Integer
aggregatedCostCentreEntries = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$! CostCentre -> Integer
costCentreEntries CostCentre
node
          , aggregatedCostCentreTime :: Scientific
aggregatedCostCentreTime = CostCentre -> Scientific
costCentreIndTime CostCentre
node
          , aggregatedCostCentreAlloc :: Scientific
aggregatedCostCentreAlloc = CostCentre -> Scientific
costCentreIndAlloc CostCentre
node
          , aggregatedCostCentreTicks :: Maybe Integer
aggregatedCostCentreTicks = CostCentre -> Maybe Integer
costCentreTicks CostCentre
node
          , aggregatedCostCentreBytes :: Maybe Integer
aggregatedCostCentreBytes = CostCentre -> Maybe Integer
costCentreBytes CostCentre
node
          }
        updateCostCentre
          :: Maybe (Map.Map Text AggregatedCostCentre)
          -> Map.Map Text AggregatedCostCentre
        updateCostCentre :: Maybe (Map Text AggregatedCostCentre)
-> Map Text AggregatedCostCentre
updateCostCentre = \case
          Maybe (Map Text AggregatedCostCentre)
Nothing -> Text -> AggregatedCostCentre -> Map Text AggregatedCostCentre
forall k a. k -> a -> Map k a
Map.singleton (CostCentre -> Text
costCentreName CostCentre
node) AggregatedCostCentre
aggregate
          Just Map Text AggregatedCostCentre
costCentreByName ->
            (AggregatedCostCentre
 -> AggregatedCostCentre -> AggregatedCostCentre)
-> Text
-> AggregatedCostCentre
-> Map Text AggregatedCostCentre
-> Map Text AggregatedCostCentre
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith
              AggregatedCostCentre
-> AggregatedCostCentre -> AggregatedCostCentre
addCostCentre
              (CostCentre -> Text
costCentreName CostCentre
node)
              AggregatedCostCentre
aggregate
              Map Text AggregatedCostCentre
costCentreByName
        addCostCentre :: AggregatedCostCentre
-> AggregatedCostCentre -> AggregatedCostCentre
addCostCentre AggregatedCostCentre
x AggregatedCostCentre
y = AggregatedCostCentre
x
          { aggregatedCostCentreEntries :: Maybe Integer
aggregatedCostCentreEntries = Maybe Integer -> Maybe Integer
forall (m :: * -> *) a. Monad m => m a -> m a
seqM (Maybe Integer -> Maybe Integer) -> Maybe Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)
            (Integer -> Integer -> Integer)
-> Maybe Integer -> Maybe (Integer -> Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AggregatedCostCentre -> Maybe Integer
aggregatedCostCentreEntries AggregatedCostCentre
x
            Maybe (Integer -> Integer) -> Maybe Integer -> Maybe Integer
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AggregatedCostCentre -> Maybe Integer
aggregatedCostCentreEntries AggregatedCostCentre
y
          , aggregatedCostCentreTime :: Scientific
aggregatedCostCentreTime =
            AggregatedCostCentre -> Scientific
aggregatedCostCentreTime AggregatedCostCentre
x Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
+ AggregatedCostCentre -> Scientific
aggregatedCostCentreTime AggregatedCostCentre
y
          , aggregatedCostCentreAlloc :: Scientific
aggregatedCostCentreAlloc =
            AggregatedCostCentre -> Scientific
aggregatedCostCentreAlloc AggregatedCostCentre
x Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
+ AggregatedCostCentre -> Scientific
aggregatedCostCentreAlloc AggregatedCostCentre
y
          , aggregatedCostCentreTicks :: Maybe Integer
aggregatedCostCentreTicks = Maybe Integer -> Maybe Integer
forall (m :: * -> *) a. Monad m => m a -> m a
seqM (Maybe Integer -> Maybe Integer) -> Maybe Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)
            (Integer -> Integer -> Integer)
-> Maybe Integer -> Maybe (Integer -> Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AggregatedCostCentre -> Maybe Integer
aggregatedCostCentreTicks AggregatedCostCentre
x
            Maybe (Integer -> Integer) -> Maybe Integer -> Maybe Integer
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AggregatedCostCentre -> Maybe Integer
aggregatedCostCentreTicks AggregatedCostCentre
y
          , aggregatedCostCentreBytes :: Maybe Integer
aggregatedCostCentreBytes = Maybe Integer -> Maybe Integer
forall (m :: * -> *) a. Monad m => m a -> m a
seqM (Maybe Integer -> Maybe Integer) -> Maybe Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)
            (Integer -> Integer -> Integer)
-> Maybe Integer -> Maybe (Integer -> Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AggregatedCostCentre -> Maybe Integer
aggregatedCostCentreBytes AggregatedCostCentre
x
            Maybe (Integer -> Integer) -> Maybe Integer -> Maybe Integer
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AggregatedCostCentre -> Maybe Integer
aggregatedCostCentreBytes AggregatedCostCentre
y
          }

howMany :: Parser a -> Parser Int
howMany :: Parser a -> Parser Text Int
howMany Parser a
p = Int -> Parser Text Int
forall a. Enum a => a -> Parser Text a
loop Int
0
  where
    loop :: a -> Parser Text a
loop !a
n = (Parser a
p Parser a -> Parser Text a -> Parser Text a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Parser Text a
loop (a -> a
forall a. Enum a => a -> a
succ a
n)) Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return a
n

parens :: Parser a -> Parser a
parens :: Parser a -> Parser a
parens Parser a
p = Text -> Parser Text Text
string Text
"(" Parser Text Text -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
p Parser a -> Parser Text Text -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
string Text
")"

symbol :: Parser Text
symbol :: Parser Text Text
symbol = (Char -> Bool) -> Parser Text Text
A.takeWhile ((Char -> Bool) -> Parser Text Text)
-> (Char -> Bool) -> Parser Text Text
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace

sourceSpan :: Parser Text
sourceSpan :: Parser Text Text
sourceSpan = [Parser Text Text] -> Parser Text Text
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
  [ String -> Text
T.pack (String -> Text) -> Parser Text String -> Parser Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text String
angleBrackets
  , Parser Text Text
symbol
  ]
  where
    angleBrackets :: Parser Text String
angleBrackets = (:) (Char -> String -> String)
-> Parser Text Char -> Parser Text (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Parser Text Char
char Char
'<' Parser Text (String -> String)
-> Parser Text String -> Parser Text String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Char -> Parser Text Char -> Parser Text String
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
manyTill Parser Text Char
anyChar (Char -> Parser Text Char
char Char
'>')

skipHorizontalSpace :: Parser ()
skipHorizontalSpace :: Parser ()
skipHorizontalSpace = Parser Text Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text Text -> Parser ()) -> Parser Text Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser Text Text
A.takeWhile Char -> Bool
isHorizontalSpace

optional_ :: Parser a -> Parser ()
optional_ :: Parser a -> Parser ()
optional_ = Parser Text (Maybe a) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text (Maybe a) -> Parser ())
-> (Parser a -> Parser Text (Maybe a)) -> Parser a -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> Parser Text (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional