{-# 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

-- | Print basic information about requests to stdout and make more detailed
-- information available to the log-explorer tool.
--
-- Example usage:
-- > handler <- Dev.handler
-- > Dev.report handler "request-id" span
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)

-- | Contextual information this reporter needs to do its work. You can create
-- one using 'handler'.
data Handler = Handler
  { Handler -> Timer
timer :: Timer.Timer,
    -- If we let each request log to stdout directly the result will be lots
    -- of unreadable interleaved output from requests that are handled
    -- concurrently. To prevent this we use an MVar as a lock.
    --
    -- After a request is done it can write it's log to the MVar. If the
    -- MVar already contains a log this operation will block until the MVar
    -- is empty. We have a logging thread running separately that takes logs
    -- from the MVar and prints them to stdout one at a time.
    Handler -> MVar Builder
writeLock :: MVar.MVar Builder.Builder,
    Handler -> Async ()
loggingThread :: Async.Async ()
  }

-- | Create a 'Handler'. Do this once when your application starts and reuse
-- the 'Handler' you get.
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}

-- | Clean up your handler after you're done with it. Call this before your
-- application shuts down.
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

-- | Waits for a log message to become available in the MVar, logs it, then
-- waits for the next one. This is intended to be ran on a separate thread.
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
        -- After a few seconds of inactivity, advertise for log-explorer.
        Int -> IO ()
Control.Concurrent.threadDelay Int
3_000_000 {- 3 seconds -}
        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 ()
    )