{-# 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 message contexts = Stack.withFrozenCallStack log message True contexts
userIsAnnoyed :: Stack.HasCallStack => Text -> Text -> [Context] -> Task e ()
userIsAnnoyed message advisory contexts =
let triage = TriageInfo UserAnnoyed advisory
in Stack.withFrozenCallStack
log
message
False
(Context "triage" triage : contexts)
userIsConfused :: Stack.HasCallStack => Text -> Text -> [Context] -> Task e ()
userIsConfused message advisory contexts =
let triage = TriageInfo UserConfused advisory
in Stack.withFrozenCallStack
log
message
False
(Context "triage" triage : contexts)
userIsPained :: Stack.HasCallStack => Text -> Text -> [Context] -> Task e ()
userIsPained message advisory contexts =
let triage = TriageInfo UserInPain advisory
in Stack.withFrozenCallStack
log
message
False
(Context "triage" triage : contexts)
userIsBlocked :: Stack.HasCallStack => Text -> Text -> [Context] -> Task e ()
userIsBlocked message advisory contexts =
let triage = TriageInfo UserBlocked advisory
in Stack.withFrozenCallStack
log
message
False
(Context "triage" triage : contexts)
withContext ::
Stack.HasCallStack =>
Text ->
[Context] ->
Task e b ->
Task e b
withContext name contexts task =
Stack.withFrozenCallStack
Internal.tracingSpan
name
( Platform.finally
task
(Platform.setTracingSpanDetails (LogContexts contexts))
)
context :: (Aeson.ToJSON a) => Text -> a -> Context
context = Context
data Context where
Context :: Aeson.ToJSON a => Text -> a -> Context
newtype LogContexts
= LogContexts [Context]
instance Aeson.ToJSON LogContexts where
toJSON (LogContexts contexts) =
contexts
|> map (\(Context key val) -> key .= val)
|> Aeson.object
toEncoding (LogContexts contexts) =
contexts
|> Prelude.foldMap (\(Context key val) -> key .= val)
|> Aeson.pairs
instance Internal.TracingSpanDetails LogContexts
mkSecret :: a -> Secret a
mkSecret = Secret
unSecret :: Secret a -> a
unSecret (Secret x) = x
newtype Secret a
= Secret a
deriving (Prelude.Eq, Prelude.Functor)
instance Prelude.Applicative Secret where
Secret f <*> Secret x = Secret (f x)
pure = Secret
instance Show (Secret a) where
showsPrec p _ =
Text.Show.showParen (p > 10) (Text.Show.showString "Secret \"*****\"")
instance Aeson.ToJSON (Secret a) where
toJSON _ = Aeson.String "Secret *****"
data TriageInfo
= TriageInfo
{ impact :: Impact,
advisory :: Text
}
deriving (Generic)
instance Aeson.ToJSON TriageInfo
data Impact
= UserAnnoyed
| UserConfused
| UserInPain
| UserBlocked
deriving (Show)
instance Aeson.ToJSON Impact where
toJSON = Aeson.toJSON << impactToText
toEncoding = Aeson.toEncoding << impactToText
impactToText :: Impact -> Text
impactToText kind =
case kind of
UserAnnoyed -> "This is causing inconveniences to users but they will be able to achieve want they want."
UserBlocked -> "User is blocked from performing an action."
UserConfused -> "The UI did something unexpected and it's unclear why."
UserInPain -> "This is causing pain to users and workaround is not obvious."
log :: Stack.HasCallStack => Text -> Bool -> [Context] -> Task e ()
log msg succeeded contexts =
Internal.tracingSpan msg <| do
Platform.setTracingSpanDetails (LogContexts contexts)
if succeeded
then Task.succeed ()
else Platform.markTracingSpanFailed