module Platform.ReporterHelpers (toHashMap, srcString) where

import qualified Data.Aeson as Aeson
import qualified Data.Foldable as Foldable
import qualified Data.HashMap.Strict as HashMap
import qualified GHC.Stack as Stack
import qualified List
import qualified Text
import qualified Prelude

-- | Our span details are arbitrary JSON structures, but some of our reporters
-- require metadata as a flast list of key,value pairs.
--
-- Given a type that has the following JSON representation:
--
--     {
--       "treasure": {
--         "coords: { "x": 12, "y" 14 },
--         "worth": "Tons!"
--       }
--     }
--
-- This function will create a flat list of key,value pairs like this:
--
--     HashMap.fromList
--       [ ("treasure.coords.x", "12"   )
--       , ("treasure.coords.y", "14"   )
--       , ("treasure.worth"   , "Tons!")
--       ]
toHashMap :: Aeson.ToJSON a => a -> HashMap.HashMap Text Text
toHashMap :: a -> HashMap Text Text
toHashMap a
x =
  case a -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON a
x of
    Aeson.Object Object
dict ->
      (HashMap Text Text -> Text -> Value -> HashMap Text Text)
-> HashMap Text Text -> Object -> HashMap Text Text
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
HashMap.foldlWithKey'
        (\HashMap Text Text
acc Text
key Value
value -> HashMap Text Text
acc HashMap Text Text -> HashMap Text Text -> HashMap Text Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text -> Value -> HashMap Text Text
jsonAsText Text
key Value
value)
        HashMap Text Text
forall k v. HashMap k v
HashMap.empty
        Object
dict
    Value
val -> Text -> Value -> HashMap Text Text
jsonAsText Text
"value" Value
val

jsonAsText :: Text -> Aeson.Value -> HashMap.HashMap Text Text
jsonAsText :: Text -> Value -> HashMap Text Text
jsonAsText Text
key Value
val =
  case Value
val of
    Aeson.Object Object
dict ->
      (HashMap Text Text -> Text -> Value -> HashMap Text Text)
-> HashMap Text Text -> Object -> HashMap Text Text
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
HashMap.foldlWithKey'
        (\HashMap Text Text
acc Text
key2 Value
value -> HashMap Text Text
acc HashMap Text Text -> HashMap Text Text -> HashMap Text Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text -> Value -> HashMap Text Text
jsonAsText (Text
key Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"." Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key2) Value
value)
        HashMap Text Text
forall k v. HashMap k v
HashMap.empty
        Object
dict
    Aeson.Array Array
vals ->
      Array -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Array
vals
        [Value]
-> ([Value] -> List (HashMap Text Text))
-> List (HashMap Text Text)
forall a b. a -> (a -> b) -> b
|> (Int -> Value -> HashMap Text Text)
-> [Value] -> List (HashMap Text Text)
forall a b. (Int -> a -> b) -> List a -> List b
List.indexedMap (\Int
i Value
elem -> Text -> Value -> HashMap Text Text
jsonAsText (Text
key Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"." Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Text
Text.fromInt Int
i) Value
elem)
        List (HashMap Text Text)
-> (List (HashMap Text Text) -> HashMap Text Text)
-> HashMap Text Text
forall a b. a -> (a -> b) -> b
|> List (HashMap Text Text) -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [HashMap k v] -> HashMap k v
HashMap.unions
    Aeson.String Text
str -> Text -> Text -> HashMap Text Text
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Text
key Text
str
    Aeson.Number Scientific
n -> Text -> Text -> HashMap Text Text
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Text
key (List Char -> Text
Text.fromList (Scientific -> List Char
forall a. Show a => a -> List Char
Prelude.show Scientific
n))
    Aeson.Bool Bool
bool -> Text -> Text -> HashMap Text Text
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Text
key (List Char -> Text
Text.fromList (Bool -> List Char
forall a. Show a => a -> List Char
Prelude.show Bool
bool))
    Value
Aeson.Null -> HashMap Text Text
forall k v. HashMap k v
HashMap.empty

srcString :: Stack.SrcLoc -> Text
srcString :: SrcLoc -> Text
srcString SrcLoc
frame =
  List Char -> Text
Text.fromList (SrcLoc -> List Char
Stack.srcLocFile SrcLoc
frame)
    Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
":"
    Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Text
Text.fromInt (Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (SrcLoc -> Int
Stack.srcLocStartLine SrcLoc
frame))