-- | This module is for running applications we build using this library, and
-- for integrating external Haskell libraries into our code. You normally
-- shouldn't need to use this module, unless you're building a library or
-- creating a wrapper for an existing Haskell library.
module Platform
  ( -- * Turning a @IO@ type into a @Task@.
    DoAnythingHandler,
    doAnythingHandler,
    doAnything,

    -- * Working with the log handler
    Internal.LogHandler,
    logHandler,
    requestId,
    silentHandler,

    -- * Creating custom tracingSpans in libraries
    Internal.tracingSpan,
    Internal.tracingSpanIO,
    Internal.rootTracingSpanIO,
    Internal.setTracingSpanDetails,
    Internal.setTracingSpanDetailsIO,
    Internal.setTracingSpanSummary,
    Internal.setTracingSpanSummaryIO,
    Internal.markTracingSpanFailed,
    Internal.markTracingSpanFailedIO,

    -- * Interpreting tracingSpans for reporting to monitoring platforms
    Internal.TracingSpan,
    Internal.emptyTracingSpan,
    Internal.name,
    Internal.started,
    Internal.finished,
    Internal.frame,
    Internal.details,
    Internal.summary,
    Internal.succeeded,
    Internal.allocated,
    Internal.children,
    Internal.Succeeded (Succeeded, Failed, FailedWith),
    Internal.TracingSpanDetails (toTracingSpanDetails, fromTracingSpanDetails),
    Internal.SomeTracingSpanDetails,
    Internal.Renderer (Renderer),
    Internal.renderTracingSpanDetails,
    Internal.MonotonicTime,
    Internal.inMicroseconds,

    -- * Reporting spans to development tooling
    Platform.DevLog.writeSpanToDevLog,

    -- * Ensuring cleanup logic gets ran in case of exceptions.
    bracketWithError,
    finally,

    -- * Exception throwing, in rare cases we need it.
    unsafeThrowException,
  )
where

import Basics
import qualified Control.Exception.Safe as Exception
import qualified Control.Monad.Catch as Catch
import qualified Data.Text
import qualified GHC.Stack as Stack
import NriPrelude
import qualified Platform.DevLog
import qualified Platform.DoAnything as DoAnything
import qualified Platform.Internal as Internal
import qualified Task
import Prelude (IO, pure)

-- | A value of this type allows you to turn an @IO@ type into a @Task@ using the
-- @doAnything@ function.
--
-- The intended use for this is creating other handlers for running specific
-- types of effects. Suppose you're creating a library for making queries to
-- a database. You might create a @Handler@ type for it like this:
--
-- > data Handler = Handler
-- >    { doAnything :: DoAnythingHandler
-- >    , host :: Text
-- >    , port :: Text
-- >    }
--
-- You create this handler in the root of your application and then pass it to
-- wherever you need to perform database requests. Using the @DoAnythingHandler@
-- available to it your library can perform the query, then wrap the resulting
-- @IO@ up in a @Task@.
type DoAnythingHandler = DoAnything.Handler

-- | Get a key that allows you to run arbitrary IO in a @Task@. This key you can
-- then pass to @doAnything@. See the documentation for @DoAnythingHandler@.
doAnythingHandler :: IO DoAnything.Handler
doAnythingHandler :: IO Handler
doAnythingHandler = Handler -> IO Handler
forall (f :: * -> *) a. Applicative f => a -> f a
pure Handler
DoAnything.Handler

-- | Allow running arbitrary IO in @Task@, but only if you have a license for it.
doAnything :: DoAnything.Handler -> IO (Result e a) -> Task e a
doAnything :: Handler -> IO (Result e a) -> Task e a
doAnything Handler
_ IO (Result e a)
io = (LogHandler -> IO (Result e a)) -> Task e a
forall x a. (LogHandler -> IO (Result x a)) -> Task x a
Internal.Task (\LogHandler
_ -> IO (Result e a)
io)

-- | @bracket@ allows us to acquire a resource (the first argument), use it (the
-- third argument), and release it afterward (the second argument). Critically,
-- the @release@ phase always runs, even if the use phase fails with an error.
--
-- @bracket@ is defined in the @exceptions@ package for all types
-- implementing the @MonadMask@ type class. We could acquire it for @Task@ by
-- deriving @MonadMask@ for it, but this would require us to implement super
-- classes @MonadThrow@ and @MonadCatch@ for @Task@ as well.
--
-- We don't want to implement @MonadThrow@ for @Task@ because it would allow us
-- to throw exceptions directly in the @IO@ monad hidden in @Task@. These types
-- of exceptions disappear from the types: @IO@ does not have a type parameter
-- indicating possible errors. We want to ensure our own errors end up in the
-- error argument of the @Task@ type, so we don't implement @MonadThrow@.
--
-- The implementation below is mostly taken from the implementation of
-- @generalBracket@ for @ExceptT e m a@ in the @Control.Monad.Catch@ module.
bracketWithError ::
  Task e a ->
  (Internal.Succeeded -> a -> Task e c) ->
  (a -> Task e b) ->
  Task e b
bracketWithError :: Task e a
-> (Succeeded -> a -> Task e c) -> (a -> Task e b) -> Task e b
bracketWithError (Internal.Task LogHandler -> IO (Result e a)
acquire) Succeeded -> a -> Task e c
release a -> Task e b
use =
  (LogHandler -> IO (Result e b)) -> Task e b
forall x a. (LogHandler -> IO (Result x a)) -> Task x a
Internal.Task ((LogHandler -> IO (Result e b)) -> Task e b)
-> (LogHandler -> IO (Result e b)) -> Task e b
forall a b. (a -> b) -> a -> b
<| \LogHandler
log -> do
    (Result e b
eb, Result e c
ec) <-
      IO (Result e a)
-> (Result e a -> ExitCase (Result e b) -> IO (Result e c))
-> (Result e a -> IO (Result e b))
-> IO (Result e b, Result e c)
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
Exception.generalBracket
        (LogHandler -> IO (Result e a)
acquire LogHandler
log)
        ( \Result e a
eresource ExitCase (Result e b)
exitCase ->
            case Result e a
eresource of
              Err e
err -> Result e c -> IO (Result e c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (e -> Result e c
forall error value. error -> Result error value
Err e
err) -- nothing to release, acquire didn't succeed
              Ok a
resource ->
                case ExitCase (Result e b)
exitCase of
                  Catch.ExitCaseSuccess (Ok b
_) -> Task e c -> LogHandler -> IO (Result e c)
forall x a. Task x a -> LogHandler -> IO (Result x a)
Internal._run (Succeeded -> a -> Task e c
release Succeeded
Internal.Succeeded a
resource) LogHandler
log
                  ExitCase (Result e b)
_ -> Task e c -> LogHandler -> IO (Result e c)
forall x a. Task x a -> LogHandler -> IO (Result x a)
Internal._run (Succeeded -> a -> Task e c
release Succeeded
Internal.Failed a
resource) LogHandler
log
        )
        ( \Result e a
result ->
            case Result e a
result of
              Err e
err -> Result e b -> IO (Result e b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (e -> Result e b
forall error value. error -> Result error value
Err e
err)
              Ok a
x -> Task e b -> LogHandler -> IO (Result e b)
forall x a. Task x a -> LogHandler -> IO (Result x a)
Internal._run (a -> Task e b
use a
x) LogHandler
log
        )
    Result e b -> IO (Result e b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result e b -> IO (Result e b)) -> Result e b -> IO (Result e b)
forall a b. (a -> b) -> a -> b
<| do
      -- The order in which we perform those two 'Either' effects determines
      -- which error will win if they are both 'Left's. We want the error from
      -- 'release' to win.
      c
_ <- Result e c
ec
      Result e b
eb

-- | Ensure some cleanup logic always run, regardless of whether the task it
-- runs after failed with an exception.
--
--     finally
--       doSomeWork
--       (Log.info "Finished doing work." [])
finally :: Task e a -> Task e b -> Task e a
finally :: Task e a -> Task e b -> Task e a
finally Task e a
run Task e b
cleanup =
  Task e ()
-> (Succeeded -> () -> Task e b) -> (() -> Task e a) -> Task e a
forall e a c b.
Task e a
-> (Succeeded -> a -> Task e c) -> (a -> Task e b) -> Task e b
bracketWithError
    (() -> Task e ()
forall a x. a -> Task x a
Task.succeed ())
    (\Succeeded
_ ()
_ -> Task e b
cleanup)
    (\()
_ -> Task e a
run)

-- |
-- Access the log handler in a task.
logHandler :: Task e Internal.LogHandler
logHandler :: Task e LogHandler
logHandler = (LogHandler -> IO (Result e LogHandler)) -> Task e LogHandler
forall x a. (LogHandler -> IO (Result x a)) -> Task x a
Internal.Task (Result e LogHandler -> IO (Result e LogHandler)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result e LogHandler -> IO (Result e LogHandler))
-> (LogHandler -> Result e LogHandler)
-> LogHandler
-> IO (Result e LogHandler)
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< LogHandler -> Result e LogHandler
forall error value. value -> Result error value
Ok)

-- | Get the ID of the current request.
requestId :: Task e Text
requestId :: Task e Text
requestId = (LogHandler -> Text) -> Task e LogHandler -> Task e Text
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map LogHandler -> Text
Internal.requestId Task e LogHandler
forall e. Task e LogHandler
logHandler

-- | A log handler that doesn't log anything.
silentHandler :: IO Internal.LogHandler
silentHandler :: IO LogHandler
silentHandler = HasCallStack =>
Text -> Clock -> (TracingSpan -> IO ()) -> Text -> IO LogHandler
Text -> Clock -> (TracingSpan -> IO ()) -> Text -> IO LogHandler
Internal.mkHandler Text
"" (IO MonotonicTime -> Clock
Internal.Clock (MonotonicTime -> IO MonotonicTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure MonotonicTime
0)) (\TracingSpan
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Text
""

-- | Throw a runtime exception that cannot be caught. This function, like
-- @Debug.todo@, breaks type level guarantees and should be avoided. Where
-- possible use a type like @Result@ or @Task@ that explicitly handlers errors.
--
-- Some external libraries and API depend on sometimes require us to throw
-- errors. When that is the case prefer this function over different ways to
-- throw an exception in @Control.Exception@, because it results in better logs
-- for those who'll need to investigate these problems.
unsafeThrowException ::
  Stack.HasCallStack =>
  Text ->
  Task e a
unsafeThrowException :: Text -> Task e a
unsafeThrowException Text
title =
  (LogHandler -> IO (Result e a)) -> Task e a
forall x a. (LogHandler -> IO (Result x a)) -> Task x a
Internal.Task
    ((LogHandler -> IO (Result e a)) -> Task e a)
-> (LogHandler -> IO (Result e a)) -> Task e a
forall a b. (a -> b) -> a -> b
<| \LogHandler
_ ->
      String -> IO (Result e a)
forall (m :: * -> *) a.
(MonadThrow m, HasCallStack) =>
String -> m a
Exception.throwString (Text -> String
Data.Text.unpack Text
title)