{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeOperators #-}

-- |
-- Description : "Dynamically typed" Event selectors and fields.
-- Copyright   : Copyright 2022 Shea Levy.
-- License     : Apache-2.0
-- Maintainer  : shea@shealevy.com
--
-- Instrumentors can use the types in this module if they don't want
-- to define domain-specific types for the code they're instrumenting.
module Observe.Event.Dynamic
  ( DynamicEventSelector (..),
    DynamicField (..),

    -- * Shorthand types
    DynamicEventBackend,
    DynamicEvent,
  )
where

import Data.Aeson
import Data.String
import Data.Text
import Observe.Event
import Observe.Event.Syntax

-- | A simple type usable as an 'EventBackend' selector.
--
-- All 'Event's have 'DynamicField' field types.
--
-- Individual 'DynamicEventSelector's are typically constructed
-- via the 'IsString' instance, e.g. @withEvent backend "foo" go@
-- will call @go@ with an @Event m r DynamicEventSelector DynamicField@
-- named "foo".
data DynamicEventSelector f where
  DynamicEventSelector :: !Text -> DynamicEventSelector DynamicField

instance (f ~ DynamicField) => IsString (DynamicEventSelector f) where
  fromString :: String -> DynamicEventSelector f
fromString = Text -> DynamicEventSelector DynamicField
DynamicEventSelector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

-- | A simple type usable as an 'Event' field type.
--
-- Individual 'DynamicField's are typically constructed via
-- the 'RecordField' instance, using 'ToJSON' for the value,
-- e.g. @addField ev $ "foo" ≔ x@ will add @DynamicField "foo" (toJSON x)@
-- as a field to @ev@.
data DynamicField = DynamicField
  { DynamicField -> Text
name :: !Text,
    DynamicField -> Value
value :: !Value
  }

instance (ToJSON a) => RecordField Text a DynamicField where
  Text
k ≔ :: Text -> a -> DynamicField
≔ a
v = Text -> Value -> DynamicField
DynamicField Text
k forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON a
v

-- | Shorthand for an 'EventBackend' using 'DynamicEventSelector's.
type DynamicEventBackend m r = EventBackend m r DynamicEventSelector

-- | Shorthand for an 'Event' using 'DynamicField's.
type DynamicEvent m r = Event m r DynamicField