Internal.hs

{-# 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' _requestId span = do
  Platform.writeSpanToDevLog span
  MVar.putMVar (writeLock handler') (mkLog (timer handler') span)

mkLog :: Timer.Timer -> Platform.TracingSpan -> Builder.Builder
mkLog timer span =
  time timer span
    ++ " "
    ++ name span
    ++ " "
    ++ failed span

time :: Timer.Timer -> Platform.TracingSpan -> Builder.Builder
time timer span =
  Timer.toLocal timer (Platform.started span)
    |> Prelude.show
    |> Builder.fromString

name :: Platform.TracingSpan -> Builder.Builder
name span =
  Platform.details span
    |> Maybe.andThen
      ( Platform.renderTracingSpanDetails
          [ Platform.Renderer nameIncomingRequest
          ]
      )
    |> Maybe.withDefault (Builder.fromText (Platform.name span))

nameIncomingRequest :: HttpRequest.Incoming -> Builder.Builder
nameIncomingRequest (HttpRequest.Incoming details) =
  HttpRequest.endpoint details
    |> Maybe.withDefault "Incoming HTTP request"
    |> Builder.fromText

failed :: Platform.TracingSpan -> Builder.Builder
failed span =
  case Platform.succeeded span of
    Platform.Succeeded -> ""
    Platform.Failed -> "❌"
    Platform.FailedWith err ->
      "❌\n"
        ++ Builder.fromString (Exception.displayException err)

data Handler = Handler
  { 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.
    writeLock :: MVar.MVar Builder.Builder,
    loggingThread :: Async.Async ()
  }

-- | Create a 'Handler'. Do this once when your application starts and reuse
-- the 'Handler' you get.
handler :: Prelude.IO Handler
handler = do
  writeLock <- MVar.newEmptyMVar
  counter <- MVar.newMVar 0
  loggingThread <- Async.async (logLoop counter writeLock)
  timer <- Timer.mkTimer
  Prelude.pure Handler {timer, writeLock, loggingThread}

-- | Clean up your handler after you're done with it. Call this before your
-- application shuts down.
cleanup :: Handler -> Prelude.IO ()
cleanup = Async.cancel << 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 counter lock = do
  line <- MVar.takeMVar lock
  Builder.toLazyText line
    |> Data.Text.Lazy.toStrict
    |> Data.Text.IO.putStrLn
  ownCount <- MVar.modifyMVar counter (\n -> Prelude.pure (n + 1, n + 1))
  Async.concurrently_
    (logLoop counter lock)
    ( do
        -- After a few seconds of inactivity, advertise for log-explorer.
        Control.Concurrent.threadDelay 3_000_000 {- 3 seconds -}
        currentCount <- MVar.readMVar counter
        if ownCount == currentCount
          then Prelude.putStrLn "🕵️ Need more detail? Try running the `log-explorer` command!\n"
          else Prelude.pure ()
    )