{-# LANGUAGE NumericUnderscores #-}
module Reporter.Dev.Internal where
import qualified Control.Concurrent
import qualified Control.Concurrent.Async as Async
import qualified Control.Concurrent.MVar as MVar
import qualified Control.Exception.Safe as Exception
import qualified Data.Text.IO
import qualified Data.Text.Lazy
import qualified Data.Text.Lazy.Builder as Builder
import qualified Log.HttpRequest as HttpRequest
import qualified Platform
import qualified Platform.Timer as Timer
import qualified Prelude
report :: Handler -> Text -> Platform.TracingSpan -> Prelude.IO ()
report :: Handler -> Text -> TracingSpan -> IO ()
report Handler
handler' Text
_requestId TracingSpan
span = do
TracingSpan -> IO ()
Platform.writeSpanToDevLog TracingSpan
span
MVar Builder -> Builder -> IO ()
forall a. MVar a -> a -> IO ()
MVar.putMVar (Handler -> MVar Builder
writeLock Handler
handler') (Timer -> TracingSpan -> Builder
mkLog (Handler -> Timer
timer Handler
handler') TracingSpan
span)
mkLog :: Timer.Timer -> Platform.TracingSpan -> Builder.Builder
mkLog :: Timer -> TracingSpan -> Builder
mkLog Timer
timer TracingSpan
span =
Timer -> TracingSpan -> Builder
time Timer
timer TracingSpan
span
Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
" "
Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ TracingSpan -> Builder
name TracingSpan
span
Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
" "
Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ TracingSpan -> Builder
failed TracingSpan
span
time :: Timer.Timer -> Platform.TracingSpan -> Builder.Builder
time :: Timer -> TracingSpan -> Builder
time Timer
timer TracingSpan
span =
Timer -> MonotonicTime -> LocalTime
Timer.toLocal Timer
timer (TracingSpan -> MonotonicTime
Platform.started TracingSpan
span)
LocalTime -> (LocalTime -> String) -> String
forall a b. a -> (a -> b) -> b
|> LocalTime -> String
forall a. Show a => a -> String
Prelude.show
String -> (String -> Builder) -> Builder
forall a b. a -> (a -> b) -> b
|> String -> Builder
Builder.fromString
name :: Platform.TracingSpan -> Builder.Builder
name :: TracingSpan -> Builder
name TracingSpan
span =
TracingSpan -> Maybe SomeTracingSpanDetails
Platform.details TracingSpan
span
Maybe SomeTracingSpanDetails
-> (Maybe SomeTracingSpanDetails -> Maybe Builder) -> Maybe Builder
forall a b. a -> (a -> b) -> b
|> (SomeTracingSpanDetails -> Maybe Builder)
-> Maybe SomeTracingSpanDetails -> Maybe Builder
forall a b. (a -> Maybe b) -> Maybe a -> Maybe b
Maybe.andThen
( [Renderer Builder] -> SomeTracingSpanDetails -> Maybe Builder
forall a. [Renderer a] -> SomeTracingSpanDetails -> Maybe a
Platform.renderTracingSpanDetails
[ (Incoming -> Builder) -> Renderer Builder
forall s a. TracingSpanDetails s => (s -> a) -> Renderer a
Platform.Renderer Incoming -> Builder
nameIncomingRequest
]
)
Maybe Builder -> (Maybe Builder -> Builder) -> Builder
forall a b. a -> (a -> b) -> b
|> Builder -> Maybe Builder -> Builder
forall a. a -> Maybe a -> a
Maybe.withDefault (Text -> Builder
Builder.fromText (TracingSpan -> Text
Platform.name TracingSpan
span))
nameIncomingRequest :: HttpRequest.Incoming -> Builder.Builder
nameIncomingRequest :: Incoming -> Builder
nameIncomingRequest (HttpRequest.Incoming Details
details) =
Details -> Maybe Text
HttpRequest.endpoint Details
details
Maybe Text -> (Maybe Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
Maybe.withDefault Text
"Incoming HTTP request"
Text -> (Text -> Builder) -> Builder
forall a b. a -> (a -> b) -> b
|> Text -> Builder
Builder.fromText
failed :: Platform.TracingSpan -> Builder.Builder
failed :: TracingSpan -> Builder
failed TracingSpan
span =
case TracingSpan -> Succeeded
Platform.succeeded TracingSpan
span of
Succeeded
Platform.Succeeded -> Builder
""
Succeeded
Platform.Failed -> Builder
"❌"
Platform.FailedWith SomeException
err ->
Builder
"❌\n"
Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ String -> Builder
Builder.fromString (SomeException -> String
forall e. Exception e => e -> String
Exception.displayException SomeException
err)
data Handler = Handler
{ Handler -> Timer
timer :: Timer.Timer,
Handler -> MVar Builder
writeLock :: MVar.MVar Builder.Builder,
Handler -> Async ()
loggingThread :: Async.Async ()
}
handler :: Prelude.IO Handler
handler :: IO Handler
handler = do
MVar Builder
writeLock <- IO (MVar Builder)
forall a. IO (MVar a)
MVar.newEmptyMVar
MVar Int
counter <- Int -> IO (MVar Int)
forall a. a -> IO (MVar a)
MVar.newMVar Int
0
Async ()
loggingThread <- IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
Async.async (MVar Int -> MVar Builder -> IO ()
logLoop MVar Int
counter MVar Builder
writeLock)
Timer
timer <- IO Timer
Timer.mkTimer
Handler -> IO Handler
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure Handler :: Timer -> MVar Builder -> Async () -> Handler
Handler {Timer
timer :: Timer
timer :: Timer
timer, MVar Builder
writeLock :: MVar Builder
writeLock :: MVar Builder
writeLock, Async ()
loggingThread :: Async ()
loggingThread :: Async ()
loggingThread}
cleanup :: Handler -> Prelude.IO ()
cleanup :: Handler -> IO ()
cleanup = Async () -> IO ()
forall a. Async a -> IO ()
Async.cancel (Async () -> IO ()) -> (Handler -> Async ()) -> Handler -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Handler -> Async ()
loggingThread
logLoop :: MVar.MVar Int -> MVar.MVar Builder.Builder -> Prelude.IO ()
logLoop :: MVar Int -> MVar Builder -> IO ()
logLoop MVar Int
counter MVar Builder
lock = do
Builder
line <- MVar Builder -> IO Builder
forall a. MVar a -> IO a
MVar.takeMVar MVar Builder
lock
Builder -> Text
Builder.toLazyText Builder
line
Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> Text -> Text
Data.Text.Lazy.toStrict
Text -> (Text -> IO ()) -> IO ()
forall a b. a -> (a -> b) -> b
|> Text -> IO ()
Data.Text.IO.putStrLn
Int
ownCount <- MVar Int -> (Int -> IO (Int, Int)) -> IO Int
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
MVar.modifyMVar MVar Int
counter (\Int
n -> (Int, Int) -> IO (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Int
n Int -> Int -> Int
forall number. Num number => number -> number -> number
+ Int
1, Int
n Int -> Int -> Int
forall number. Num number => number -> number -> number
+ Int
1))
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO ()
Async.concurrently_
(MVar Int -> MVar Builder -> IO ()
logLoop MVar Int
counter MVar Builder
lock)
( do
Int -> IO ()
Control.Concurrent.threadDelay Int
3_000_000
Int
currentCount <- MVar Int -> IO Int
forall a. MVar a -> IO a
MVar.readMVar MVar Int
counter
if Int
ownCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
currentCount
then String -> IO ()
Prelude.putStrLn String
"🕵️ Need more detail? Try running the `log-explorer` command!\n"
else () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure ()
)