{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}

module Platform.Internal where

import Basics
import Control.Applicative ((<|>))
import qualified Control.AutoUpdate as AutoUpdate
import qualified Control.Exception.Safe as Exception
import qualified Control.Monad
import Data.Aeson ((.:), (.:?), (.=))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Encoding as Aeson.Encoding
import qualified Data.IORef as IORef
import qualified Data.Text
import qualified Data.Typeable as Typeable
import qualified GHC.Clock as Clock
import GHC.Generics (Generic)
import qualified GHC.Stack as Stack
import qualified GHC.Word
import Internal.Shortcut (andThen, map)
import qualified Internal.Shortcut as Shortcut
import qualified List
import Maybe (Maybe (..))
import qualified Maybe
import Result (Result (Err, Ok))
import qualified System.Mem
import Text (Text)
import qualified Tuple
import Prelude
  ( Applicative (pure, (<*>)),
    Functor,
    IO,
    Monad ((>>=)),
  )
import qualified Prelude

--
-- TASK
--

-- | Here are some common tasks:
--
-- - @now : Task x Posix@
-- - @query : String -> Task Error ()@
-- - @sleep : Float -> Task x ()@
--
-- In each case we have a Task that will resolve successfully with an a value
-- or unsuccessfully with an x value. So Postgres.query may fail with an Error
-- if the query is invalid. Whereas Time.now never fails so I cannot be more
-- specific than x. No such value will ever exist! Instead it always succeeds
-- with the current POSIX time.
--
-- More generally a task is a /description/ of what you need to do. Like a todo
-- list. Or like a grocery list. Or like GitHub issues. So saying "the task is
-- to tell me the current POSIX time" does not complete the task! You need
-- 'perform' tasks or 'attempt' tasks.
newtype Task x a = Task {forall x a. Task x a -> LogHandler -> IO (Result x a)
_run :: LogHandler -> IO (Result x a)}
  deriving ((forall a b. (a -> b) -> Task x a -> Task x b)
-> (forall a b. a -> Task x b -> Task x a) -> Functor (Task x)
forall a b. a -> Task x b -> Task x a
forall a b. (a -> b) -> Task x a -> Task x b
forall x a b. a -> Task x b -> Task x a
forall x a b. (a -> b) -> Task x a -> Task x b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall x a b. (a -> b) -> Task x a -> Task x b
fmap :: forall a b. (a -> b) -> Task x a -> Task x b
$c<$ :: forall x a b. a -> Task x b -> Task x a
<$ :: forall a b. a -> Task x b -> Task x a
Functor)

instance Applicative (Task a) where
  pure :: forall a. a -> Task a a
pure a
a =
    (LogHandler -> IO (Result a a)) -> Task a a
forall x a. (LogHandler -> IO (Result x a)) -> Task x a
Task (\LogHandler
_ -> Result a a -> IO (Result a a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (a -> Result a a
forall error value. value -> Result error value
Ok a
a))

  <*> :: forall a b. Task a (a -> b) -> Task a a -> Task a b
(<*>) Task a (a -> b)
func Task a a
task = Task a (a -> b) -> Task a a -> Task a b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
Control.Monad.ap Task a (a -> b)
func Task a a
task

instance Monad (Task a) where
  Task a a
task >>= :: forall a b. Task a a -> (a -> Task a b) -> Task a b
>>= a -> Task a b
func =
    (LogHandler -> IO (Result a b)) -> Task a b
forall x a. (LogHandler -> IO (Result x a)) -> Task x a
Task ((LogHandler -> IO (Result a b)) -> Task a b)
-> (LogHandler -> IO (Result a b)) -> Task a b
forall a b. (a -> b) -> a -> b
<| \LogHandler
key ->
      let onResult :: Result a a -> IO (Result a b)
onResult Result a a
result =
            case Result a a
result of
              Ok a
ok ->
                Task a b -> LogHandler -> IO (Result a b)
forall x a. Task x a -> LogHandler -> IO (Result x a)
_run (a -> Task a b
func a
ok) LogHandler
key
              Err a
err ->
                Result a b -> IO (Result a b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Result a b
forall error value. error -> Result error value
Err a
err)
       in Task a a -> LogHandler -> IO (Result a a)
forall x a. Task x a -> LogHandler -> IO (Result x a)
_run Task a a
task LogHandler
key IO (Result a a)
-> (IO (Result a a) -> IO (Result a b)) -> IO (Result a b)
forall a b. a -> (a -> b) -> b
|> (Result a a -> IO (Result a b))
-> IO (Result a a) -> IO (Result a b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
andThen Result a a -> IO (Result a b)
onResult

--
-- SPAN
--

-- | A @TracingSpan@ contains debugging information related to a section of the
-- program. TracingSpans can be nested inside other tracingSpans to form a
-- tree, each tracingSpan representing part of the execution of the program.
-- This format is a typical way to store tracing data. Check out this section
-- of the documentation on the open tracing standard for a good introduction on
-- tracing data and tracingSpans:
--
-- https://github.com/opentracing/specification/blob/master/specification.md#the-opentracing-data-model
--
-- From tracingSpans we can derive many other formats of debugging information:
--
-- - Logs are tracingSpans flattened into a series of events ordered by time. For
--   example, consider the following tracingSpans:
--
-- > do the laundry   11:00-12:15
-- >     wash clothes   11:00-12:00
-- >     hang clothes to dry   12:00-12:15
--
--   we could recover the following logs from this:
--
-- > 11:00 starting do the laundry
-- > 11:00 wash clothes
-- > 12:00 hang clothes to dry
-- > 12:15 finishing do the laundry
--
-- - Metrics are rolling statistics on tracingSpans. For example, we can
--   increment a counter every time we see a particular tracingSpan pass by.
--
-- So whether we're looking for tracing data, logs, or metrics, tracingSpans
-- got us covered.
data TracingSpan = TracingSpan
  { -- | A description of this tracingSpan. This should not contain any
    -- dynamically generated strings to make grouping tracingSpans easy.
    -- Any contextual info should go into 'details'.
    TracingSpan -> Text
name :: Text,
    -- | The time this tracingSpan started.
    TracingSpan -> MonotonicTime
started :: MonotonicTime,
    -- | The time this tracingSpan finished.
    TracingSpan -> MonotonicTime
finished :: MonotonicTime,
    -- | The source code location of this tracingSpan. The first @Text@ is
    -- the name of the function getting called.
    TracingSpan -> Maybe (Text, SrcLoc)
frame :: Maybe (Text, Stack.SrcLoc),
    -- | Unique information for this tracingSpan.
    TracingSpan -> Maybe SomeTracingSpanDetails
details :: Maybe SomeTracingSpanDetails,
    -- | A short blurb describing the details of this span, for use in
    -- tooling for inspecting these spans.
    TracingSpan -> Maybe Text
summary :: Maybe Text,
    -- | Whether this tracingSpan succeeded.
    TracingSpan -> Succeeded
succeeded :: Succeeded,
    -- | Whether this tracingSpan or any of the children of this
    -- tracingSpan failed. This will create a
    -- path to the tracingSpan closest to the failure from the root
    -- tracingSpan.
    TracingSpan -> Bool
containsFailures :: Bool,
    -- | The amount of bytes were allocated on the current thread while this
    -- span was running. This is a proxy for the amount of work done. If
    -- this number is low but the span took a long time to complete this
    -- indicates the thread was blocked for some time, or that work was done
    -- on other threads.
    TracingSpan -> Int
allocated :: Int,
    -- | Any subtracingSpans nested inside this tracingSpan. These are
    -- ordered in reverse chronological order, so most recent tracingSpan
    -- first, because it's cheaper to append new tracingSpans onto the left
    -- of the list.
    TracingSpan -> [TracingSpan]
children :: [TracingSpan]
  }
  deriving (Int -> TracingSpan -> ShowS
[TracingSpan] -> ShowS
TracingSpan -> String
(Int -> TracingSpan -> ShowS)
-> (TracingSpan -> String)
-> ([TracingSpan] -> ShowS)
-> Show TracingSpan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TracingSpan -> ShowS
showsPrec :: Int -> TracingSpan -> ShowS
$cshow :: TracingSpan -> String
show :: TracingSpan -> String
$cshowList :: [TracingSpan] -> ShowS
showList :: [TracingSpan] -> ShowS
Prelude.Show, (forall x. TracingSpan -> Rep TracingSpan x)
-> (forall x. Rep TracingSpan x -> TracingSpan)
-> Generic TracingSpan
forall x. Rep TracingSpan x -> TracingSpan
forall x. TracingSpan -> Rep TracingSpan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TracingSpan -> Rep TracingSpan x
from :: forall x. TracingSpan -> Rep TracingSpan x
$cto :: forall x. Rep TracingSpan x -> TracingSpan
to :: forall x. Rep TracingSpan x -> TracingSpan
Generic)

instance Aeson.ToJSON TracingSpan where
  toJSON :: TracingSpan -> Value
toJSON TracingSpan
span =
    [Pair] -> Value
Aeson.object
      [ Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TracingSpan -> Text
name TracingSpan
span,
        Key
"started" Key -> MonotonicTime -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TracingSpan -> MonotonicTime
started TracingSpan
span,
        Key
"finished" Key -> MonotonicTime -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TracingSpan -> MonotonicTime
finished TracingSpan
span,
        Key
"frame" Key -> Maybe SrcLocForEncoding -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ((Text, SrcLoc) -> SrcLocForEncoding)
-> Maybe (Text, SrcLoc) -> Maybe SrcLocForEncoding
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (Text, SrcLoc) -> SrcLocForEncoding
SrcLocForEncoding (TracingSpan -> Maybe (Text, SrcLoc)
frame TracingSpan
span),
        Key
"details" Key -> Maybe SomeTracingSpanDetails -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TracingSpan -> Maybe SomeTracingSpanDetails
details TracingSpan
span,
        Key
"summary" Key -> Maybe Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TracingSpan -> Maybe Text
summary TracingSpan
span,
        Key
"succeeded" Key -> Succeeded -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TracingSpan -> Succeeded
succeeded TracingSpan
span,
        Key
"containsFailures" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TracingSpan -> Bool
containsFailures TracingSpan
span,
        Key
"allocated" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TracingSpan -> Int
allocated TracingSpan
span,
        Key
"children" Key -> [TracingSpan] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TracingSpan -> [TracingSpan]
children TracingSpan
span
      ]
  toEncoding :: TracingSpan -> Encoding
toEncoding TracingSpan
span =
    Series -> Encoding
Aeson.pairs
      ( Key
"name"
          Key -> Text -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TracingSpan -> Text
name TracingSpan
span
          Series -> Series -> Series
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Key
"started"
            Key -> MonotonicTime -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TracingSpan -> MonotonicTime
started TracingSpan
span
          Series -> Series -> Series
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Key
"finished"
            Key -> MonotonicTime -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TracingSpan -> MonotonicTime
finished TracingSpan
span
          Series -> Series -> Series
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Key
"frame"
            Key -> Maybe SrcLocForEncoding -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ((Text, SrcLoc) -> SrcLocForEncoding)
-> Maybe (Text, SrcLoc) -> Maybe SrcLocForEncoding
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (Text, SrcLoc) -> SrcLocForEncoding
SrcLocForEncoding (TracingSpan -> Maybe (Text, SrcLoc)
frame TracingSpan
span)
          Series -> Series -> Series
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Key
"details"
            Key -> Maybe SomeTracingSpanDetails -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TracingSpan -> Maybe SomeTracingSpanDetails
details TracingSpan
span
          Series -> Series -> Series
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Key
"summary"
            Key -> Maybe Text -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TracingSpan -> Maybe Text
summary TracingSpan
span
          Series -> Series -> Series
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Key
"succeeded"
            Key -> Succeeded -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TracingSpan -> Succeeded
succeeded TracingSpan
span
          Series -> Series -> Series
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Key
"containsFailures"
            Key -> Bool -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TracingSpan -> Bool
containsFailures TracingSpan
span
          Series -> Series -> Series
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Key
"allocated"
            Key -> Int -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TracingSpan -> Int
allocated TracingSpan
span
          Series -> Series -> Series
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Key
"children"
            Key -> [TracingSpan] -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TracingSpan -> [TracingSpan]
children TracingSpan
span
      )

instance Aeson.FromJSON TracingSpan where
  parseJSON :: Value -> Parser TracingSpan
parseJSON =
    String
-> (Object -> Parser TracingSpan) -> Value -> Parser TracingSpan
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject
      String
"TracingSpan"
      ( \Object
object -> do
          name <- Object
object Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
          started <- object .: "started"
          finished <- object .: "finished"
          frame <- map (map unSrcLocForEncoding) (object .:? "frame")
          details <- object .:? "details"
          summary <- object .:? "summary"
          succeeded <- object .: "succeeded"
          containsFailures <- object .: "containsFailures"
          allocated <- object .: "allocated"
          children <- object .: "children"
          Prelude.pure
            TracingSpan
              { name,
                started,
                finished,
                frame,
                details,
                summary,
                succeeded,
                containsFailures,
                allocated,
                children
              }
      )

newtype SrcLocForEncoding = SrcLocForEncoding {SrcLocForEncoding -> (Text, SrcLoc)
unSrcLocForEncoding :: (Text, Stack.SrcLoc)}

instance Aeson.ToJSON SrcLocForEncoding where
  toJSON :: SrcLocForEncoding -> Value
toJSON (SrcLocForEncoding (Text
name, SrcLoc
loc)) =
    [Pair] -> Value
Aeson.object
      [ Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
name,
        Key
"package" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SrcLoc -> String
Stack.srcLocPackage SrcLoc
loc,
        Key
"module" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SrcLoc -> String
Stack.srcLocModule SrcLoc
loc,
        Key
"file" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SrcLoc -> String
Stack.srcLocFile SrcLoc
loc,
        Key
"startLine" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SrcLoc -> Int
Stack.srcLocStartLine SrcLoc
loc,
        Key
"startCol" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SrcLoc -> Int
Stack.srcLocStartCol SrcLoc
loc,
        Key
"endLine" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SrcLoc -> Int
Stack.srcLocEndLine SrcLoc
loc,
        Key
"endCol" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SrcLoc -> Int
Stack.srcLocEndCol SrcLoc
loc
      ]
  toEncoding :: SrcLocForEncoding -> Encoding
toEncoding (SrcLocForEncoding (Text
name, SrcLoc
loc)) =
    Series -> Encoding
Aeson.pairs
      ( Key
"name"
          Key -> Text -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
name
          Series -> Series -> Series
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Key
"package"
            Key -> String -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SrcLoc -> String
Stack.srcLocPackage SrcLoc
loc
          Series -> Series -> Series
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Key
"module"
            Key -> String -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SrcLoc -> String
Stack.srcLocModule SrcLoc
loc
          Series -> Series -> Series
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Key
"file"
            Key -> String -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SrcLoc -> String
Stack.srcLocFile SrcLoc
loc
          Series -> Series -> Series
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Key
"startLine"
            Key -> Int -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SrcLoc -> Int
Stack.srcLocStartLine SrcLoc
loc
          Series -> Series -> Series
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Key
"startCol"
            Key -> Int -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SrcLoc -> Int
Stack.srcLocStartCol SrcLoc
loc
          Series -> Series -> Series
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Key
"endLine"
            Key -> Int -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SrcLoc -> Int
Stack.srcLocEndLine SrcLoc
loc
          Series -> Series -> Series
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Key
"endCol"
            Key -> Int -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SrcLoc -> Int
Stack.srcLocEndCol SrcLoc
loc
      )

instance Aeson.FromJSON SrcLocForEncoding where
  parseJSON :: Value -> Parser SrcLocForEncoding
parseJSON =
    String
-> (Object -> Parser SrcLocForEncoding)
-> Value
-> Parser SrcLocForEncoding
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject
      String
"SrcLocForEncoding"
      ( \Object
object -> do
          name <- Object
object Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
          srcLocPackage <- object .: "package"
          srcLocModule <- object .: "module"
          srcLocFile <- object .: "file"
          srcLocStartLine <- object .: "startLine"
          srcLocStartCol <- object .: "startCol"
          srcLocEndLine <- object .: "endLine"
          srcLocEndCol <- object .: "endCol"
          Prelude.pure
            ( SrcLocForEncoding
                ( name,
                  Stack.SrcLoc
                    { Stack.srcLocPackage,
                      Stack.srcLocModule,
                      Stack.srcLocFile,
                      Stack.srcLocStartLine,
                      Stack.srcLocStartCol,
                      Stack.srcLocEndLine,
                      Stack.srcLocEndCol
                    }
                )
            )
      )

-- | A tracing span containing default empty values for all fields. Usually we
-- don't need this because TracingSpans get created for us when we evaluate
-- tasks. This can be useful when testing reporting code to see if it produces
-- the right outputs given a specific tracing span as input.
emptyTracingSpan :: TracingSpan
emptyTracingSpan :: TracingSpan
emptyTracingSpan =
  TracingSpan
    { name :: Text
name = Text
"",
      started :: MonotonicTime
started = MonotonicTime
0,
      finished :: MonotonicTime
finished = MonotonicTime
0,
      frame :: Maybe (Text, SrcLoc)
frame = Maybe (Text, SrcLoc)
forall a. Maybe a
Nothing,
      details :: Maybe SomeTracingSpanDetails
details = Maybe SomeTracingSpanDetails
forall a. Maybe a
Nothing,
      summary :: Maybe Text
summary = Maybe Text
forall a. Maybe a
Nothing,
      succeeded :: Succeeded
succeeded = Succeeded
Succeeded,
      containsFailures :: Bool
containsFailures = Bool
False,
      allocated :: Int
allocated = Int
0,
      children :: [TracingSpan]
children = []
    }

-- | The @Succeeded@ type is used to indicate whether or not a particular
-- @TracingSpan@ ran without encountering user-facing problems.
data Succeeded
  = -- | A tracingSpan that didn't fail with an unexpected exception, or was
    -- explicitly marked as failed by the user.
    --
    -- When a tracingSpan returns a failed task we do not count that as @Failed@
    -- here, because a failed task might be part of normal program
    -- operation. We wouldn't want to log those kinds of failures as errors.
    Succeeded
  | -- | A tracingSpan marked as failed by a user, for example by logging with a
    -- high severity to indicate a user is in pain.
    Failed
  | -- | A tracingSpan that failed with an unhandled exception thrown by the
    -- Haskell runtime or a library.
    FailedWith Exception.SomeException
  deriving (Int -> Succeeded -> ShowS
[Succeeded] -> ShowS
Succeeded -> String
(Int -> Succeeded -> ShowS)
-> (Succeeded -> String)
-> ([Succeeded] -> ShowS)
-> Show Succeeded
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Succeeded -> ShowS
showsPrec :: Int -> Succeeded -> ShowS
$cshow :: Succeeded -> String
show :: Succeeded -> String
$cshowList :: [Succeeded] -> ShowS
showList :: [Succeeded] -> ShowS
Prelude.Show)

instance Aeson.ToJSON Succeeded where
  toJSON :: Succeeded -> Value
toJSON Succeeded
Succeeded = Text -> Value
Aeson.String Text
"Succeeded"
  toJSON Succeeded
Failed = Text -> Value
Aeson.String Text
"Failed"
  toJSON (FailedWith SomeException
exception) =
    SomeException -> String
forall e. Exception e => e -> String
Exception.displayException SomeException
exception
      String -> (String -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> String -> Text
Data.Text.pack
      Text -> (Text -> Value) -> Value
forall a b. a -> (a -> b) -> b
|> Text -> Value
Aeson.String
  toEncoding :: Succeeded -> Encoding
toEncoding Succeeded
Succeeded = Text -> Encoding
forall a. Text -> Encoding' a
Aeson.Encoding.text Text
"Succeeded"
  toEncoding Succeeded
Failed = Text -> Encoding
forall a. Text -> Encoding' a
Aeson.Encoding.text Text
"Failed"
  toEncoding (FailedWith SomeException
exception) =
    SomeException -> String
forall e. Exception e => e -> String
Exception.displayException SomeException
exception
      String -> (String -> Encoding) -> Encoding
forall a b. a -> (a -> b) -> b
|> String -> Encoding
forall a. String -> Encoding' a
Aeson.Encoding.string

instance Aeson.FromJSON Succeeded where
  parseJSON :: Value -> Parser Succeeded
parseJSON =
    String -> (Text -> Parser Succeeded) -> Value -> Parser Succeeded
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText
      String
"Succeeded"
      ( \Text
text ->
          case Text
text of
            Text
"Succeeded" -> Succeeded -> Parser Succeeded
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure Succeeded
Succeeded
            Text
"Failed" -> Succeeded -> Parser Succeeded
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure Succeeded
Failed
            Text
_ ->
              Text -> ParsedException
ParsedException Text
text
                ParsedException
-> (ParsedException -> SomeException) -> SomeException
forall a b. a -> (a -> b) -> b
|> ParsedException -> SomeException
forall e. Exception e => e -> SomeException
Exception.toException
                SomeException -> (SomeException -> Succeeded) -> Succeeded
forall a b. a -> (a -> b) -> b
|> SomeException -> Succeeded
FailedWith
                Succeeded -> (Succeeded -> Parser Succeeded) -> Parser Succeeded
forall a b. a -> (a -> b) -> b
|> Succeeded -> Parser Succeeded
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
      )

-- Helper type for when we're decoding a TracingSpan. SomeException doesn't have
-- aeson instances for encoding or decoding. For encoding a SomeException we can
-- make something up, but we can never decode it back into the original
-- exception type. Hence this ParsedException for decoding into instead.
newtype ParsedException = ParsedException Text
  deriving ([ParsedException] -> Value
[ParsedException] -> Encoding
ParsedException -> Bool
ParsedException -> Value
ParsedException -> Encoding
(ParsedException -> Value)
-> (ParsedException -> Encoding)
-> ([ParsedException] -> Value)
-> ([ParsedException] -> Encoding)
-> (ParsedException -> Bool)
-> ToJSON ParsedException
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ParsedException -> Value
toJSON :: ParsedException -> Value
$ctoEncoding :: ParsedException -> Encoding
toEncoding :: ParsedException -> Encoding
$ctoJSONList :: [ParsedException] -> Value
toJSONList :: [ParsedException] -> Value
$ctoEncodingList :: [ParsedException] -> Encoding
toEncodingList :: [ParsedException] -> Encoding
$comitField :: ParsedException -> Bool
omitField :: ParsedException -> Bool
Aeson.ToJSON)

instance Prelude.Show ParsedException where
  show :: ParsedException -> String
show (ParsedException Text
text) = Text -> String
Data.Text.unpack Text
text

instance Exception.Exception ParsedException

-- | If the first bit of code succeeded and the second failed, the combination
-- of the two has failed as well. The @SemiGroup@ and @Monoid@ type instances
-- for @Succeeded@ allow us to combine @Succeeded@ values in such a fashion.
--
-- The rule expressed here is that the Succeeded value of a combination of
-- computations if the same as the worst thing that happened to any of the
-- individual computations.
instance Prelude.Semigroup Succeeded where
  FailedWith SomeException
err <> :: Succeeded -> Succeeded -> Succeeded
<> Succeeded
_ = SomeException -> Succeeded
FailedWith SomeException
err
  Succeeded
_ <> FailedWith SomeException
err = SomeException -> Succeeded
FailedWith SomeException
err
  Succeeded
Failed <> Succeeded
_ = Succeeded
Failed
  Succeeded
_ <> Succeeded
Failed = Succeeded
Failed
  Succeeded
_ <> Succeeded
_ = Succeeded
Succeeded

instance Prelude.Monoid Succeeded where
  mempty :: Succeeded
mempty = Succeeded
Succeeded

--
-- SPAN DETAILS
--

-- | A wrapper around the various types that specify details for different kinds
-- of tracingSpans.
--
-- Depending on what happens within a tracingSpan we want to log different
-- information for debugging. A tracingSpan for a database query might include
-- the SQL of the query, and a tracingSpan for an HTTP request the URL the
-- request is addressed to.
--
-- We could define a single @SomeTracingSpanDetails@ type that can represent all
-- of these different types of details. One way would be to write a union:
--
-- > data SomeTracingSpanDetails
-- >   = Sql SqlDetails
-- >   | Http HttpDetails
-- >   | ...
--
-- The disadvantage of this is that nri-prelude will have to know about every
-- possible type of tracingSpan. If a library wanted to log new information it
-- would have to change @nri-prelude@ first to support this. That's a barrier to
-- adding useful logging information we'd prefer not to have.
--
-- Another approach is to have the details field take arbitrary JSON:
--
-- > type SomeTracingSpanDetails = Data.Aeson.Value
--
-- This allows any library to log what it wants without requiring any changes in
-- nri-prelude. However, unless we parse that JSON back into the original types
-- (which is wasteful and can fail) we have lost the ability to render specific
-- bits of information in special ways. If we provide Bugsnag with the stack
-- trace of an error it will present it nicely in its UI. NewRelic can treat SQL
-- strings of queries in a special way. But we don't have stack traces or SQL
-- strings to give, just opaque JSON blobs.
--
-- We'd like to both let libraries define custom detail types _and_ be able to
-- read specific fields from those types in loggers that present certain bits of
-- information in nice ways. To do that we allow a bit of type magic here.
-- Analogous to Haskell's @SomeException@ type and @Exception@ type class, we
-- define a @SomeTracingSpanDetails@ type and @TracingSpanDetails@ type class.
--
-- The SomeTracingSpanDetails type can wrap any custom type, as long as it has
-- @TracingSpanDetails@ instance. The @TracingSpanDetails@ instance allows us
-- to recover the original details type if we want to treat it special in a
-- custom logger.
data SomeTracingSpanDetails where
  SomeTracingSpanDetails :: (TracingSpanDetails a) => a -> SomeTracingSpanDetails

instance Aeson.ToJSON SomeTracingSpanDetails where
  toJSON :: SomeTracingSpanDetails -> Value
toJSON (SomeTracingSpanDetails a
details) = a -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON a
details

  toEncoding :: SomeTracingSpanDetails -> Encoding
toEncoding (SomeTracingSpanDetails a
details) = a -> Encoding
forall a. ToJSON a => a -> Encoding
Aeson.toEncoding a
details

instance Aeson.FromJSON SomeTracingSpanDetails where
  parseJSON :: Value -> Parser SomeTracingSpanDetails
parseJSON Value
x =
    Value -> Parser Value
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
x
      Parser Value
-> (Parser Value -> Parser SomeTracingSpanDetails)
-> Parser SomeTracingSpanDetails
forall a b. a -> (a -> b) -> b
|> (Value -> SomeTracingSpanDetails)
-> Parser Value -> Parser SomeTracingSpanDetails
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
        (ParsedTracingSpandetails -> SomeTracingSpanDetails
forall e. TracingSpanDetails e => e -> SomeTracingSpanDetails
toTracingSpanDetails (ParsedTracingSpandetails -> SomeTracingSpanDetails)
-> (Value -> ParsedTracingSpandetails)
-> Value
-> SomeTracingSpanDetails
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Value -> ParsedTracingSpandetails
ParsedTracingSpandetails)

instance TracingSpanDetails SomeTracingSpanDetails where
  toTracingSpanDetails :: SomeTracingSpanDetails -> SomeTracingSpanDetails
toTracingSpanDetails SomeTracingSpanDetails
details = SomeTracingSpanDetails
details

  fromTracingSpanDetails :: SomeTracingSpanDetails -> Maybe SomeTracingSpanDetails
fromTracingSpanDetails = SomeTracingSpanDetails -> Maybe SomeTracingSpanDetails
forall a. a -> Maybe a
Just

instance Prelude.Show SomeTracingSpanDetails where
  show :: SomeTracingSpanDetails -> String
show (SomeTracingSpanDetails a
details) =
    a -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode a
details
      ByteString -> (ByteString -> String) -> String
forall a b. a -> (a -> b) -> b
|> ByteString -> String
forall a. Show a => a -> String
Prelude.show

-- | A container for tracing span details if we parsed them back from JSON.
-- We don't require users of this library to define FromJSON instances of their
-- own tracing span details because it's not necessary for logging, but to
-- support tooling reading data structures produced by this lib we'd still like
-- to be able to parse tracing spans from JSON. This helper type allows us to do
-- so.
newtype ParsedTracingSpandetails = ParsedTracingSpandetails Aeson.Value
  deriving ([ParsedTracingSpandetails] -> Value
[ParsedTracingSpandetails] -> Encoding
ParsedTracingSpandetails -> Bool
ParsedTracingSpandetails -> Value
ParsedTracingSpandetails -> Encoding
(ParsedTracingSpandetails -> Value)
-> (ParsedTracingSpandetails -> Encoding)
-> ([ParsedTracingSpandetails] -> Value)
-> ([ParsedTracingSpandetails] -> Encoding)
-> (ParsedTracingSpandetails -> Bool)
-> ToJSON ParsedTracingSpandetails
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ParsedTracingSpandetails -> Value
toJSON :: ParsedTracingSpandetails -> Value
$ctoEncoding :: ParsedTracingSpandetails -> Encoding
toEncoding :: ParsedTracingSpandetails -> Encoding
$ctoJSONList :: [ParsedTracingSpandetails] -> Value
toJSONList :: [ParsedTracingSpandetails] -> Value
$ctoEncodingList :: [ParsedTracingSpandetails] -> Encoding
toEncodingList :: [ParsedTracingSpandetails] -> Encoding
$comitField :: ParsedTracingSpandetails -> Bool
omitField :: ParsedTracingSpandetails -> Bool
Aeson.ToJSON)

instance TracingSpanDetails ParsedTracingSpandetails

-- | Every type we want to use as tracingSpan metadata needs a
-- @TracingSpanDetails@ instance.  The @TracingSpanDetails@ class fulfills
-- these roles:
--
-- - It allows for conversion between the custom details type and the
--   @SomeTracingSpanDetails@ type stored in a @TracingSpan@.
-- - It requires the custom details type to also have a @ToJSON@ instance.
--
-- This gives a logger two options for rendering a @SomeTracingSpanDetails@
-- value into a format understood by a monitoring tool:
--
-- - It can try @fromTracingSpanDetails@ to try to recover one of the custom
--   tracingSpan details types it has implemented custom rendering logic for.
-- - If this particular tracingSpan details type is unknown to this particular
--   logger, it can obtain always obtain a generic JSON blob of the information
--   instead.
class (Typeable.Typeable e, Aeson.ToJSON e) => TracingSpanDetails e where
  toTracingSpanDetails :: e -> SomeTracingSpanDetails
  toTracingSpanDetails = e -> SomeTracingSpanDetails
forall e. TracingSpanDetails e => e -> SomeTracingSpanDetails
SomeTracingSpanDetails

  fromTracingSpanDetails :: SomeTracingSpanDetails -> Maybe e
  fromTracingSpanDetails (SomeTracingSpanDetails a
d) = a -> Maybe e
forall a b. (Typeable a, Typeable b) => a -> Maybe b
Typeable.cast a
d

-- | A helper type used for @renderTracingSpanDetails@. Used to wrap rendering
-- functions so they have the same type and can be put in a list together.
data Renderer a where
  Renderer :: (TracingSpanDetails s) => (s -> a) -> Renderer a

-- | In reporting logic we'd like to case on the different types a
-- 'SomeTracingSpanDetails' can contain and write logic for each one. This
-- helper allows us to do so.
--
-- > newtype ImportantFact = ImportantFact Text
-- > instance ToJSON ImportantFact
-- > instance SpanDetails ImportantFact
-- >
-- > newtype KeyStatistic = KeyStatistic Int
-- > instance ToJSON KeyStatistic
-- > instance SpanDetails KeyStatistic
-- >
-- > toTracingSpanDetails (ImportantFact "Koala's are adorable")
-- >   |> renderTracingSpanDetails
-- >        [ Renderer (\ImportantFact fact -> fact)
-- >        , Renderer (\KeyStatistic stat -> Text.fromInt stat)
-- >        ]
-- >   |> Maybe.withDefault (\details -> show (Data.Aeson.encode details))
--
-- Remember that @SomeTracingSpanDetails@ are always JSON-serializable, so you
-- can use that if you need to render a span of a type you didn't prepare for.
renderTracingSpanDetails :: [Renderer a] -> SomeTracingSpanDetails -> Maybe a
renderTracingSpanDetails :: forall a. [Renderer a] -> SomeTracingSpanDetails -> Maybe a
renderTracingSpanDetails [Renderer a]
rs SomeTracingSpanDetails
s =
  case [Renderer a]
rs of
    [] -> Maybe a
forall a. Maybe a
Nothing
    (Renderer s -> a
r) : [Renderer a]
rest -> (s -> a) -> Maybe s -> Maybe a
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
Shortcut.map s -> a
r (SomeTracingSpanDetails -> Maybe s
forall e. TracingSpanDetails e => SomeTracingSpanDetails -> Maybe e
fromTracingSpanDetails SomeTracingSpanDetails
s) Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Renderer a] -> SomeTracingSpanDetails -> Maybe a
forall a. [Renderer a] -> SomeTracingSpanDetails -> Maybe a
renderTracingSpanDetails [Renderer a]
rest SomeTracingSpanDetails
s

--
-- HANDLER
--

-- | Our @Task@ type secretly passed a value of this type throughout our
-- application. Anywhere in our application we can add context to the log
-- handler. For example we might wrap our database queries in a tracingSpan
-- called "query" and add some bits of context, such as the SQL operation the
-- query is performing. These bits of metadata will then be used as much as
-- possible in logging messages, tracing, and error reporting.
--
-- Note that we do not report recorded information anywhere (log it to file, or
-- to an observability platform), until we completely finish a request. This
-- gives us the option _not_ to report on a particular request. We might use
-- this to report only on a subset of the succeeding requests, to save us money
-- without loosing important signal. We'll only know whether a request succeeds
-- after it completes though, so we have to hold off on any reporting for a
-- request until it's done.
data LogHandler = LogHandler
  { -- | We're making the assumption that every task we run is ran because
    -- of some sort of request, and that this request has a unique
    -- identifier.  We take this identifier from the incoming request and
    -- pass it on when we call external services. If something goes wrong
    -- we'll be able to collect all information related to a single request
    -- from all the components in our architecture that did work for it.
    LogHandler -> Text
requestId :: Text,
    -- | Every tracingSpan gets its own handler. That way if we record
    -- debugging information using a handler we'll know which tracingSpan
    -- the information belongs to. This function creates a new handler for
    -- a child tracingSpan of the current handler.
    LogHandler -> HasCallStack => Text -> IO LogHandler
startChildTracingSpan :: (Stack.HasCallStack) => Text -> IO LogHandler,
    -- | This allows creating a new `LogHandler` with the same behaviour as
    -- the root of this LogHandler. Remember that every tracingSpan gets its
    -- own handler, and that tracingSpans form a tree. Allowing a tracingSpan
    -- which copies the behaviour of the root allows long-lived constructs to
    -- treat its children as a new root. For example, a webserver could use
    -- this to create a new tracingSpan for each request.
    LogHandler -> HasCallStack => Text -> IO LogHandler
startNewRoot :: (Stack.HasCallStack) => Text -> IO LogHandler,
    -- | There's common fields all tracingSpans have such as a name and
    -- start and finish times. On top of that each tracingSpan can define a
    -- custom type containing useful custom data. This function allows us
    -- to set this custom data for the current tracingSpan. We could design
    -- it so this data is passed in as an extra argument when we create the
    -- tracingSpan, but then we'd miss out on useful details that only
    -- become known as the tracingSpan runs, for example the response code
    -- of an HTTP request.
    LogHandler -> forall d. TracingSpanDetails d => d -> IO ()
setTracingSpanDetailsIO :: forall d. (TracingSpanDetails d) => d -> IO (),
    -- | Set a summary for the current tracingSpan. This is shown in tools
    -- used to inspect spans as a stand-in for the full tracingSpan details
    -- in places where we only have room to show a little text.
    LogHandler -> Text -> IO ()
setTracingSpanSummaryIO :: Text -> IO (),
    -- | Mark the current tracingSpan as failed. Some reporting backends
    -- will use this to decide whether a particular request is worth
    -- reporting on.
    LogHandler -> IO ()
markTracingSpanFailedIO :: IO (),
    -- | Mark the current tracingSpan as finished, which will set the
    -- @finished@ timestamp. What this function does depends on the
    -- tracingSpan. Once we're done collecting data for the root
    -- tracingSpan we'll want to pass the tracingSpan "out", to some code
    -- that will report the debugging data to whatever observability
    -- platform(s) are used. Once we're done collecting data for child
    -- tracingSpans we'll want to add the "completed" child tracingSpan to
    -- its parent.
    LogHandler -> Maybe SomeException -> IO ()
finishTracingSpan :: Maybe Exception.SomeException -> IO (),
    -- | Deliver an analytics event payload to the configured analytics
    -- backend. The prelude knows nothing about the backend; it only
    -- threads this opaque callback from `rootTracingSpanIO` through
    -- every child `LogHandler`. See `Platform.Analytics.Internal.trackEvent`
    -- for the user-facing wrapper.
    --
    -- The callback is `Task`-shaped (not `IO`) so the wire-layer
    -- implementation can use the surrounding `LogHandler` for logging
    -- and tracing — delivery errors flow through the same observability
    -- pipeline as everything else. The `Never` error guarantees the
    -- callback can't fail the outer `track` call; the wire layer is
    -- expected to swallow and log its own failures.
    --
    -- Default: `silentTrack`.
    LogHandler -> Value -> Task Never ()
trackAnalyticsEvent :: Aeson.Value -> Task Never ()
  }

-- | A no-op analytics callback. Used as the default for `nullHandler`
-- and for platforms that have not opted in to analytics tracking yet.
silentTrack :: Aeson.Value -> Task Never ()
silentTrack :: Value -> Task Never ()
silentTrack Value
_ = (LogHandler -> IO (Result Never ())) -> Task Never ()
forall x a. (LogHandler -> IO (Result x a)) -> Task x a
Task (\LogHandler
_ -> Result Never () -> IO (Result Never ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Result Never ()
forall error value. value -> Result error value
Ok ()))

-- | Helper that creates one of the handler's above. This is intended for
-- internal use in this library only and not for exposing. Outside of this
-- library the @rootTracingSpanIO@ is the more user-friendly way to get hands
-- on a @LogHandler@.
mkHandler ::
  (Stack.HasCallStack) =>
  Text ->
  Clock ->
  -- | Analytics callback, propagated to every descendant `LogHandler`.
  (Aeson.Value -> Task Never ()) ->
  -- Finalizer for this loghandler
  (TracingSpan -> IO ()) ->
  -- Root finalizer
  Maybe (TracingSpan -> IO ()) ->
  Text ->
  IO LogHandler
mkHandler :: HasCallStack =>
Text
-> Clock
-> (Value -> Task Never ())
-> (TracingSpan -> IO ())
-> Maybe (TracingSpan -> IO ())
-> Text
-> IO LogHandler
mkHandler Text
requestId Clock
clock Value -> Task Never ()
trackEvent' TracingSpan -> IO ()
onFinish Maybe (TracingSpan -> IO ())
onFinishRoot' Text
name' = do
  let onFinishRoot :: TracingSpan -> IO ()
onFinishRoot = (TracingSpan -> IO ())
-> Maybe (TracingSpan -> IO ()) -> TracingSpan -> IO ()
forall a. a -> Maybe a -> a
Maybe.withDefault TracingSpan -> IO ()
onFinish Maybe (TracingSpan -> IO ())
onFinishRoot'
  tracingSpanRef <-
    (HasCallStack => Clock -> Text -> IO TracingSpan)
-> Clock -> Text -> IO TracingSpan
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack => Clock -> Text -> IO TracingSpan
Clock -> Text -> IO TracingSpan
startTracingSpan Clock
clock Text
name'
      IO TracingSpan
-> (IO TracingSpan -> IO (IORef TracingSpan))
-> IO (IORef TracingSpan)
forall a b. a -> (a -> b) -> b
|> (TracingSpan -> IO (IORef TracingSpan))
-> IO TracingSpan -> IO (IORef TracingSpan)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
andThen TracingSpan -> IO (IORef TracingSpan)
forall a. a -> IO (IORef a)
IORef.newIORef
  allocationCounterStartVal <- System.Mem.getAllocationCounter
  pure
    LogHandler
      { requestId,
        startChildTracingSpan = mkHandler requestId clock trackEvent' (appendTracingSpanToParent tracingSpanRef) (Just onFinishRoot),
        startNewRoot = mkHandler requestId clock trackEvent' onFinishRoot Nothing,
        setTracingSpanDetailsIO = \d
details' ->
          IORef TracingSpan -> (TracingSpan -> TracingSpan) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
updateIORef
            IORef TracingSpan
tracingSpanRef
            (\TracingSpan
tracingSpan' -> TracingSpan
tracingSpan' {details = Just (toTracingSpanDetails details')}),
        setTracingSpanSummaryIO = \Text
text ->
          IORef TracingSpan -> (TracingSpan -> TracingSpan) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
updateIORef
            IORef TracingSpan
tracingSpanRef
            (\TracingSpan
tracingSpan' -> TracingSpan
tracingSpan' {summary = Just text}),
        markTracingSpanFailedIO =
          updateIORef
            tracingSpanRef
            (\TracingSpan
tracingSpan' -> TracingSpan
tracingSpan' {succeeded = succeeded tracingSpan' ++ Failed, containsFailures = True}),
        finishTracingSpan = finalizeTracingSpan clock allocationCounterStartVal tracingSpanRef >> andThen onFinish,
        trackAnalyticsEvent = trackEvent'
      }

-- | Helper that creates a handler that does nothing. This is intended to power
-- basically @Platform.silentHandler@ and nothing else. We provide this to make
-- @Platform.silentHandler@ as efficient as possible, skipping all side effects.
--
-- The underlying desire for an IO-free `silentHandler`, aside from principles,
-- is we saw space leaks carrying @TracingSpan@ and @TracingSpanDetails@ we
-- couldn't understand, which went away when we switched to this no-op handler.
nullHandler :: LogHandler
nullHandler :: LogHandler
nullHandler = do
  LogHandler
    { requestId :: Text
requestId = Text
"",
      startChildTracingSpan :: HasCallStack => Text -> IO LogHandler
startChildTracingSpan = \Text
_ -> LogHandler -> IO LogHandler
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogHandler
nullHandler,
      startNewRoot :: HasCallStack => Text -> IO LogHandler
startNewRoot = \Text
_ -> LogHandler -> IO LogHandler
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogHandler
nullHandler,
      setTracingSpanDetailsIO :: forall d. TracingSpanDetails d => d -> IO ()
setTracingSpanDetailsIO = \d
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (),
      setTracingSpanSummaryIO :: Text -> IO ()
setTracingSpanSummaryIO = \Text
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (),
      markTracingSpanFailedIO :: IO ()
markTracingSpanFailedIO = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (),
      finishTracingSpan :: Maybe SomeException -> IO ()
finishTracingSpan = \Maybe SomeException
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (),
      trackAnalyticsEvent :: Value -> Task Never ()
trackAnalyticsEvent = Value -> Task Never ()
silentTrack
    }

-- | Set the details for a tracingSpan created using the @tracingSpan@
-- function. Like @tracingSpan@ this is intended for use in writing libraries
-- that define custom types of effects, such as database queries or http
-- requests.
--
-- It's often a good idea to use this together with @Platform.finally@ or
-- @Platform.bracketWithError@, to ensure we record tracingSpan details even in
-- the event of an exception cutting the execution of our tracingSpan short.
--
-- > tracingSpan "holiday" do
-- >   let bookPick = BookPick "The Stone Sky"
-- >   Platform.finally
-- >     (readBook bookPick)
-- >     (setTracingSpanDetails bookPick)
-- >
-- > newtype BookPick = BookPick Text
-- >   deriving (Aeson.ToJSON)
-- >
-- > instance TracingSpanDetails BookPick
setTracingSpanDetails :: (TracingSpanDetails d) => d -> Task e ()
setTracingSpanDetails :: forall d e. TracingSpanDetails d => d -> Task e ()
setTracingSpanDetails d
details =
  (LogHandler -> IO (Result e ())) -> Task e ()
forall x a. (LogHandler -> IO (Result x a)) -> Task x a
Task
    ( \LogHandler
handler ->
        LogHandler -> forall d. TracingSpanDetails d => d -> IO ()
setTracingSpanDetailsIO LogHandler
handler d
details
          IO () -> (IO () -> IO (Result e ())) -> IO (Result e ())
forall a b. a -> (a -> b) -> b
|> (() -> Result e ()) -> IO () -> IO (Result e ())
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map () -> Result e ()
forall error value. value -> Result error value
Ok
    )

-- | Set a summary for the tracingSpan created with the @tracingSpan@ function.
-- Like @tracingSpan@ this is intended for use in writing libraries that define
-- custom types of effects, such as database queries or http requests.
--
-- The summary is shown in tools used to inspect spans as a stand-in for the
-- full tracingSpan details in places where we only have room to show a little
-- text.
setTracingSpanSummary :: Text -> Task e ()
setTracingSpanSummary :: forall e. Text -> Task e ()
setTracingSpanSummary Text
text =
  (LogHandler -> IO (Result e ())) -> Task e ()
forall x a. (LogHandler -> IO (Result x a)) -> Task x a
Task
    ( \LogHandler
handler ->
        LogHandler -> Text -> IO ()
setTracingSpanSummaryIO LogHandler
handler Text
text
          IO () -> (IO () -> IO (Result e ())) -> IO (Result e ())
forall a b. a -> (a -> b) -> b
|> (() -> Result e ()) -> IO () -> IO (Result e ())
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map () -> Result e ()
forall error value. value -> Result error value
Ok
    )

-- | Mark a tracingSpan created with the @tracingSpan@ function as failed. Like
-- @tracingSpan@ this is intended for use in writing libraries that define
-- custom types of effects, such as database queries or http requests.
--
-- > tracingSpan "holiday" do
-- >   Platform.finally
-- >     (readBook bookPick)
-- >     (setTracingSpanSummary "The Stone Sky")
markTracingSpanFailed :: Task e ()
markTracingSpanFailed :: forall e. Task e ()
markTracingSpanFailed =
  (LogHandler -> IO (Result e ())) -> Task e ()
forall x a. (LogHandler -> IO (Result x a)) -> Task x a
Task ((() -> Result e ()) -> IO () -> IO (Result e ())
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map () -> Result e ()
forall error value. value -> Result error value
Ok (IO () -> IO (Result e ()))
-> (LogHandler -> IO ()) -> LogHandler -> IO (Result e ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< LogHandler -> IO ()
markTracingSpanFailedIO)

-- | Create an initial @TracingSpan@ with some initial values.
startTracingSpan :: (Stack.HasCallStack) => Clock -> Text -> IO TracingSpan
startTracingSpan :: HasCallStack => Clock -> Text -> IO TracingSpan
startTracingSpan Clock
clock Text
name = do
  started <- Clock -> IO MonotonicTime
monotonicTimeInMsec Clock
clock
  pure
    TracingSpan
      { name,
        started,
        finished = started,
        frame =
          -- This records a single stack frame containing the location in source
          -- code that creates this tracingSpan. It wouldn't be that useful if
          -- this single stack frame referenced the line in this source file
          -- where the @startTracingSpan@ function itself gets called, that would
          -- be the same line for every tracingSpan! Instead we'd like the source
          -- location recorded here to be the line outside this library calling
          -- into it. For example: the line in the application doing a database
          -- query, or logging some information.
          --
          -- That's why you see the @Stack.HasCallStack@ constraints and
          -- @Stack.withFrozenCallStack@ calls on this function's callers all the
          -- way to the boundary of the library. Unfortunately, that's what we
          -- need to do to push the stack frame we record out of the library.
          --
          -- We record only a single stack frame because that's all we get
          -- anyway, unless we'd start adding @Stack.HasCallStack@ constraints to
          -- functions in our Haskell applications. But because we record a frame
          -- for each tracingSpan together these frames can create a stack trace
          -- with a couple of different frames.
          --
          -- See the docs of the @GHC.Stack@ module for more information on how
          -- these traces work.
          Stack.callStack
            |> Stack.getCallStack
            |> List.head
            |> Shortcut.map (Tuple.mapFirst Data.Text.pack),
        details = Nothing,
        summary = Nothing,
        succeeded = Succeeded,
        containsFailures = False,
        allocated = 0,
        children = []
      }

-- | Some final properties to set on a tracingSpan before calling it done.
finalizeTracingSpan :: Clock -> Int -> IORef.IORef TracingSpan -> Maybe Exception.SomeException -> IO TracingSpan
finalizeTracingSpan :: Clock
-> Int
-> IORef TracingSpan
-> Maybe SomeException
-> IO TracingSpan
finalizeTracingSpan Clock
clock Int
allocationCounterStartVal IORef TracingSpan
tracingSpanRef Maybe SomeException
maybeException = do
  finished <- Clock -> IO MonotonicTime
monotonicTimeInMsec Clock
clock
  allocationCounterEndVal <- System.Mem.getAllocationCounter
  tracingSpan' <- IORef.readIORef tracingSpanRef
  pure
    tracingSpan'
      { finished,
        succeeded =
          succeeded tracingSpan'
            ++ case maybeException of
              Just SomeException
exception -> SomeException -> Succeeded
FailedWith SomeException
exception
              Maybe SomeException
Nothing -> Succeeded
Succeeded,
        containsFailures =
          containsFailures tracingSpan'
            || case maybeException of
              Just SomeException
_ -> Bool
True
              Maybe SomeException
Nothing ->
                (TracingSpan -> Bool) -> [TracingSpan] -> Bool
forall a. (a -> Bool) -> List a -> Bool
List.any TracingSpan -> Bool
Platform.Internal.containsFailures (TracingSpan -> [TracingSpan]
children TracingSpan
tracingSpan'),
        -- The allocation counter counts down as it allocations bytest. We
        -- subtract in this order to get a positive number.
        allocated = allocationCounterStartVal - allocationCounterEndVal
      }

appendTracingSpanToParent :: IORef.IORef TracingSpan -> TracingSpan -> IO ()
appendTracingSpanToParent :: IORef TracingSpan -> TracingSpan -> IO ()
appendTracingSpanToParent IORef TracingSpan
parentRef TracingSpan
child =
  IORef TracingSpan -> (TracingSpan -> TracingSpan) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
updateIORef IORef TracingSpan
parentRef ((TracingSpan -> TracingSpan) -> IO ())
-> (TracingSpan -> TracingSpan) -> IO ()
forall a b. (a -> b) -> a -> b
<| \TracingSpan
parentTracingSpan ->
    -- Note child tracingSpans are consed to the front of the list, so children
    -- are ordered new-to-old.
    TracingSpan
parentTracingSpan {children = child : children parentTracingSpan}

updateIORef :: IORef.IORef a -> (a -> a) -> IO ()
updateIORef :: forall a. IORef a -> (a -> a) -> IO ()
updateIORef IORef a
ref a -> a
f = IORef a -> (a -> (a, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
IORef.atomicModifyIORef' IORef a
ref (\a
x -> (a -> a
f a
x, ()))

--
-- SPAN CONSTRUCTION
--

-- | Run a task in a tracingSpan.
--
-- > tracingSpan "code dance" <| do
-- >   waltzPassLeft
-- >   clockwiseTurn 60
--
-- This will help provide better debugging information if something goes wrong
-- inside the wrapped task.
tracingSpan :: (Stack.HasCallStack) => Text -> Task e a -> Task e a
tracingSpan :: forall e a. HasCallStack => Text -> Task e a -> Task e a
tracingSpan Text
name (Task LogHandler -> IO (Result e a)
run) =
  (LogHandler -> IO (Result e a)) -> Task e a
forall x a. (LogHandler -> IO (Result x a)) -> Task x a
Task
    ( \LogHandler
handler ->
        (HasCallStack =>
 LogHandler
 -> Text -> (LogHandler -> IO (Result e a)) -> IO (Result e a))
-> LogHandler
-> Text
-> (LogHandler -> IO (Result e a))
-> IO (Result e a)
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack
          HasCallStack =>
LogHandler
-> Text -> (LogHandler -> IO (Result e a)) -> IO (Result e a)
LogHandler
-> Text -> (LogHandler -> IO (Result e a)) -> IO (Result e a)
forall a.
HasCallStack =>
LogHandler -> Text -> (LogHandler -> IO a) -> IO a
tracingSpanIO
          LogHandler
handler
          Text
name
          LogHandler -> IO (Result e a)
run
    )

-- | Run a task in a tracingSpan forking the root tracingSpan
--
-- > newRoot "No need for my parent" <| do
-- >   whateverHappensInHere
-- >   itWillHappen asIfMyParentDid it
--
-- This can help in flushing logs; by replacing the parent span, we also
-- "inherit" its finalization point
newRoot :: (Stack.HasCallStack) => Text -> Task e a -> Task e a
newRoot :: forall e a. HasCallStack => Text -> Task e a -> Task e a
newRoot Text
name (Task LogHandler -> IO (Result e a)
run) =
  (LogHandler -> IO (Result e a)) -> Task e a
forall x a. (LogHandler -> IO (Result x a)) -> Task x a
Task
    ( \LogHandler
handler ->
        (HasCallStack =>
 LogHandler
 -> Text -> (LogHandler -> IO (Result e a)) -> IO (Result e a))
-> LogHandler
-> Text
-> (LogHandler -> IO (Result e a))
-> IO (Result e a)
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack
          HasCallStack =>
LogHandler
-> Text -> (LogHandler -> IO (Result e a)) -> IO (Result e a)
LogHandler
-> Text -> (LogHandler -> IO (Result e a)) -> IO (Result e a)
forall a.
HasCallStack =>
LogHandler -> Text -> (LogHandler -> IO a) -> IO a
newRootIO
          LogHandler
handler
          Text
name
          LogHandler -> IO (Result e a)
run
    )

-- | Like @tracingSpan@, but this one runs in @IO@ instead of @Task@. We
-- sometimes need this in libraries. @Task@ has the concept of a @LogHandler@
-- built in but @IO@ does not, so we'll have to pass it around ourselves.
--
-- > tracingSpanIO handler "code dance" <| \childHandler -> do
-- >   waltzPassLeft childHandler
-- >   clockwiseTurn childHandler 60
tracingSpanIO :: (Stack.HasCallStack) => LogHandler -> Text -> (LogHandler -> IO a) -> IO a
tracingSpanIO :: forall a.
HasCallStack =>
LogHandler -> Text -> (LogHandler -> IO a) -> IO a
tracingSpanIO LogHandler
handler Text
name LogHandler -> IO a
run =
  IO LogHandler
-> (Maybe SomeException -> LogHandler -> IO ())
-> (LogHandler -> IO a)
-> IO a
forall (m :: * -> *) a b c.
(HasCallStack, MonadMask m) =>
m a -> (Maybe SomeException -> a -> m b) -> (a -> m c) -> m c
Exception.bracketWithError
    ((HasCallStack => IO LogHandler) -> IO LogHandler
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack (LogHandler -> HasCallStack => Text -> IO LogHandler
startChildTracingSpan LogHandler
handler Text
name))
    ((LogHandler -> Maybe SomeException -> IO ())
-> Maybe SomeException -> LogHandler -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
Prelude.flip LogHandler -> Maybe SomeException -> IO ()
finishTracingSpan)
    LogHandler -> IO a
run

-- | Like @newRoot@, but this one runs in @IO@ instead of @Task@. We
-- sometimes need this in libraries. @Task@ has the concept of a @LogHandler@
-- built in but @IO@ does not, so we'll have to pass it around ourselves.
--
-- > newRootIO handler "code dance" <| \childHandler -> do
-- >   waltzPassLeft childHandler
-- >   clockwiseTurn childHandler 60
newRootIO :: (Stack.HasCallStack) => LogHandler -> Text -> (LogHandler -> IO a) -> IO a
newRootIO :: forall a.
HasCallStack =>
LogHandler -> Text -> (LogHandler -> IO a) -> IO a
newRootIO LogHandler
handler Text
name LogHandler -> IO a
run = do
  IO LogHandler
-> (Maybe SomeException -> LogHandler -> IO ())
-> (LogHandler -> IO a)
-> IO a
forall (m :: * -> *) a b c.
(HasCallStack, MonadMask m) =>
m a -> (Maybe SomeException -> a -> m b) -> (a -> m c) -> m c
Exception.bracketWithError
    ((HasCallStack => IO LogHandler) -> IO LogHandler
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack (LogHandler -> HasCallStack => Text -> IO LogHandler
startNewRoot LogHandler
handler Text
name))
    ((LogHandler -> Maybe SomeException -> IO ())
-> Maybe SomeException -> LogHandler -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
Prelude.flip LogHandler -> Maybe SomeException -> IO ()
finishTracingSpan)
    LogHandler -> IO a
run

-- | Special version of @tracingSpanIO@ to call in the root of your application.
-- Instead of taking a parent handler it takes a continuation that will be
-- called with this root tracingSpan after it has run.
--
-- > rootTracingSpanIO "request-23" silentTrack Prelude.print "incoming request" <| \handler ->
-- >   handleRequest
-- >   |> Task.perform handler
rootTracingSpanIO ::
  (Stack.HasCallStack) =>
  Text ->
  -- | Analytics callback. Pass `silentTrack` for platforms that don't track.
  (Aeson.Value -> Task Never ()) ->
  (TracingSpan -> IO ()) ->
  Text ->
  (LogHandler -> IO a) ->
  IO a
rootTracingSpanIO :: forall a.
HasCallStack =>
Text
-> (Value -> Task Never ())
-> (TracingSpan -> IO ())
-> Text
-> (LogHandler -> IO a)
-> IO a
rootTracingSpanIO Text
requestId Value -> Task Never ()
trackEvent' TracingSpan -> IO ()
onFinish Text
name LogHandler -> IO a
runIO = do
  clock' <- IO Clock
mkClock
  Exception.bracketWithError
    (Stack.withFrozenCallStack mkHandler requestId clock' trackEvent' onFinish Nothing name)
    (Prelude.flip finishTracingSpan)
    runIO

--
-- CLOCK
--

-- | A clock we can use to get the current time, to check when tracingSpans are
-- starting or ending. We could call @getCurrentTime@ or somesuch whenever we
-- need the time but we'd be calling this a lot: every time a tracingSpan
-- starts or finishes. The @Clock@ type we pass around here contains cached
-- version of @getCurrentTime@. We can call it as often as we like and it will
-- only get the current time at most once every millisecond.
newtype Clock = Clock {Clock -> IO MonotonicTime
monotonicTimeInMsec :: IO MonotonicTime}

mkClock :: IO Clock
mkClock :: IO Clock
mkClock =
  UpdateSettings MonotonicTime -> IO (IO MonotonicTime)
forall a. UpdateSettings a -> IO (IO a)
AutoUpdate.mkAutoUpdate
    UpdateSettings ()
AutoUpdate.defaultUpdateSettings
      { AutoUpdate.updateAction =
          Clock.getMonotonicTimeNSec
            |> map (\Word64
n -> Word64 -> MonotonicTime
MonotonicTime (Word64
n Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`Prelude.div` Word64
1000)),
        AutoUpdate.updateFreq = 100 -- Once every 100 microseconds
      }
    IO (IO MonotonicTime)
-> (IO (IO MonotonicTime) -> IO Clock) -> IO Clock
forall a b. a -> (a -> b) -> b
|> (IO MonotonicTime -> Clock) -> IO (IO MonotonicTime) -> IO Clock
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map IO MonotonicTime -> Clock
Clock

-- |
-- You might expect a timestamp here, but timestamps are unreliable for
-- measuring how long a bit of code runs. For example: events like leap seconds
-- can cause them to move backards. This might result in us measuring the
-- duration of an operation and finding it to be minus 200 milliseconds.
--
-- We use @GHC.Clock.getMonotonicTimeNSec@ to let the OS tell us how much time
-- has passed since an arbitrary but constant moment in the past. That might
-- not seem all that useful, but if we 'sync watches' at one moment by getting
-- the monotonic and "regular" time in the same moment then we'll able to
-- convert any monotonic time to real timestamps. Conversion is not our concern
-- here though, we just store these monotonic times and let code that reporters
-- that use these tracingSpans convert the monotonic times into whatever format
-- they need.
newtype MonotonicTime = MonotonicTime
  { -- | The number of microseconds that have passed since an arbitrary but
    -- constant moment in the past.
    MonotonicTime -> Word64
inMicroseconds :: GHC.Word.Word64
  }
  deriving (Int -> MonotonicTime -> ShowS
[MonotonicTime] -> ShowS
MonotonicTime -> String
(Int -> MonotonicTime -> ShowS)
-> (MonotonicTime -> String)
-> ([MonotonicTime] -> ShowS)
-> Show MonotonicTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MonotonicTime -> ShowS
showsPrec :: Int -> MonotonicTime -> ShowS
$cshow :: MonotonicTime -> String
show :: MonotonicTime -> String
$cshowList :: [MonotonicTime] -> ShowS
showList :: [MonotonicTime] -> ShowS
Prelude.Show, Int -> MonotonicTime
MonotonicTime -> Int
MonotonicTime -> [MonotonicTime]
MonotonicTime -> MonotonicTime
MonotonicTime -> MonotonicTime -> [MonotonicTime]
MonotonicTime -> MonotonicTime -> MonotonicTime -> [MonotonicTime]
(MonotonicTime -> MonotonicTime)
-> (MonotonicTime -> MonotonicTime)
-> (Int -> MonotonicTime)
-> (MonotonicTime -> Int)
-> (MonotonicTime -> [MonotonicTime])
-> (MonotonicTime -> MonotonicTime -> [MonotonicTime])
-> (MonotonicTime -> MonotonicTime -> [MonotonicTime])
-> (MonotonicTime
    -> MonotonicTime -> MonotonicTime -> [MonotonicTime])
-> Enum MonotonicTime
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MonotonicTime -> MonotonicTime
succ :: MonotonicTime -> MonotonicTime
$cpred :: MonotonicTime -> MonotonicTime
pred :: MonotonicTime -> MonotonicTime
$ctoEnum :: Int -> MonotonicTime
toEnum :: Int -> MonotonicTime
$cfromEnum :: MonotonicTime -> Int
fromEnum :: MonotonicTime -> Int
$cenumFrom :: MonotonicTime -> [MonotonicTime]
enumFrom :: MonotonicTime -> [MonotonicTime]
$cenumFromThen :: MonotonicTime -> MonotonicTime -> [MonotonicTime]
enumFromThen :: MonotonicTime -> MonotonicTime -> [MonotonicTime]
$cenumFromTo :: MonotonicTime -> MonotonicTime -> [MonotonicTime]
enumFromTo :: MonotonicTime -> MonotonicTime -> [MonotonicTime]
$cenumFromThenTo :: MonotonicTime -> MonotonicTime -> MonotonicTime -> [MonotonicTime]
enumFromThenTo :: MonotonicTime -> MonotonicTime -> MonotonicTime -> [MonotonicTime]
Prelude.Enum, Num MonotonicTime
Ord MonotonicTime
(Num MonotonicTime, Ord MonotonicTime) =>
(MonotonicTime -> Rational) -> Real MonotonicTime
MonotonicTime -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: MonotonicTime -> Rational
toRational :: MonotonicTime -> Rational
Prelude.Real, Enum MonotonicTime
Real MonotonicTime
(Real MonotonicTime, Enum MonotonicTime) =>
(MonotonicTime -> MonotonicTime -> MonotonicTime)
-> (MonotonicTime -> MonotonicTime -> MonotonicTime)
-> (MonotonicTime -> MonotonicTime -> MonotonicTime)
-> (MonotonicTime -> MonotonicTime -> MonotonicTime)
-> (MonotonicTime
    -> MonotonicTime -> (MonotonicTime, MonotonicTime))
-> (MonotonicTime
    -> MonotonicTime -> (MonotonicTime, MonotonicTime))
-> (MonotonicTime -> Integer)
-> Integral MonotonicTime
MonotonicTime -> Integer
MonotonicTime -> MonotonicTime -> (MonotonicTime, MonotonicTime)
MonotonicTime -> MonotonicTime -> MonotonicTime
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: MonotonicTime -> MonotonicTime -> MonotonicTime
quot :: MonotonicTime -> MonotonicTime -> MonotonicTime
$crem :: MonotonicTime -> MonotonicTime -> MonotonicTime
rem :: MonotonicTime -> MonotonicTime -> MonotonicTime
$cdiv :: MonotonicTime -> MonotonicTime -> MonotonicTime
div :: MonotonicTime -> MonotonicTime -> MonotonicTime
$cmod :: MonotonicTime -> MonotonicTime -> MonotonicTime
mod :: MonotonicTime -> MonotonicTime -> MonotonicTime
$cquotRem :: MonotonicTime -> MonotonicTime -> (MonotonicTime, MonotonicTime)
quotRem :: MonotonicTime -> MonotonicTime -> (MonotonicTime, MonotonicTime)
$cdivMod :: MonotonicTime -> MonotonicTime -> (MonotonicTime, MonotonicTime)
divMod :: MonotonicTime -> MonotonicTime -> (MonotonicTime, MonotonicTime)
$ctoInteger :: MonotonicTime -> Integer
toInteger :: MonotonicTime -> Integer
Prelude.Integral, Integer -> MonotonicTime
MonotonicTime -> MonotonicTime
MonotonicTime -> MonotonicTime -> MonotonicTime
(MonotonicTime -> MonotonicTime -> MonotonicTime)
-> (MonotonicTime -> MonotonicTime -> MonotonicTime)
-> (MonotonicTime -> MonotonicTime -> MonotonicTime)
-> (MonotonicTime -> MonotonicTime)
-> (MonotonicTime -> MonotonicTime)
-> (MonotonicTime -> MonotonicTime)
-> (Integer -> MonotonicTime)
-> Num MonotonicTime
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: MonotonicTime -> MonotonicTime -> MonotonicTime
+ :: MonotonicTime -> MonotonicTime -> MonotonicTime
$c- :: MonotonicTime -> MonotonicTime -> MonotonicTime
- :: MonotonicTime -> MonotonicTime -> MonotonicTime
$c* :: MonotonicTime -> MonotonicTime -> MonotonicTime
* :: MonotonicTime -> MonotonicTime -> MonotonicTime
$cnegate :: MonotonicTime -> MonotonicTime
negate :: MonotonicTime -> MonotonicTime
$cabs :: MonotonicTime -> MonotonicTime
abs :: MonotonicTime -> MonotonicTime
$csignum :: MonotonicTime -> MonotonicTime
signum :: MonotonicTime -> MonotonicTime
$cfromInteger :: Integer -> MonotonicTime
fromInteger :: Integer -> MonotonicTime
Prelude.Num, MonotonicTime -> MonotonicTime -> Bool
(MonotonicTime -> MonotonicTime -> Bool)
-> (MonotonicTime -> MonotonicTime -> Bool) -> Eq MonotonicTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MonotonicTime -> MonotonicTime -> Bool
== :: MonotonicTime -> MonotonicTime -> Bool
$c/= :: MonotonicTime -> MonotonicTime -> Bool
/= :: MonotonicTime -> MonotonicTime -> Bool
Prelude.Eq, Eq MonotonicTime
Eq MonotonicTime =>
(MonotonicTime -> MonotonicTime -> Ordering)
-> (MonotonicTime -> MonotonicTime -> Bool)
-> (MonotonicTime -> MonotonicTime -> Bool)
-> (MonotonicTime -> MonotonicTime -> Bool)
-> (MonotonicTime -> MonotonicTime -> Bool)
-> (MonotonicTime -> MonotonicTime -> MonotonicTime)
-> (MonotonicTime -> MonotonicTime -> MonotonicTime)
-> Ord MonotonicTime
MonotonicTime -> MonotonicTime -> Bool
MonotonicTime -> MonotonicTime -> Ordering
MonotonicTime -> MonotonicTime -> MonotonicTime
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MonotonicTime -> MonotonicTime -> Ordering
compare :: MonotonicTime -> MonotonicTime -> Ordering
$c< :: MonotonicTime -> MonotonicTime -> Bool
< :: MonotonicTime -> MonotonicTime -> Bool
$c<= :: MonotonicTime -> MonotonicTime -> Bool
<= :: MonotonicTime -> MonotonicTime -> Bool
$c> :: MonotonicTime -> MonotonicTime -> Bool
> :: MonotonicTime -> MonotonicTime -> Bool
$c>= :: MonotonicTime -> MonotonicTime -> Bool
>= :: MonotonicTime -> MonotonicTime -> Bool
$cmax :: MonotonicTime -> MonotonicTime -> MonotonicTime
max :: MonotonicTime -> MonotonicTime -> MonotonicTime
$cmin :: MonotonicTime -> MonotonicTime -> MonotonicTime
min :: MonotonicTime -> MonotonicTime -> MonotonicTime
Prelude.Ord, [MonotonicTime] -> Value
[MonotonicTime] -> Encoding
MonotonicTime -> Bool
MonotonicTime -> Value
MonotonicTime -> Encoding
(MonotonicTime -> Value)
-> (MonotonicTime -> Encoding)
-> ([MonotonicTime] -> Value)
-> ([MonotonicTime] -> Encoding)
-> (MonotonicTime -> Bool)
-> ToJSON MonotonicTime
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: MonotonicTime -> Value
toJSON :: MonotonicTime -> Value
$ctoEncoding :: MonotonicTime -> Encoding
toEncoding :: MonotonicTime -> Encoding
$ctoJSONList :: [MonotonicTime] -> Value
toJSONList :: [MonotonicTime] -> Value
$ctoEncodingList :: [MonotonicTime] -> Encoding
toEncodingList :: [MonotonicTime] -> Encoding
$comitField :: MonotonicTime -> Bool
omitField :: MonotonicTime -> Bool
Aeson.ToJSON, Maybe MonotonicTime
Value -> Parser [MonotonicTime]
Value -> Parser MonotonicTime
(Value -> Parser MonotonicTime)
-> (Value -> Parser [MonotonicTime])
-> Maybe MonotonicTime
-> FromJSON MonotonicTime
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser MonotonicTime
parseJSON :: Value -> Parser MonotonicTime
$cparseJSONList :: Value -> Parser [MonotonicTime]
parseJSONList :: Value -> Parser [MonotonicTime]
$comittedField :: Maybe MonotonicTime
omittedField :: Maybe MonotonicTime
Aeson.FromJSON)