module Patrol.Type.TransactionSource where

import qualified Data.Aeson as Aeson

-- | <https://develop.sentry.dev/sdk/event-payloads/types/#transactionsource>
data TransactionSource
  = Component
  | Custom
  | Route
  | Task
  | Url
  | Unknown
  | View
  deriving (TransactionSource -> TransactionSource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransactionSource -> TransactionSource -> Bool
$c/= :: TransactionSource -> TransactionSource -> Bool
== :: TransactionSource -> TransactionSource -> Bool
$c== :: TransactionSource -> TransactionSource -> Bool
Eq, Int -> TransactionSource -> ShowS
[TransactionSource] -> ShowS
TransactionSource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransactionSource] -> ShowS
$cshowList :: [TransactionSource] -> ShowS
show :: TransactionSource -> String
$cshow :: TransactionSource -> String
showsPrec :: Int -> TransactionSource -> ShowS
$cshowsPrec :: Int -> TransactionSource -> ShowS
Show)

instance Aeson.ToJSON TransactionSource where
  toJSON :: TransactionSource -> Value
toJSON TransactionSource
transactionSource = forall a. ToJSON a => a -> Value
Aeson.toJSON forall a b. (a -> b) -> a -> b
$ case TransactionSource
transactionSource of
    TransactionSource
Component -> String
"component"
    TransactionSource
Custom -> String
"custom"
    TransactionSource
Route -> String
"route"
    TransactionSource
Task -> String
"task"
    TransactionSource
Url -> String
"url"
    TransactionSource
Unknown -> String
"unknown"
    TransactionSource
View -> String
"view"