{-# LANGUAGE CPP #-}
module GHC.Prof
  ( decode
  , decode'

  -- * Parser
  , profile

  -- * Cost-centre tree
  , CostCentreTree
  , aggregatedCostCentres
  , aggregatedCostCentresOrderBy
  , costCentres
  , costCentresOrderBy
  , aggregateCallSites
  , aggregateCallSitesOrderBy
  , callSites
  , callSitesOrderBy
  , aggregateModules
  , aggregateModulesOrderBy

  -- * Types
  , Profile(..)
  , TotalTime(..)
  , TotalAlloc(..)
  , AggregatedCostCentre(..)
  , CostCentre(..)
  , CostCentreNo
  , CallSite(..)
  , AggregateModule(..)
  ) where

#if !MIN_VERSION_base(4, 13, 0)
import Control.Applicative ((<*))
#endif

import qualified Data.Attoparsec.Text.Lazy as ATL
import qualified Data.Attoparsec.Text as AT
import qualified Data.Text.Lazy as TL
import qualified Data.Text as T

import GHC.Prof.CostCentreTree
import GHC.Prof.Parser (profile)
import GHC.Prof.Types

-- | Decode a GHC time allocation profiling report from a lazy 'ATL.Text'
decode :: TL.Text -> Either String Profile
decode :: Text -> Either String Profile
decode Text
text = case Parser Profile -> Text -> Result Profile
forall a. Parser a -> Text -> Result a
ATL.parse Parser Profile
profile Text
text of
  ATL.Fail Text
_unconsumed [String]
_contexts String
reason -> String -> Either String Profile
forall a b. a -> Either a b
Left String
reason
  ATL.Done Text
_unconsumed Profile
prof -> Profile -> Either String Profile
forall a b. b -> Either a b
Right Profile
prof

-- | Decode a GHC time allocation profiling report from a strict 'AT.Text'
decode' :: T.Text -> Either String Profile
decode' :: Text -> Either String Profile
decode' Text
text = Parser Profile -> Text -> Either String Profile
forall a. Parser a -> Text -> Either String a
AT.parseOnly (Parser Profile
profile Parser Profile -> Parser Text () -> Parser Profile
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
AT.endOfInput) Text
text