-- | Profiling information emitted by a running Futhark program.
module Futhark.Profile
  ( ProfilingEvent (..),
    ProfilingReport (..),
    profilingReportFromText,
    decodeProfilingReport,
  )
where

import Data.Aeson qualified as JSON
import Data.Aeson.Key qualified as JSON
import Data.Aeson.KeyMap qualified as JSON
import Data.Bifunctor
import Data.ByteString.Builder (toLazyByteString)
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.Map qualified as M
import Data.Text qualified as T
import Data.Text.Encoding (encodeUtf8Builder)

-- | A thing that has occurred during execution.
data ProfilingEvent = ProfilingEvent
  { -- | Short, single line.
    ProfilingEvent -> Text
eventName :: T.Text,
    -- | In microseconds.
    ProfilingEvent -> Double
eventDuration :: Double,
    -- | Long, may be multiple lines.
    ProfilingEvent -> Text
eventDescription :: T.Text
  }
  deriving (ProfilingEvent -> ProfilingEvent -> Bool
(ProfilingEvent -> ProfilingEvent -> Bool)
-> (ProfilingEvent -> ProfilingEvent -> Bool) -> Eq ProfilingEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProfilingEvent -> ProfilingEvent -> Bool
== :: ProfilingEvent -> ProfilingEvent -> Bool
$c/= :: ProfilingEvent -> ProfilingEvent -> Bool
/= :: ProfilingEvent -> ProfilingEvent -> Bool
Eq, Eq ProfilingEvent
Eq ProfilingEvent =>
(ProfilingEvent -> ProfilingEvent -> Ordering)
-> (ProfilingEvent -> ProfilingEvent -> Bool)
-> (ProfilingEvent -> ProfilingEvent -> Bool)
-> (ProfilingEvent -> ProfilingEvent -> Bool)
-> (ProfilingEvent -> ProfilingEvent -> Bool)
-> (ProfilingEvent -> ProfilingEvent -> ProfilingEvent)
-> (ProfilingEvent -> ProfilingEvent -> ProfilingEvent)
-> Ord ProfilingEvent
ProfilingEvent -> ProfilingEvent -> Bool
ProfilingEvent -> ProfilingEvent -> Ordering
ProfilingEvent -> ProfilingEvent -> ProfilingEvent
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ProfilingEvent -> ProfilingEvent -> Ordering
compare :: ProfilingEvent -> ProfilingEvent -> Ordering
$c< :: ProfilingEvent -> ProfilingEvent -> Bool
< :: ProfilingEvent -> ProfilingEvent -> Bool
$c<= :: ProfilingEvent -> ProfilingEvent -> Bool
<= :: ProfilingEvent -> ProfilingEvent -> Bool
$c> :: ProfilingEvent -> ProfilingEvent -> Bool
> :: ProfilingEvent -> ProfilingEvent -> Bool
$c>= :: ProfilingEvent -> ProfilingEvent -> Bool
>= :: ProfilingEvent -> ProfilingEvent -> Bool
$cmax :: ProfilingEvent -> ProfilingEvent -> ProfilingEvent
max :: ProfilingEvent -> ProfilingEvent -> ProfilingEvent
$cmin :: ProfilingEvent -> ProfilingEvent -> ProfilingEvent
min :: ProfilingEvent -> ProfilingEvent -> ProfilingEvent
Ord, Int -> ProfilingEvent -> ShowS
[ProfilingEvent] -> ShowS
ProfilingEvent -> String
(Int -> ProfilingEvent -> ShowS)
-> (ProfilingEvent -> String)
-> ([ProfilingEvent] -> ShowS)
-> Show ProfilingEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProfilingEvent -> ShowS
showsPrec :: Int -> ProfilingEvent -> ShowS
$cshow :: ProfilingEvent -> String
show :: ProfilingEvent -> String
$cshowList :: [ProfilingEvent] -> ShowS
showList :: [ProfilingEvent] -> ShowS
Show)

instance JSON.ToJSON ProfilingEvent where
  toJSON :: ProfilingEvent -> Value
toJSON (ProfilingEvent Text
name Double
duration Text
description) =
    [Pair] -> Value
JSON.object
      [ (Key
"name", Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Text
name),
        (Key
"duration", Double -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Double
duration),
        (Key
"description", Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Text
description)
      ]

instance JSON.FromJSON ProfilingEvent where
  parseJSON :: Value -> Parser ProfilingEvent
parseJSON = String
-> (Object -> Parser ProfilingEvent)
-> Value
-> Parser ProfilingEvent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"event" ((Object -> Parser ProfilingEvent)
 -> Value -> Parser ProfilingEvent)
-> (Object -> Parser ProfilingEvent)
-> Value
-> Parser ProfilingEvent
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Double -> Text -> ProfilingEvent
ProfilingEvent
      (Text -> Double -> Text -> ProfilingEvent)
-> Parser Text -> Parser (Double -> Text -> ProfilingEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
JSON..: Key
"name"
      Parser (Double -> Text -> ProfilingEvent)
-> Parser Double -> Parser (Text -> ProfilingEvent)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
JSON..: Key
"duration"
      Parser (Text -> ProfilingEvent)
-> Parser Text -> Parser ProfilingEvent
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
JSON..: Key
"description"

-- | A profiling report contains all profiling information for a
-- single benchmark (meaning a single invocation on an entry point on
-- a specific dataset).
data ProfilingReport = ProfilingReport
  { ProfilingReport -> [ProfilingEvent]
profilingEvents :: [ProfilingEvent],
    -- | Mapping memory spaces to bytes.
    ProfilingReport -> Map Text Integer
profilingMemory :: M.Map T.Text Integer
  }
  deriving (ProfilingReport -> ProfilingReport -> Bool
(ProfilingReport -> ProfilingReport -> Bool)
-> (ProfilingReport -> ProfilingReport -> Bool)
-> Eq ProfilingReport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProfilingReport -> ProfilingReport -> Bool
== :: ProfilingReport -> ProfilingReport -> Bool
$c/= :: ProfilingReport -> ProfilingReport -> Bool
/= :: ProfilingReport -> ProfilingReport -> Bool
Eq, Eq ProfilingReport
Eq ProfilingReport =>
(ProfilingReport -> ProfilingReport -> Ordering)
-> (ProfilingReport -> ProfilingReport -> Bool)
-> (ProfilingReport -> ProfilingReport -> Bool)
-> (ProfilingReport -> ProfilingReport -> Bool)
-> (ProfilingReport -> ProfilingReport -> Bool)
-> (ProfilingReport -> ProfilingReport -> ProfilingReport)
-> (ProfilingReport -> ProfilingReport -> ProfilingReport)
-> Ord ProfilingReport
ProfilingReport -> ProfilingReport -> Bool
ProfilingReport -> ProfilingReport -> Ordering
ProfilingReport -> ProfilingReport -> ProfilingReport
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ProfilingReport -> ProfilingReport -> Ordering
compare :: ProfilingReport -> ProfilingReport -> Ordering
$c< :: ProfilingReport -> ProfilingReport -> Bool
< :: ProfilingReport -> ProfilingReport -> Bool
$c<= :: ProfilingReport -> ProfilingReport -> Bool
<= :: ProfilingReport -> ProfilingReport -> Bool
$c> :: ProfilingReport -> ProfilingReport -> Bool
> :: ProfilingReport -> ProfilingReport -> Bool
$c>= :: ProfilingReport -> ProfilingReport -> Bool
>= :: ProfilingReport -> ProfilingReport -> Bool
$cmax :: ProfilingReport -> ProfilingReport -> ProfilingReport
max :: ProfilingReport -> ProfilingReport -> ProfilingReport
$cmin :: ProfilingReport -> ProfilingReport -> ProfilingReport
min :: ProfilingReport -> ProfilingReport -> ProfilingReport
Ord, Int -> ProfilingReport -> ShowS
[ProfilingReport] -> ShowS
ProfilingReport -> String
(Int -> ProfilingReport -> ShowS)
-> (ProfilingReport -> String)
-> ([ProfilingReport] -> ShowS)
-> Show ProfilingReport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProfilingReport -> ShowS
showsPrec :: Int -> ProfilingReport -> ShowS
$cshow :: ProfilingReport -> String
show :: ProfilingReport -> String
$cshowList :: [ProfilingReport] -> ShowS
showList :: [ProfilingReport] -> ShowS
Show)

instance JSON.ToJSON ProfilingReport where
  toJSON :: ProfilingReport -> Value
toJSON (ProfilingReport [ProfilingEvent]
events Map Text Integer
memory) =
    [Pair] -> Value
JSON.object
      [ (Key
"events", [ProfilingEvent] -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON [ProfilingEvent]
events),
        (Key
"memory", [Pair] -> Value
JSON.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ ((Text, Integer) -> Pair) -> [(Text, Integer)] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Key) -> (Integer -> Value) -> (Text, Integer) -> Pair
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Text -> Key
JSON.fromText Integer -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON) ([(Text, Integer)] -> [Pair]) -> [(Text, Integer)] -> [Pair]
forall a b. (a -> b) -> a -> b
$ Map Text Integer -> [(Text, Integer)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text Integer
memory)
      ]

instance JSON.FromJSON ProfilingReport where
  parseJSON :: Value -> Parser ProfilingReport
parseJSON = String
-> (Object -> Parser ProfilingReport)
-> Value
-> Parser ProfilingReport
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"profiling-info" ((Object -> Parser ProfilingReport)
 -> Value -> Parser ProfilingReport)
-> (Object -> Parser ProfilingReport)
-> Value
-> Parser ProfilingReport
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    [ProfilingEvent] -> Map Text Integer -> ProfilingReport
ProfilingReport
      ([ProfilingEvent] -> Map Text Integer -> ProfilingReport)
-> Parser [ProfilingEvent]
-> Parser (Map Text Integer -> ProfilingReport)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [ProfilingEvent]
forall a. FromJSON a => Object -> Key -> Parser a
JSON..: Key
"events"
      Parser (Map Text Integer -> ProfilingReport)
-> Parser (Map Text Integer) -> Parser ProfilingReport
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Integer -> Map Text Integer
forall v. KeyMap v -> Map Text v
JSON.toMapText (KeyMap Integer -> Map Text Integer)
-> Parser (KeyMap Integer) -> Parser (Map Text Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (KeyMap Integer)
forall a. FromJSON a => Object -> Key -> Parser a
JSON..: Key
"memory")

-- | Read a profiling report from a bytestring containing JSON.
decodeProfilingReport :: LBS.ByteString -> Maybe ProfilingReport
decodeProfilingReport :: ByteString -> Maybe ProfilingReport
decodeProfilingReport = ByteString -> Maybe ProfilingReport
forall a. FromJSON a => ByteString -> Maybe a
JSON.decode

-- | Read a profiling report from a text containing JSON.
profilingReportFromText :: T.Text -> Maybe ProfilingReport
profilingReportFromText :: Text -> Maybe ProfilingReport
profilingReportFromText = ByteString -> Maybe ProfilingReport
forall a. FromJSON a => ByteString -> Maybe a
JSON.decode (ByteString -> Maybe ProfilingReport)
-> (Text -> ByteString) -> Text -> Maybe ProfilingReport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> (Text -> Builder) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
encodeUtf8Builder