{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}

-- |
-- Description : Renderers for serializing Events as JSON
-- Copyright   : Copyright 2022 Shea Levy.
-- License     : Apache-2.0
-- Maintainer  : shea@shealevy.com
--
-- Rendering types for JSON-consuming 'Observe.Event.EventBackend's.
--
-- Instances of 'RenderSelectorJSON' and 'RenderFieldJSON' can be generated
-- by "Observe.Event.Render.JSON.DSL.Compile".
module Observe.Event.Render.JSON
  ( RenderSelectorJSON,
    RenderFieldJSON,

    -- * Default renderers
    DefaultRenderSelectorJSON (..),
    DefaultRenderFieldJSON (..),

    -- * Rendering structured exceptions
    RenderExJSON,

    -- ** SomeJSONException
    SomeJSONException (..),
    jsonExceptionToException,
    jsonExceptionFromException,
  )
where

import Control.Exception
import Data.Aeson
import Data.Aeson.Key
import Data.Typeable
import Data.Void
import Observe.Event.Dynamic

-- | A function to render a given selector, and its fields, as JSON.
--
-- The 'Key' is the event name/category.
type RenderSelectorJSON sel = forall f. sel f -> (Key, RenderFieldJSON f)

-- | A function to render a given @field@ as JSON.
--
-- The 'Key' is a field name, the 'Value' is an arbitrary
-- rendering of the field value (if any).
type RenderFieldJSON field = field -> (Key, Value)

-- | A default 'RenderSelectorJSON', useful for auto-generation and simple
-- backend invocation.
class DefaultRenderSelectorJSON sel where
  defaultRenderSelectorJSON :: RenderSelectorJSON sel

-- | A default 'RenderFieldJSON', useful for auto-generation and simple
-- backend invocation.
class DefaultRenderFieldJSON field where
  defaultRenderFieldJSON :: RenderFieldJSON field

instance DefaultRenderFieldJSON Void where
  defaultRenderFieldJSON :: RenderFieldJSON Void
defaultRenderFieldJSON = forall a. Void -> a
absurd

instance DefaultRenderSelectorJSON DynamicEventSelector where
  defaultRenderSelectorJSON :: RenderSelectorJSON DynamicEventSelector
defaultRenderSelectorJSON (DynamicEventSelector Text
n) =
    (Text -> Key
fromText Text
n, forall field. DefaultRenderFieldJSON field => RenderFieldJSON field
defaultRenderFieldJSON)

instance DefaultRenderFieldJSON DynamicField where
  defaultRenderFieldJSON :: RenderFieldJSON DynamicField
defaultRenderFieldJSON (DynamicField {Text
Value
value :: DynamicField -> Value
name :: DynamicField -> Text
value :: Value
name :: Text
..}) = (Text -> Key
fromText Text
name, Value
value)

-- | A function to render a given structured exception to JSON.
type RenderExJSON stex = stex -> Value

-- | A possible base type for structured exceptions renderable to JSON.
--
-- It is __not__ necessary to use 'SomeJSONException' for the base of your
-- structured exceptions in a JSON backend, so long as you provide a
-- 'RenderExJSON' for your base exception type (or use 'ToJSON'-based rendering).
data SomeJSONException = forall e. (Exception e, ToJSON e) => SomeJSONException e

instance Show SomeJSONException where
  showsPrec :: Int -> SomeJSONException -> ShowS
showsPrec Int
i (SomeJSONException e
e) = forall a. Show a => Int -> a -> ShowS
showsPrec Int
i e
e

instance ToJSON SomeJSONException where
  toJSON :: SomeJSONException -> Value
toJSON (SomeJSONException e
e) = forall a. ToJSON a => a -> Value
toJSON e
e
  toEncoding :: SomeJSONException -> Encoding
toEncoding (SomeJSONException e
e) = forall a. ToJSON a => a -> Encoding
toEncoding e
e

instance Exception SomeJSONException

-- | Used to create sub-classes of 'SomeJSONException'.
jsonExceptionToException :: (Exception e, ToJSON e) => e -> SomeException
jsonExceptionToException :: forall e. (Exception e, ToJSON e) => e -> SomeException
jsonExceptionToException = forall e. Exception e => e -> SomeException
toException forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. (Exception e, ToJSON e) => e -> SomeJSONException
SomeJSONException

-- | Used to create sub-classes of 'SomeJSONException'.
jsonExceptionFromException :: (Exception e) => SomeException -> Maybe e
jsonExceptionFromException :: forall e. Exception e => SomeException -> Maybe e
jsonExceptionFromException SomeException
x = do
  SomeJSONException e
a <- forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
  forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
a