{-# OPTIONS_GHC -fno-cse #-}

module Platform.DevLog
  ( writeSpanToDevLog,
  )
where

import qualified Control.Concurrent.MVar as MVar
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Lazy
import qualified Data.Time as Time
import NriPrelude
import qualified Platform.Internal
import qualified System.IO
import qualified System.IO.Unsafe
import qualified Prelude

-- | Write a tracing span to the development log, where it can be found by
-- `log-explorer` for closer inspection.
writeSpanToDevLog :: Platform.Internal.TracingSpan -> Prelude.IO ()
writeSpanToDevLog :: TracingSpan -> IO ()
writeSpanToDevLog TracingSpan
span = do
  UTCTime
now <- IO UTCTime
Time.getCurrentTime
  let logFile :: FilePath
logFile = FilePath
"/tmp/nri-prelude-logs"
  MVar () -> (() -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
MVar.withMVar MVar ()
writeLock ((() -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
<| \()
_ ->
    FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
System.IO.withFile
      FilePath
logFile
      IOMode
System.IO.AppendMode
      ( \Handle
handle -> do
          Handle -> ByteString -> IO ()
Data.ByteString.Lazy.hPut Handle
handle ((UTCTime, TracingSpan) -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (UTCTime
now, TracingSpan
span))
          Handle -> ByteString -> IO ()
Data.ByteString.Lazy.hPut Handle
handle ByteString
"\n"
      )

-- A lock used to ensure writing spans to the dev log are atomic, processes will
-- take turns to fully write their spans to the log to prevent interleaving.
{-# NOINLINE writeLock #-}
writeLock :: MVar.MVar ()
writeLock :: MVar ()
writeLock =
  () -> IO (MVar ())
forall a. a -> IO (MVar a)
MVar.newMVar ()
    IO (MVar ()) -> (IO (MVar ()) -> MVar ()) -> MVar ()
forall a b. a -> (a -> b) -> b
|> IO (MVar ()) -> MVar ()
forall a. IO a -> a
System.IO.Unsafe.unsafePerformIO