{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Hermod.ReCon.Trace.Event where

import           Cardano.Logging.Types.TraceMessage (TraceMessage (..))
import           Hermod.ReCon.LTL.Formula
import           Hermod.ReCon.Trace.Feed (TemporalEvent (..))

import           Data.Aeson (Object, Value (..))
import           Data.Aeson.Key (toText)
import qualified Data.Aeson.KeyMap as KeyMap
import           Data.List (find)
import qualified Data.Map as Map
import           Data.Map.Strict (Map)
import           Data.Maybe (isJust)
import           Data.Text (Text, unpack)

class Extractable a where
  extract :: Value -> Maybe a

instance Extractable IntValue where
  extract :: Value -> Maybe IntValue
extract (Number Scientific
n) = IntValue -> Maybe IntValue
forall a. a -> Maybe a
Just (Scientific -> IntValue
forall b. Integral b => Scientific -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate Scientific
n)
  extract Value
_          = Maybe IntValue
forall a. Maybe a
Nothing

instance Extractable Text where
  extract :: Value -> Maybe Text
extract (String Text
s) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s
  extract Value
_          = Maybe Text
forall a. Maybe a
Nothing

extractProps :: Extractable a => Object -> Map VariableIdentifier a
extractProps :: forall a. Extractable a => Object -> Map Text a
extractProps = Text -> Map Text a -> Map Text a
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Text
"kind" (Map Text a -> Map Text a)
-> (Object -> Map Text a) -> Object -> Map Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Object -> Map Text a
forall {a}. Extractable a => Text -> Object -> Map Text a
go Text
""
  where
    go :: Text -> Object -> Map Text a
go Text
prefix = (Map Text a -> Text -> Value -> Map Text a)
-> Map Text a -> Map Text Value -> Map Text a
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (\Map Text a
acc Text
k Value
v ->
        let key :: Text
key = Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k
        in case Value
v of
          Object Object
nested -> Map Text a -> Map Text a -> Map Text a
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Text a
acc (Text -> Object -> Map Text a
go (Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".") Object
nested)
          Value
_             -> Map Text a -> (a -> Map Text a) -> Maybe a -> Map Text a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map Text a
acc (\a
val -> Text -> a -> Map Text a -> Map Text a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
key a
val Map Text a
acc) (Value -> Maybe a
forall a. Extractable a => Value -> Maybe a
extract Value
v)
      ) Map Text a
forall k a. Map k a
Map.empty (Map Text Value -> Map Text a)
-> (Object -> Map Text Value) -> Object -> Map Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key -> Text) -> Map Key Value -> Map Text Value
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic Key -> Text
toText (Map Key Value -> Map Text Value)
-> (Object -> Map Key Value) -> Object -> Map Text Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Map Key Value
forall v. KeyMap v -> Map Key v
KeyMap.toMap

instance Event TemporalEvent Text where
  ofTy :: TemporalEvent -> Text -> Bool
ofTy (TemporalEvent Word64
_ [TraceMessage]
msgs) Text
c = Maybe TraceMessage -> Bool
forall a. Maybe a -> Bool
isJust (Maybe TraceMessage -> Bool) -> Maybe TraceMessage -> Bool
forall a b. (a -> b) -> a -> b
$ (TraceMessage -> Bool) -> [TraceMessage] -> Maybe TraceMessage
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\TraceMessage
msg -> TraceMessage
msg.tmsgNS Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
c) [TraceMessage]
msgs
  intProps :: TemporalEvent -> Text -> Map Text IntValue
intProps (TemporalEvent Word64
_ [TraceMessage]
msgs) Text
c =
    case (TraceMessage -> Bool) -> [TraceMessage] -> Maybe TraceMessage
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\TraceMessage
msg -> TraceMessage
msg.tmsgNS Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
c) [TraceMessage]
msgs of
      Just TraceMessage
x  -> Object -> Map Text IntValue
forall a. Extractable a => Object -> Map Text a
extractProps TraceMessage
x.tmsgData
      Maybe TraceMessage
Nothing -> [Char] -> Map Text IntValue
forall a. HasCallStack => [Char] -> a
error ([Char]
"Not an event of type " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
unpack Text
c)
  textProps :: TemporalEvent -> Text -> Map Text Text
textProps (TemporalEvent Word64
_ [TraceMessage]
msgs) Text
c =
    case (TraceMessage -> Bool) -> [TraceMessage] -> Maybe TraceMessage
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\TraceMessage
msg -> TraceMessage
msg.tmsgNS Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
c) [TraceMessage]
msgs of
      Just TraceMessage
x  -> Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"host"   TraceMessage
x.tmsgHost   (Map Text Text -> Map Text Text) -> Map Text Text -> Map Text Text
forall a b. (a -> b) -> a -> b
$
                   Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"thread" TraceMessage
x.tmsgThread (Map Text Text -> Map Text Text) -> Map Text Text -> Map Text Text
forall a b. (a -> b) -> a -> b
$
                     Object -> Map Text Text
forall a. Extractable a => Object -> Map Text a
extractProps TraceMessage
x.tmsgData
      Maybe TraceMessage
Nothing -> [Char] -> Map Text Text
forall a. HasCallStack => [Char] -> a
error ([Char]
"Not an event of type " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
unpack Text
c)
  beg :: TemporalEvent -> Word64
beg (TemporalEvent Word64
t [TraceMessage]
_) = Word64
t