-- | 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProfilingEvent -> ProfilingEvent -> Bool
$c/= :: ProfilingEvent -> ProfilingEvent -> Bool
== :: ProfilingEvent -> ProfilingEvent -> Bool
$c== :: ProfilingEvent -> ProfilingEvent -> Bool
Eq, Eq 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
min :: ProfilingEvent -> ProfilingEvent -> ProfilingEvent
$cmin :: ProfilingEvent -> ProfilingEvent -> ProfilingEvent
max :: ProfilingEvent -> ProfilingEvent -> ProfilingEvent
$cmax :: ProfilingEvent -> ProfilingEvent -> ProfilingEvent
>= :: ProfilingEvent -> ProfilingEvent -> Bool
$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
compare :: ProfilingEvent -> ProfilingEvent -> Ordering
$ccompare :: ProfilingEvent -> ProfilingEvent -> Ordering
Ord, Int -> ProfilingEvent -> ShowS
[ProfilingEvent] -> ShowS
ProfilingEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProfilingEvent] -> ShowS
$cshowList :: [ProfilingEvent] -> ShowS
show :: ProfilingEvent -> String
$cshow :: ProfilingEvent -> String
showsPrec :: Int -> ProfilingEvent -> ShowS
$cshowsPrec :: Int -> 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", forall a. ToJSON a => a -> Value
JSON.toJSON Text
name),
        (Key
"duration", forall a. ToJSON a => a -> Value
JSON.toJSON Double
duration),
        (Key
"description", forall a. ToJSON a => a -> Value
JSON.toJSON Text
description)
      ]

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

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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProfilingReport -> ProfilingReport -> Bool
$c/= :: ProfilingReport -> ProfilingReport -> Bool
== :: ProfilingReport -> ProfilingReport -> Bool
$c== :: ProfilingReport -> ProfilingReport -> Bool
Eq, Eq 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
min :: ProfilingReport -> ProfilingReport -> ProfilingReport
$cmin :: ProfilingReport -> ProfilingReport -> ProfilingReport
max :: ProfilingReport -> ProfilingReport -> ProfilingReport
$cmax :: ProfilingReport -> ProfilingReport -> ProfilingReport
>= :: ProfilingReport -> ProfilingReport -> Bool
$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
compare :: ProfilingReport -> ProfilingReport -> Ordering
$ccompare :: ProfilingReport -> ProfilingReport -> Ordering
Ord, Int -> ProfilingReport -> ShowS
[ProfilingReport] -> ShowS
ProfilingReport -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProfilingReport] -> ShowS
$cshowList :: [ProfilingReport] -> ShowS
show :: ProfilingReport -> String
$cshow :: ProfilingReport -> String
showsPrec :: Int -> ProfilingReport -> ShowS
$cshowsPrec :: Int -> 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", forall a. ToJSON a => a -> Value
JSON.toJSON [ProfilingEvent]
events),
        (Key
"memory", [Pair] -> Value
JSON.object forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Text -> Key
JSON.fromText forall a. ToJSON a => a -> Value
JSON.toJSON) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map Text Integer
memory)
      ]

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

decodeProfilingReport :: LBS.ByteString -> Maybe ProfilingReport
decodeProfilingReport :: ByteString -> Maybe ProfilingReport
decodeProfilingReport = forall a. FromJSON a => ByteString -> Maybe a
JSON.decode

profilingReportFromText :: T.Text -> Maybe ProfilingReport
profilingReportFromText :: Text -> Maybe ProfilingReport
profilingReportFromText = forall a. FromJSON a => ByteString -> Maybe a
JSON.decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
encodeUtf8Builder