{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE GADTs #-}
module Log
(
info,
userIsAnnoyed,
userIsConfused,
userIsPained,
userIsBlocked,
withContext,
context,
Secret,
mkSecret,
unSecret,
Context (..),
LogContexts (..),
TriageInfo (..),
Impact (..),
)
where
import Data.Aeson ((.=))
import qualified Data.Aeson as Aeson
import qualified GHC.Stack as Stack
import NriPrelude
import qualified Platform
import qualified Platform.Internal as Internal
import qualified Task
import qualified Text.Show
import qualified Prelude
info :: Stack.HasCallStack => Text -> [Context] -> Task e ()
info :: Text -> [Context] -> Task e ()
info Text
message [Context]
contexts = (HasCallStack => Text -> ReportStatus -> [Context] -> Task e ())
-> Text -> ReportStatus -> [Context] -> Task e ()
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack => Text -> ReportStatus -> [Context] -> Task e ()
forall e.
HasCallStack =>
Text -> ReportStatus -> [Context] -> Task e ()
log Text
message ReportStatus
ReportAsSucceeded [Context]
contexts
userIsAnnoyed :: Stack.HasCallStack => Text -> Text -> [Context] -> Task e ()
userIsAnnoyed :: Text -> Text -> [Context] -> Task e ()
userIsAnnoyed Text
message Text
advisory [Context]
contexts =
let triage :: TriageInfo
triage = Impact -> Text -> TriageInfo
TriageInfo Impact
UserAnnoyed Text
advisory
in (HasCallStack => Text -> ReportStatus -> [Context] -> Task e ())
-> Text -> ReportStatus -> [Context] -> Task e ()
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack
HasCallStack => Text -> ReportStatus -> [Context] -> Task e ()
forall e.
HasCallStack =>
Text -> ReportStatus -> [Context] -> Task e ()
log
Text
message
ReportStatus
ReportAsFailed
(Text -> TriageInfo -> Context
forall a. ToJSON a => Text -> a -> Context
Context Text
"triage" TriageInfo
triage Context -> [Context] -> [Context]
forall a. a -> [a] -> [a]
: [Context]
contexts)
userIsConfused :: Stack.HasCallStack => Text -> Text -> [Context] -> Task e ()
userIsConfused :: Text -> Text -> [Context] -> Task e ()
userIsConfused Text
message Text
advisory [Context]
contexts =
let triage :: TriageInfo
triage = Impact -> Text -> TriageInfo
TriageInfo Impact
UserConfused Text
advisory
in (HasCallStack => Text -> ReportStatus -> [Context] -> Task e ())
-> Text -> ReportStatus -> [Context] -> Task e ()
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack
HasCallStack => Text -> ReportStatus -> [Context] -> Task e ()
forall e.
HasCallStack =>
Text -> ReportStatus -> [Context] -> Task e ()
log
Text
message
ReportStatus
ReportAsFailed
(Text -> TriageInfo -> Context
forall a. ToJSON a => Text -> a -> Context
Context Text
"triage" TriageInfo
triage Context -> [Context] -> [Context]
forall a. a -> [a] -> [a]
: [Context]
contexts)
userIsPained :: Stack.HasCallStack => Text -> Text -> [Context] -> Task e ()
userIsPained :: Text -> Text -> [Context] -> Task e ()
userIsPained Text
message Text
advisory [Context]
contexts =
let triage :: TriageInfo
triage = Impact -> Text -> TriageInfo
TriageInfo Impact
UserInPain Text
advisory
in (HasCallStack => Text -> ReportStatus -> [Context] -> Task e ())
-> Text -> ReportStatus -> [Context] -> Task e ()
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack
HasCallStack => Text -> ReportStatus -> [Context] -> Task e ()
forall e.
HasCallStack =>
Text -> ReportStatus -> [Context] -> Task e ()
log
Text
message
ReportStatus
ReportAsFailed
(Text -> TriageInfo -> Context
forall a. ToJSON a => Text -> a -> Context
Context Text
"triage" TriageInfo
triage Context -> [Context] -> [Context]
forall a. a -> [a] -> [a]
: [Context]
contexts)
userIsBlocked :: Stack.HasCallStack => Text -> Text -> [Context] -> Task e ()
userIsBlocked :: Text -> Text -> [Context] -> Task e ()
userIsBlocked Text
message Text
advisory [Context]
contexts =
let triage :: TriageInfo
triage = Impact -> Text -> TriageInfo
TriageInfo Impact
UserBlocked Text
advisory
in (HasCallStack => Text -> ReportStatus -> [Context] -> Task e ())
-> Text -> ReportStatus -> [Context] -> Task e ()
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack
HasCallStack => Text -> ReportStatus -> [Context] -> Task e ()
forall e.
HasCallStack =>
Text -> ReportStatus -> [Context] -> Task e ()
log
Text
message
ReportStatus
ReportAsFailed
(Text -> TriageInfo -> Context
forall a. ToJSON a => Text -> a -> Context
Context Text
"triage" TriageInfo
triage Context -> [Context] -> [Context]
forall a. a -> [a] -> [a]
: [Context]
contexts)
withContext ::
Stack.HasCallStack =>
Text ->
[Context] ->
Task e b ->
Task e b
withContext :: Text -> [Context] -> Task e b -> Task e b
withContext Text
name [Context]
contexts Task e b
task =
(HasCallStack => Text -> Task e b -> Task e b)
-> Text -> Task e b -> Task e b
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack
HasCallStack => Text -> Task e b -> Task e b
forall e a. HasCallStack => Text -> Task e a -> Task e a
Internal.tracingSpan
Text
name
( Task e b -> Task e () -> Task e b
forall e a b. Task e a -> Task e b -> Task e a
Platform.finally
Task e b
task
( do
LogContexts -> Task e ()
forall d e. TracingSpanDetails d => d -> Task e ()
Platform.setTracingSpanDetails ([Context] -> LogContexts
LogContexts [Context]
contexts)
Text -> Task e ()
forall e. Text -> Task e ()
Platform.setTracingSpanSummary Text
name
)
)
context :: (Aeson.ToJSON a) => Text -> a -> Context
context :: Text -> a -> Context
context = Text -> a -> Context
forall a. ToJSON a => Text -> a -> Context
Context
data Context where
Context :: Aeson.ToJSON a => Text -> a -> Context
newtype LogContexts
= LogContexts [Context]
instance Aeson.ToJSON LogContexts where
toJSON :: LogContexts -> Value
toJSON (LogContexts [Context]
contexts) =
[Context]
contexts
[Context] -> ([Context] -> [Pair]) -> [Pair]
forall a b. a -> (a -> b) -> b
|> (Context -> Pair) -> [Context] -> [Pair]
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (\(Context Text
key a
val) -> Text
key Text -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
val)
[Pair] -> ([Pair] -> Value) -> Value
forall a b. a -> (a -> b) -> b
|> [Pair] -> Value
Aeson.object
toEncoding :: LogContexts -> Encoding
toEncoding (LogContexts [Context]
contexts) =
[Context]
contexts
[Context] -> ([Context] -> Series) -> Series
forall a b. a -> (a -> b) -> b
|> (Context -> Series) -> [Context] -> Series
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Prelude.foldMap (\(Context Text
key a
val) -> Text
key Text -> a -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
val)
Series -> (Series -> Encoding) -> Encoding
forall a b. a -> (a -> b) -> b
|> Series -> Encoding
Aeson.pairs
instance Internal.TracingSpanDetails LogContexts
mkSecret :: a -> Secret a
mkSecret :: a -> Secret a
mkSecret = a -> Secret a
forall a. a -> Secret a
Secret
unSecret :: Secret a -> a
unSecret :: Secret a -> a
unSecret (Secret a
x) = a
x
newtype Secret a
= Secret a
deriving (Secret a -> Secret a -> Bool
(Secret a -> Secret a -> Bool)
-> (Secret a -> Secret a -> Bool) -> Eq (Secret a)
forall a. Eq a => Secret a -> Secret a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Secret a -> Secret a -> Bool
$c/= :: forall a. Eq a => Secret a -> Secret a -> Bool
== :: Secret a -> Secret a -> Bool
$c== :: forall a. Eq a => Secret a -> Secret a -> Bool
Prelude.Eq, a -> Secret b -> Secret a
(a -> b) -> Secret a -> Secret b
(forall a b. (a -> b) -> Secret a -> Secret b)
-> (forall a b. a -> Secret b -> Secret a) -> Functor Secret
forall a b. a -> Secret b -> Secret a
forall a b. (a -> b) -> Secret a -> Secret b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Secret b -> Secret a
$c<$ :: forall a b. a -> Secret b -> Secret a
fmap :: (a -> b) -> Secret a -> Secret b
$cfmap :: forall a b. (a -> b) -> Secret a -> Secret b
Prelude.Functor)
instance Prelude.Applicative Secret where
Secret a -> b
f <*> :: Secret (a -> b) -> Secret a -> Secret b
<*> Secret a
x = b -> Secret b
forall a. a -> Secret a
Secret (a -> b
f a
x)
pure :: a -> Secret a
pure = a -> Secret a
forall a. a -> Secret a
Secret
instance Show (Secret a) where
showsPrec :: Int -> Secret a -> ShowS
showsPrec Int
p Secret a
_ =
Bool -> ShowS -> ShowS
Text.Show.showParen (Int
p Int -> Int -> Bool
forall comparable.
Ord comparable =>
comparable -> comparable -> Bool
> Int
10) (String -> ShowS
Text.Show.showString String
"Secret \"*****\"")
instance Aeson.ToJSON (Secret a) where
toJSON :: Secret a -> Value
toJSON Secret a
_ = Text -> Value
Aeson.String Text
"Secret *****"
data TriageInfo = TriageInfo
{ TriageInfo -> Impact
impact :: Impact,
TriageInfo -> Text
advisory :: Text
}
deriving ((forall x. TriageInfo -> Rep TriageInfo x)
-> (forall x. Rep TriageInfo x -> TriageInfo) -> Generic TriageInfo
forall x. Rep TriageInfo x -> TriageInfo
forall x. TriageInfo -> Rep TriageInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TriageInfo x -> TriageInfo
$cfrom :: forall x. TriageInfo -> Rep TriageInfo x
Generic)
instance Aeson.ToJSON TriageInfo
data Impact
= UserAnnoyed
| UserConfused
| UserInPain
| UserBlocked
deriving (Int -> Impact -> ShowS
[Impact] -> ShowS
Impact -> String
(Int -> Impact -> ShowS)
-> (Impact -> String) -> ([Impact] -> ShowS) -> Show Impact
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Impact] -> ShowS
$cshowList :: [Impact] -> ShowS
show :: Impact -> String
$cshow :: Impact -> String
showsPrec :: Int -> Impact -> ShowS
$cshowsPrec :: Int -> Impact -> ShowS
Show)
instance Aeson.ToJSON Impact where
toJSON :: Impact -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (Text -> Value) -> (Impact -> Text) -> Impact -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Impact -> Text
impactToText
toEncoding :: Impact -> Encoding
toEncoding = Text -> Encoding
forall a. ToJSON a => a -> Encoding
Aeson.toEncoding (Text -> Encoding) -> (Impact -> Text) -> Impact -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Impact -> Text
impactToText
impactToText :: Impact -> Text
impactToText :: Impact -> Text
impactToText Impact
kind =
case Impact
kind of
Impact
UserAnnoyed -> Text
"This is causing inconveniences to users but they will be able to achieve want they want."
Impact
UserBlocked -> Text
"User is blocked from performing an action."
Impact
UserConfused -> Text
"The UI did something unexpected and it's unclear why."
Impact
UserInPain -> Text
"This is causing pain to users and workaround is not obvious."
data ReportStatus = ReportAsFailed | ReportAsSucceeded
log :: Stack.HasCallStack => Text -> ReportStatus -> [Context] -> Task e ()
log :: Text -> ReportStatus -> [Context] -> Task e ()
log Text
msg ReportStatus
reportStatus [Context]
contexts =
Text -> Task e () -> Task e ()
forall e a. HasCallStack => Text -> Task e a -> Task e a
Internal.tracingSpan Text
msg (Task e () -> Task e ()) -> Task e () -> Task e ()
forall a b. (a -> b) -> a -> b
<| do
LogContexts -> Task e ()
forall d e. TracingSpanDetails d => d -> Task e ()
Platform.setTracingSpanDetails ([Context] -> LogContexts
LogContexts [Context]
contexts)
case ReportStatus
reportStatus of
ReportStatus
ReportAsSucceeded -> () -> Task e ()
forall a x. a -> Task x a
Task.succeed ()
ReportStatus
ReportAsFailed -> Task e ()
forall e. Task e ()
Platform.markTracingSpanFailed