{-# 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 GHC.Generics (Generic)
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
(LogContexts -> Task e ()
forall d e. TracingSpanDetails d => d -> Task e ()
Platform.setTracingSpanDetails ([Context] -> LogContexts
LogContexts [Context]
contexts))
)
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