{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module HsSpeedscope where


import Data.Aeson
import GHC.RTS.Events hiding (header, str)

import Data.Word
import Data.Text (Text)
import qualified Data.Text
import qualified Data.Vector.Unboxed as V
import Data.Maybe
import Data.List.Extra
import Control.Monad
import Data.Char

import Data.Version
import Text.ParserCombinators.ReadP
import qualified Paths_hs_speedscope as Paths

import Options.Applicative hiding (optional)
import qualified Options.Applicative as O


data SSOptions = SSOptions { SSOptions -> FilePath
file :: FilePath
                       , SSOptions -> Maybe Text
isolateStart :: Maybe Text
                       , SSOptions -> Maybe Text
isolateEnd :: Maybe Text
                       } deriving Int -> SSOptions -> ShowS
[SSOptions] -> ShowS
SSOptions -> FilePath
(Int -> SSOptions -> ShowS)
-> (SSOptions -> FilePath)
-> ([SSOptions] -> ShowS)
-> Show SSOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SSOptions] -> ShowS
$cshowList :: [SSOptions] -> ShowS
show :: SSOptions -> FilePath
$cshow :: SSOptions -> FilePath
showsPrec :: Int -> SSOptions -> ShowS
$cshowsPrec :: Int -> SSOptions -> ShowS
Show


optsParser :: Parser SSOptions
optsParser :: Parser SSOptions
optsParser = FilePath -> Maybe Text -> Maybe Text -> SSOptions
SSOptions
  (FilePath -> Maybe Text -> Maybe Text -> SSOptions)
-> Parser FilePath
-> Parser (Maybe Text -> Maybe Text -> SSOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM FilePath -> Mod ArgumentFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM FilePath
forall s. IsString s => ReadM s
str (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"FILE.eventlog")
  Parser (Maybe Text -> Maybe Text -> SSOptions)
-> Parser (Maybe Text) -> Parser (Maybe Text -> SSOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
O.optional (Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    ( Char -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
's'
    Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"start"
    Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"STRING"
    Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"No samples before the first eventlog message with this prefix will be included in the output" ))
  Parser (Maybe Text -> SSOptions)
-> Parser (Maybe Text) -> Parser SSOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
O.optional (Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    ( Char -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'e' Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"end" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"STRING" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"No samples after the first eventlog message with this prefix will be included in the output" ))



entry :: IO ()
entry :: IO ()
entry = do
  SSOptions
os <- ParserInfo SSOptions -> IO SSOptions
forall a. ParserInfo a -> IO a
execParser ParserInfo SSOptions
opts
  SSOptions -> IO ()
run SSOptions
os
  where
    opts :: ParserInfo SSOptions
opts = Parser SSOptions -> InfoMod SSOptions -> ParserInfo SSOptions
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser SSOptions
optsParser Parser SSOptions
-> Parser (SSOptions -> SSOptions) -> Parser SSOptions
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (SSOptions -> SSOptions)
forall a. Parser (a -> a)
helper)
      ( InfoMod SSOptions
forall a. InfoMod a
fullDesc
     InfoMod SSOptions -> InfoMod SSOptions -> InfoMod SSOptions
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod SSOptions
forall a. FilePath -> InfoMod a
progDesc FilePath
"Generate a speedscope.app json file from an eventlog"
     InfoMod SSOptions -> InfoMod SSOptions -> InfoMod SSOptions
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod SSOptions
forall a. FilePath -> InfoMod a
header FilePath
"hs-speedscope" )

run :: SSOptions -> IO ()
run :: SSOptions -> IO ()
run SSOptions
os = do
  EventLog
el <- (FilePath -> EventLog)
-> (EventLog -> EventLog) -> Either FilePath EventLog -> EventLog
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> EventLog
forall a. HasCallStack => FilePath -> a
error EventLog -> EventLog
forall a. a -> a
id (Either FilePath EventLog -> EventLog)
-> IO (Either FilePath EventLog) -> IO EventLog
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Either FilePath EventLog)
readEventLogFromFile (SSOptions -> FilePath
file SSOptions
os)
  FilePath -> Value -> IO ()
forall a. ToJSON a => FilePath -> a -> IO ()
encodeFile (SSOptions -> FilePath
file SSOptions
os FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
".json") ((Maybe Text, Maybe Text) -> EventLog -> Value
convertToSpeedscope (SSOptions -> Maybe Text
isolateStart SSOptions
os, SSOptions -> Maybe Text
isolateEnd SSOptions
os) EventLog
el)

data ReadState =
        ReadAll -- Ignore all future
      | IgnoreUntil Text ReadState
      | ReadUntil Text ReadState
      | IgnoreAll deriving Int -> ReadState -> ShowS
[ReadState] -> ShowS
ReadState -> FilePath
(Int -> ReadState -> ShowS)
-> (ReadState -> FilePath)
-> ([ReadState] -> ShowS)
-> Show ReadState
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ReadState] -> ShowS
$cshowList :: [ReadState] -> ShowS
show :: ReadState -> FilePath
$cshow :: ReadState -> FilePath
showsPrec :: Int -> ReadState -> ShowS
$cshowsPrec :: Int -> ReadState -> ShowS
Show

shouldRead :: ReadState -> Bool
shouldRead :: ReadState -> Bool
shouldRead ReadState
ReadAll = Bool
True
shouldRead (ReadUntil {}) = Bool
True
shouldRead ReadState
_ = Bool
False

transition :: Text -> ReadState -> ReadState
transition :: Text -> ReadState -> ReadState
transition Text
s ReadState
r = case ReadState
r of
                   (ReadUntil Text
is ReadState
n) | Text
is Text -> Text -> Bool
`Data.Text.isPrefixOf` Text
s -> ReadState
n
                   (IgnoreUntil Text
is ReadState
n) | Text
is Text -> Text -> Bool
`Data.Text.isPrefixOf` Text
s -> ReadState
n
                   ReadState
_ -> ReadState
r

initState :: Maybe Text -> Maybe Text -> ReadState
initState :: Maybe Text -> Maybe Text -> ReadState
initState Maybe Text
Nothing Maybe Text
Nothing = ReadState
ReadAll
initState (Just Text
s) Maybe Text
e = Text -> ReadState -> ReadState
IgnoreUntil Text
s (Maybe Text -> Maybe Text -> ReadState
initState Maybe Text
forall a. Maybe a
Nothing Maybe Text
e)
initState Maybe Text
Nothing  (Just Text
e) = Text -> ReadState -> ReadState
ReadUntil Text
e ReadState
IgnoreAll

convertToSpeedscope :: (Maybe Text, Maybe Text) -> EventLog -> Value
convertToSpeedscope :: (Maybe Text, Maybe Text) -> EventLog -> Value
convertToSpeedscope (Maybe Text
is, Maybe Text
ie) (EventLog Header
_h (Data ((Event -> Timestamp) -> [Event] -> [Event]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Event -> Timestamp
evTime -> [Event]
es))) =
  case Maybe (Version, Text)
el_version of
    Just (Version
ghc_version, Text
_) | Version
ghc_version Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
makeVersion [Int
8,Int
9,Int
0]  ->
      FilePath -> Value
forall a. HasCallStack => FilePath -> a
error (FilePath
"Eventlog is from ghc-" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
showVersion Version
ghc_version FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" hs-speedscope only works with GHC 8.10 or later")
    Maybe (Version, Text)
_ -> [Pair] -> Value
object [ Text
"version" Text -> FilePath -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (FilePath
"0.0.1" :: String)
                , Text
"$schema" Text -> FilePath -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (FilePath
"https://www.speedscope.app/file-format-schema.json" :: String)
                , Text
"shared" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object [ Text
"frames" Text -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Value]
ccs_json ]
                , Text
"profiles" Text -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ((Capset, [[Int]]) -> Value) -> [(Capset, [[Int]])] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Timestamp -> (Capset, [[Int]]) -> Value
mkProfile Text
profile_name Timestamp
interval) [(Capset, [[Int]])]
caps
                , Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
profile_name
                , Text
"activeProfileIndex" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Int
0 :: Int)
                , Text
"exporter" Text -> FilePath -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= FilePath
version_string
                ]
  where
    (EL (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" -> Text
profile_name) Maybe (Version, Text)
el_version (Timestamp -> Maybe Timestamp -> Timestamp
forall a. a -> Maybe a -> a
fromMaybe Timestamp
1 -> Timestamp
interval) [CostCentre]
frames [Sample]
samples) =
      (ReadState, EL) -> EL
forall a b. (a, b) -> b
snd ((ReadState, EL) -> EL) -> (ReadState, EL) -> EL
forall a b. (a -> b) -> a -> b
$ ((ReadState, EL) -> Event -> (ReadState, EL))
-> (ReadState, EL) -> [Event] -> (ReadState, EL)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Event -> (ReadState, EL) -> (ReadState, EL))
-> (ReadState, EL) -> Event -> (ReadState, EL)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Event -> (ReadState, EL) -> (ReadState, EL)
processEvents) (Maybe Text -> Maybe Text -> ReadState
initState Maybe Text
is Maybe Text
ie, EL
initEL) [Event]
es

    initEL :: EL
initEL = Maybe Text
-> Maybe (Version, Text)
-> Maybe Timestamp
-> [CostCentre]
-> [Sample]
-> EL
EL Maybe Text
forall a. Maybe a
Nothing Maybe (Version, Text)
forall a. Maybe a
Nothing Maybe Timestamp
forall a. Maybe a
Nothing [] []


    version_string :: String
    version_string :: FilePath
version_string = FilePath
"hs-speedscope@" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
showVersion Version
Paths.version

    -- Drop 7 events for built in cost centres like GC, IDLE etc
    ccs_raw :: [CostCentre]
ccs_raw = [CostCentre] -> [CostCentre]
forall a. [a] -> [a]
reverse (Int -> [CostCentre] -> [CostCentre]
forall a. Int -> [a] -> [a]
drop Int
7 ([CostCentre] -> [CostCentre]
forall a. [a] -> [a]
reverse [CostCentre]
frames))


    ccs_json :: [Value]
    ccs_json :: [Value]
ccs_json = (CostCentre -> Value) -> [CostCentre] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map CostCentre -> Value
mkFrame [CostCentre]
ccs_raw

    num_frames :: Int
num_frames = [Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
ccs_json


    caps :: [(Capset, [[Int]])]
    caps :: [(Capset, [[Int]])]
caps = [(Capset, [Int])] -> [(Capset, [[Int]])]
forall k v. Ord k => [(k, v)] -> [(k, [v])]
groupSort ([(Capset, [Int])] -> [(Capset, [[Int]])])
-> [(Capset, [Int])] -> [(Capset, [[Int]])]
forall a b. (a -> b) -> a -> b
$ (Sample -> Maybe (Capset, [Int])) -> [Sample] -> [(Capset, [Int])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Sample -> Maybe (Capset, [Int])
mkSample ([Sample] -> [Sample]
forall a. [a] -> [a]
reverse [Sample]
samples)

    mkFrame :: CostCentre -> Value
    mkFrame :: CostCentre -> Value
mkFrame (CostCentre Capset
_n Text
l Text
_m Text
s) = [Pair] -> Value
object [ Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
l, Text
"file" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
s ]

    mkSample :: Sample -> Maybe (Capset, [Int])
    -- Filter out system frames
    mkSample :: Sample -> Maybe (Capset, [Int])
mkSample (Sample Capset
_ti [Capset
k]) | Capset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Capset
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
num_frames = Maybe (Capset, [Int])
forall a. Maybe a
Nothing
    mkSample (Sample Capset
ti [Capset]
ccs) = (Capset, [Int]) -> Maybe (Capset, [Int])
forall a. a -> Maybe a
Just (Capset
ti, (Capset -> Int) -> [Capset] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1 (Int -> Int) -> (Capset -> Int) -> Capset -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Capset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Capset] -> [Capset]
forall a. [a] -> [a]
reverse [Capset]
ccs))


    processEvents :: Event -> (ReadState, EL) -> (ReadState, EL)
    processEvents :: Event -> (ReadState, EL) -> (ReadState, EL)
processEvents (Event Timestamp
_t EventInfo
ei Maybe Int
_c) (ReadState
do_sample, EL
el) =
      case EventInfo
ei of
        ProgramArgs Capset
_ (Text
pname: [Text]
_args) ->
          (ReadState
do_sample, EL
el { prog_name :: Maybe Text
prog_name = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
pname })
        RtsIdentifier Capset
_ Text
rts_ident ->
          (ReadState
do_sample, EL
el { rts_version :: Maybe (Version, Text)
rts_version = Text -> Maybe (Version, Text)
parseIdent Text
rts_ident })
        ProfBegin Timestamp
ival ->
          (ReadState
do_sample, EL
el { prof_interval :: Maybe Timestamp
prof_interval = Timestamp -> Maybe Timestamp
forall a. a -> Maybe a
Just Timestamp
ival })
        HeapProfCostCentre Capset
n Text
l Text
m Text
s HeapProfFlags
_ ->
          (ReadState
do_sample, EL
el { cost_centres :: [CostCentre]
cost_centres = Capset -> Text -> Text -> Text -> CostCentre
CostCentre Capset
n Text
l Text
m Text
s CostCentre -> [CostCentre] -> [CostCentre]
forall a. a -> [a] -> [a]
: EL -> [CostCentre]
cost_centres EL
el })
        ProfSampleCostCentre Capset
t Timestamp
_ Word8
_ Vector Capset
st ->
          if ReadState -> Bool
shouldRead ReadState
do_sample then
            (ReadState
do_sample, EL
el { el_samples :: [Sample]
el_samples = Capset -> [Capset] -> Sample
Sample Capset
t (Vector Capset -> [Capset]
forall a. Unbox a => Vector a -> [a]
V.toList Vector Capset
st) Sample -> [Sample] -> [Sample]
forall a. a -> [a] -> [a]
: EL -> [Sample]
el_samples EL
el })
            else (ReadState
do_sample, EL
el)
        (UserMarker Text
m) -> (Text -> ReadState -> ReadState
transition Text
m ReadState
do_sample, EL
el)
        EventInfo
_ -> (ReadState
do_sample, EL
el)

mkProfile :: Text -> Word64 -> (Capset, [[Int]]) -> Value
mkProfile :: Text -> Timestamp -> (Capset, [[Int]]) -> Value
mkProfile Text
pname Timestamp
interval (Capset
_n, [[Int]]
samples) =
  [Pair] -> Value
object [ Text
"type" Text -> FilePath -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (FilePath
"sampled" :: String)
         , Text
"unit" Text -> FilePath -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (FilePath
"nanoseconds" :: String)
         , Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
pname
         , Text
"startValue" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Int
0 :: Int)
         , Text
"endValue" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ([[Int]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Int]]
samples :: Int)
         , Text
"samples" Text -> [[Int]] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [[Int]]
samples
         , Text
"weights" Text -> [Timestamp] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Timestamp]
sample_weights ]
  where
    sample_weights :: [Word64]
    sample_weights :: [Timestamp]
sample_weights = Int -> Timestamp -> [Timestamp]
forall a. Int -> a -> [a]
replicate ([[Int]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Int]]
samples) Timestamp
interval

parseIdent :: Text -> Maybe (Version, Text)
parseIdent :: Text -> Maybe (Version, Text)
parseIdent Text
s = Maybe (Version, FilePath) -> Maybe (Version, Text)
forall (f :: * -> *) a. Functor f => f (a, FilePath) -> f (a, Text)
convert (Maybe (Version, FilePath) -> Maybe (Version, Text))
-> Maybe (Version, FilePath) -> Maybe (Version, Text)
forall a b. (a -> b) -> a -> b
$ [(Version, FilePath)] -> Maybe (Version, FilePath)
forall a. [a] -> Maybe a
listToMaybe ([(Version, FilePath)] -> Maybe (Version, FilePath))
-> [(Version, FilePath)] -> Maybe (Version, FilePath)
forall a b. (a -> b) -> a -> b
$ (ReadP Version -> FilePath -> [(Version, FilePath)])
-> FilePath -> ReadP Version -> [(Version, FilePath)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReadP Version -> FilePath -> [(Version, FilePath)]
forall a. ReadP a -> ReadS a
readP_to_S (Text -> FilePath
Data.Text.unpack Text
s) (ReadP Version -> [(Version, FilePath)])
-> ReadP Version -> [(Version, FilePath)]
forall a b. (a -> b) -> a -> b
$ do
  ReadP FilePath -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP FilePath -> ReadP ()) -> ReadP FilePath -> ReadP ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ReadP FilePath
string FilePath
"GHC-"
  [Int
v1, Int
v2, Int
v3] <- Int -> ReadP Int -> ReadP [Int]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 (ReadP Int
intP ReadP Int -> ReadP () -> ReadP Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP Char -> ReadP ()
forall a. ReadP a -> ReadP ()
optional (Char -> ReadP Char
char Char
'.'))
  ReadP ()
skipSpaces
  Version -> ReadP Version
forall (m :: * -> *) a. Monad m => a -> m a
return (Version -> ReadP Version) -> Version -> ReadP Version
forall a b. (a -> b) -> a -> b
$ [Int] -> Version
makeVersion [Int
v1,Int
v2,Int
v3]
  where
    intP :: ReadP Int
intP = do
      FilePath
x <- (Char -> Bool) -> ReadP FilePath
munch1 Char -> Bool
isDigit
      Int -> ReadP Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ReadP Int) -> Int -> ReadP Int
forall a b. (a -> b) -> a -> b
$ FilePath -> Int
forall a. Read a => FilePath -> a
read FilePath
x

    convert :: f (a, FilePath) -> f (a, Text)
convert f (a, FilePath)
x = (\(a
a, FilePath
b) -> (a
a, FilePath -> Text
Data.Text.pack FilePath
b)) ((a, FilePath) -> (a, Text)) -> f (a, FilePath) -> f (a, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a, FilePath)
x

data EL = EL {
    EL -> Maybe Text
prog_name :: Maybe Text
  , EL -> Maybe (Version, Text)
rts_version :: Maybe (Version, Text)
  , EL -> Maybe Timestamp
prof_interval :: Maybe Word64
  , EL -> [CostCentre]
cost_centres :: [CostCentre]
  , EL -> [Sample]
el_samples :: [Sample]
}

data CostCentre = CostCentre Word32 Text Text Text deriving Int -> CostCentre -> ShowS
[CostCentre] -> ShowS
CostCentre -> FilePath
(Int -> CostCentre -> ShowS)
-> (CostCentre -> FilePath)
-> ([CostCentre] -> ShowS)
-> Show CostCentre
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CostCentre] -> ShowS
$cshowList :: [CostCentre] -> ShowS
show :: CostCentre -> FilePath
$cshow :: CostCentre -> FilePath
showsPrec :: Int -> CostCentre -> ShowS
$cshowsPrec :: Int -> CostCentre -> ShowS
Show

data Sample = Sample Capset [Word32]