-- Copyright 2024 Shea Levy
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--     http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnicodeSyntax #-}
{-# OPTIONS_HADDOCK not-home #-}

{- |
Description : Consuming events as data
Copyright   : Copyright 2024 Shea Levy.
License     : Apache-2.0
Maintainer  : shea@shealevy.com

This module provides the t'DataEventBackend' 'EventBackend' for consuming events
by representing them as ordinary Haskell data.
-}
module Observe.Event.Backend.Data
  ( newDataEventBackend
  , getEvents
  , DataEvent (..)
  , Selectors (..)
  , DataEventBackend
  )
where

import Control.Exception
import Control.Monad.Primitive
import Data.Coerce
import Data.Functor.Parametric
import Data.Primitive.MutVar
import Data.Sequence as Seq
import Observe.Event.Backend

{- | An 'EventBackend' for consuming events by representing them as
ordinary Haskell data.

Create a new one with 'newDataEventBackend'. Get the event data with 'getEvents'.
-}
newtype DataEventBackend m selector = DataEventBackend (MutVar (PrimState m) (Seq (MutVar (PrimState m) (Maybe (PendingDataEvent selector)))))

-- | Allocate a new t'DataEventBackend'
newDataEventBackend   m selector. (PrimMonad m, ParametricFunctor m)  m (DataEventBackend m selector)
newDataEventBackend :: forall (m :: * -> *) (selector :: * -> *).
(PrimMonad m, ParametricFunctor m) =>
m (DataEventBackend m selector)
newDataEventBackend = m (MutVar
     (PrimState m)
     (Seq (MutVar (PrimState m) (Maybe (PendingDataEvent selector)))))
-> m (DataEventBackend m selector)
forall a b. Coercible a b => a -> b
coerce (m (MutVar
      (PrimState m)
      (Seq (MutVar (PrimState m) (Maybe (PendingDataEvent selector)))))
 -> m (DataEventBackend m selector))
-> m (MutVar
        (PrimState m)
        (Seq (MutVar (PrimState m) (Maybe (PendingDataEvent selector)))))
-> m (DataEventBackend m selector)
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar @m (forall a. Seq a
empty @(MutVar (PrimState m) (Maybe (PendingDataEvent selector))))

{- | Read the events that have been emitted using the t'DataEventBackend'

A 'Nothing' indicates an event that hasn't been 'finalize'd.
-}
getEvents
   (PrimMonad m)
   DataEventBackend m selector
   m (Seq (Maybe (DataEvent selector)))
getEvents :: forall (m :: * -> *) (selector :: * -> *).
PrimMonad m =>
DataEventBackend m selector -> m (Seq (Maybe (DataEvent selector)))
getEvents DataEventBackend m selector
eb = do
  Seq (MutVar (PrimState m) (Maybe (PendingDataEvent selector)))
pendingEvVars  MutVar
  (PrimState m)
  (Seq (MutVar (PrimState m) (Maybe (PendingDataEvent selector))))
-> m (Seq
        (MutVar (PrimState m) (Maybe (PendingDataEvent selector))))
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (MutVar
   (PrimState m)
   (Seq (MutVar (PrimState m) (Maybe (PendingDataEvent selector))))
 -> m (Seq
         (MutVar (PrimState m) (Maybe (PendingDataEvent selector)))))
-> MutVar
     (PrimState m)
     (Seq (MutVar (PrimState m) (Maybe (PendingDataEvent selector))))
-> m (Seq
        (MutVar (PrimState m) (Maybe (PendingDataEvent selector))))
forall a b. (a -> b) -> a -> b
$ DataEventBackend m selector
-> MutVar
     (PrimState m)
     (Seq (MutVar (PrimState m) (Maybe (PendingDataEvent selector))))
forall a b. Coercible a b => a -> b
coerce DataEventBackend m selector
eb
  Seq (Maybe (PendingDataEvent selector))
pendingEvs  (MutVar (PrimState m) (Maybe (PendingDataEvent selector))
 -> m (Maybe (PendingDataEvent selector)))
-> Seq (MutVar (PrimState m) (Maybe (PendingDataEvent selector)))
-> m (Seq (Maybe (PendingDataEvent selector)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse MutVar (PrimState m) (Maybe (PendingDataEvent selector))
-> m (Maybe (PendingDataEvent selector))
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar Seq (MutVar (PrimState m) (Maybe (PendingDataEvent selector)))
pendingEvVars
  let
    res :: Seq (Maybe (DataEvent selector))
res = Maybe (PendingDataEvent selector) -> Maybe (DataEvent selector)
unPend (Maybe (PendingDataEvent selector) -> Maybe (DataEvent selector))
-> Seq (Maybe (PendingDataEvent selector))
-> Seq (Maybe (DataEvent selector))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (Maybe (PendingDataEvent selector))
pendingEvs
    find :: Int -> Either Int (DataEvent selector)
find Int
n = case Seq (Maybe (DataEvent selector))
-> Int -> Maybe (DataEvent selector)
forall a. Seq a -> Int -> a
index Seq (Maybe (DataEvent selector))
res Int
n of
      Just DataEvent selector
ev  DataEvent selector -> Either Int (DataEvent selector)
forall a b. b -> Either a b
Right DataEvent selector
ev
      Maybe (DataEvent selector)
Nothing  Int -> Either Int (DataEvent selector)
forall a b. a -> Either a b
Left Int
n
    unPend :: Maybe (PendingDataEvent selector) -> Maybe (DataEvent selector)
unPend (Just ev :: PendingDataEvent selector
ev@(PendingDataEvent Int
_ Selectors selector f
selectors Maybe Int
_ [Int]
_ Maybe SomeException
_ Seq f
fields Bool
_)) =
      DataEvent selector -> Maybe (DataEvent selector)
forall a. a -> Maybe a
Just (DataEvent selector -> Maybe (DataEvent selector))
-> DataEvent selector -> Maybe (DataEvent selector)
forall a b. (a -> b) -> a -> b
$
        DataEvent
          { $sel:idx:DataEvent :: Int
idx = PendingDataEvent selector
ev.reference
          , $sel:parent:DataEvent :: Maybe (Either Int (DataEvent selector))
parent = Int -> Either Int (DataEvent selector)
find (Int -> Either Int (DataEvent selector))
-> Maybe Int -> Maybe (Either Int (DataEvent selector))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PendingDataEvent selector
ev.parent
          , $sel:causes:DataEvent :: [Either Int (DataEvent selector)]
causes = Int -> Either Int (DataEvent selector)
find (Int -> Either Int (DataEvent selector))
-> [Int] -> [Either Int (DataEvent selector)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PendingDataEvent selector
ev.causes
          , Selectors selector f
selectors :: Selectors selector f
$sel:selectors:DataEvent :: Selectors selector f
selectors
          , $sel:err:DataEvent :: Maybe SomeException
err = PendingDataEvent selector
ev.err
          , Seq f
fields :: Seq f
$sel:fields:DataEvent :: Seq f
fields
          , $sel:instant:DataEvent :: Bool
instant = PendingDataEvent selector
ev.instant
          }
    unPend Maybe (PendingDataEvent selector)
Nothing = Maybe (DataEvent selector)
forall a. Maybe a
Nothing
  Seq (Maybe (DataEvent selector))
-> m (Seq (Maybe (DataEvent selector)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq (Maybe (DataEvent selector))
res

-- | A representation of an event.
data DataEvent selector =  f.
  DataEvent
  { forall (selector :: * -> *). DataEvent selector -> Int
idx  !Int
  -- ^ This event's index in the sequence of event creations.
  , ()
selectors  !(Selectors selector f)
  -- ^ The [selector](Observe-Event.html#g:selectorAndField) used to initialize the event
  , forall (selector :: * -> *).
DataEvent selector -> Maybe (Either Int (DataEvent selector))
parent  !(Maybe (Either Int (DataEvent selector)))
  -- ^ The [parent](Observe-Event.html#g:relationships) of this t'DataEvent', if any.
  --
  -- @Left n@ means the parent was the n'th event but wasn't 'finalize'd.
  , forall (selector :: * -> *).
DataEvent selector -> [Either Int (DataEvent selector)]
causes  ![Either Int (DataEvent selector)]
  -- ^ The [causes](Observe-Event.html#g:relationships) of this t'DataEvent'.
  --
  -- @Left n@ means the cause was the n'th event but wasn't 'finalize'd.
  , forall (selector :: * -> *).
DataEvent selector -> Maybe SomeException
err  !(Maybe SomeException)
  -- ^ The error which ended the event, if any
  , ()
fields  !(Seq f)
  -- ^ The fields which were added to the event
  , forall (selector :: * -> *). DataEvent selector -> Bool
instant  !Bool
  -- ^ Whether the event was emitted instantly.
  }

-- | An in-progress representation of an event.
data PendingDataEvent selector =  f.
  PendingDataEvent
  { forall (selector :: * -> *). PendingDataEvent selector -> Int
reference  !Int
  , ()
selectors  !(Selectors selector f)
  , forall (selector :: * -> *). PendingDataEvent selector -> Maybe Int
parent  !(Maybe Int)
  , forall (selector :: * -> *). PendingDataEvent selector -> [Int]
causes  ![Int]
  , forall (selector :: * -> *).
PendingDataEvent selector -> Maybe SomeException
err  !(Maybe SomeException)
  , ()
fields  !(Seq f)
  , forall (selector :: * -> *). PendingDataEvent selector -> Bool
instant  !Bool
  }

-- | The 'Event' associated with t'DataEventBackend'.
data DataEventBackendEvent m selector f = DataEventBackendEvent
  { forall (m :: * -> *) (selector :: * -> *) f.
DataEventBackendEvent m selector f -> Int
reference  !Int
  , forall (m :: * -> *) (selector :: * -> *) f.
DataEventBackendEvent m selector f
-> MutVar (PrimState m) (Maybe (PendingDataEvent selector))
cell  !(MutVar (PrimState m) (Maybe (PendingDataEvent selector)))
  , forall (m :: * -> *) (selector :: * -> *) f.
DataEventBackendEvent m selector f -> EventParams selector f Int
params  !(EventParams selector f Int)
  , forall (m :: * -> *) (selector :: * -> *) f.
DataEventBackendEvent m selector f -> MutVar (PrimState m) (Seq f)
fields  !(MutVar (PrimState m) (Seq f))
  }

-- | Consume events by representing them as ordinary Haskell data.
instance Event (DataEventBackendEvent m selector) where
  type EventReference (DataEventBackendEvent m selector) = Int
  reference :: forall field.
DataEventBackendEvent m selector field
-> EventReference (DataEventBackendEvent m selector)
reference DataEventBackendEvent m selector field
ev = DataEventBackendEvent m selector field
ev.reference

-- | Consume events by representing them as ordinary Haskell data.
instance (PrimMonad m, ParametricFunctor m)  EventIn m (DataEventBackendEvent m selector) where
  finalize :: forall field.
DataEventBackendEvent m selector field
-> Maybe SomeException -> m ()
finalize DataEventBackendEvent m selector field
ev Maybe SomeException
err = do
    Seq field
fields  MutVar (PrimState m) (Seq field) -> m (Seq field)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar DataEventBackendEvent m selector field
ev.fields
    let
      modify  Maybe (PendingDataEvent selector)  (Maybe (PendingDataEvent selector), ())
      modify :: Maybe (PendingDataEvent selector)
-> (Maybe (PendingDataEvent selector), ())
modify Maybe (PendingDataEvent selector)
Nothing =
        ( PendingDataEvent selector -> Maybe (PendingDataEvent selector)
forall a. a -> Maybe a
Just (PendingDataEvent selector -> Maybe (PendingDataEvent selector))
-> PendingDataEvent selector -> Maybe (PendingDataEvent selector)
forall a b. (a -> b) -> a -> b
$
            PendingDataEvent
              { $sel:reference:PendingDataEvent :: Int
reference = DataEventBackendEvent m selector field
ev.reference
              , $sel:selectors:PendingDataEvent :: Selectors selector field
selectors = DataEventBackendEvent m selector field
ev.params.selectors
              , $sel:parent:PendingDataEvent :: Maybe Int
parent = DataEventBackendEvent m selector field
ev.params.parent
              , $sel:causes:PendingDataEvent :: [Int]
causes = DataEventBackendEvent m selector field
ev.params.causes
              , Maybe SomeException
$sel:err:PendingDataEvent :: Maybe SomeException
err :: Maybe SomeException
err
              , Seq field
$sel:fields:PendingDataEvent :: Seq field
fields :: Seq field
fields
              , $sel:instant:PendingDataEvent :: Bool
instant = Bool
False
              }
        , ()
        )
      modify Maybe (PendingDataEvent selector)
n = (Maybe (PendingDataEvent selector)
n, ())
    MutVar (PrimState m) (Maybe (PendingDataEvent selector))
-> (Maybe (PendingDataEvent selector)
    -> (Maybe (PendingDataEvent selector), ()))
-> m ()
forall (m :: * -> *) a b.
PrimMonad m =>
MutVar (PrimState m) a -> (a -> (a, b)) -> m b
atomicModifyMutVar' DataEventBackendEvent m selector field
ev.cell Maybe (PendingDataEvent selector)
-> (Maybe (PendingDataEvent selector), ())
modify
  addField :: forall field.
DataEventBackendEvent m selector field -> field -> m ()
addField DataEventBackendEvent m selector field
ev field
f =
    MutVar (PrimState m) (Seq field)
-> (Seq field -> (Seq field, ())) -> m ()
forall (m :: * -> *) a b.
PrimMonad m =>
MutVar (PrimState m) a -> (a -> (a, b)) -> m b
atomicModifyMutVar' DataEventBackendEvent m selector field
ev.fields ((Seq field -> (Seq field, ())) -> m ())
-> (Seq field -> (Seq field, ())) -> m ()
forall a b. (a -> b) -> a -> b
$ \Seq field
fs  (Seq field
fs Seq field -> field -> Seq field
forall a. Seq a -> a -> Seq a
|> field
f, ())

-- | Consume events by representing them as ordinary Haskell data.
instance EventBackend (DataEventBackend m selector) where
  type BackendEvent (DataEventBackend m selector) = DataEventBackendEvent m selector
  type RootSelector (DataEventBackend m selector) = selector

newCell  (PrimMonad m)  DataEventBackend m selector  m (MutVar (PrimState m) (Maybe (PendingDataEvent selector)), Int)
newCell :: forall (m :: * -> *) (selector :: * -> *).
PrimMonad m =>
DataEventBackend m selector
-> m (MutVar (PrimState m) (Maybe (PendingDataEvent selector)),
      Int)
newCell DataEventBackend m selector
eb = do
  MutVar (PrimState m) (Maybe (PendingDataEvent selector))
cell  Maybe (PendingDataEvent selector)
-> m (MutVar (PrimState m) (Maybe (PendingDataEvent selector)))
forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar Maybe (PendingDataEvent selector)
forall a. Maybe a
Nothing
  Int
ref  MutVar
  (PrimState m)
  (Seq (MutVar (PrimState m) (Maybe (PendingDataEvent selector))))
-> (Seq (MutVar (PrimState m) (Maybe (PendingDataEvent selector)))
    -> (Seq (MutVar (PrimState m) (Maybe (PendingDataEvent selector))),
        Int))
-> m Int
forall (m :: * -> *) a b.
PrimMonad m =>
MutVar (PrimState m) a -> (a -> (a, b)) -> m b
atomicModifyMutVar' (DataEventBackend m selector
-> MutVar
     (PrimState m)
     (Seq (MutVar (PrimState m) (Maybe (PendingDataEvent selector))))
forall a b. Coercible a b => a -> b
coerce DataEventBackend m selector
eb) (\Seq (MutVar (PrimState m) (Maybe (PendingDataEvent selector)))
evs  (Seq (MutVar (PrimState m) (Maybe (PendingDataEvent selector)))
evs Seq (MutVar (PrimState m) (Maybe (PendingDataEvent selector)))
-> MutVar (PrimState m) (Maybe (PendingDataEvent selector))
-> Seq (MutVar (PrimState m) (Maybe (PendingDataEvent selector)))
forall a. Seq a -> a -> Seq a
|> MutVar (PrimState m) (Maybe (PendingDataEvent selector))
cell, Seq (MutVar (PrimState m) (Maybe (PendingDataEvent selector)))
-> Int
forall a. Seq a -> Int
Seq.length Seq (MutVar (PrimState m) (Maybe (PendingDataEvent selector)))
evs))
  (MutVar (PrimState m) (Maybe (PendingDataEvent selector)), Int)
-> m (MutVar (PrimState m) (Maybe (PendingDataEvent selector)),
      Int)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MutVar (PrimState m) (Maybe (PendingDataEvent selector))
cell, Int
ref)

-- | Consume events by representing them as ordinary Haskell data.
instance (PrimMonad m, ParametricFunctor m)  EventBackendIn m (DataEventBackend m selector) where
  newEvent :: forall field.
DataEventBackend m selector
-> EventParams
     (RootSelector (DataEventBackend m selector))
     field
     (EventReference (BackendEvent (DataEventBackend m selector)))
-> m (BackendEvent (DataEventBackend m selector) field)
newEvent DataEventBackend m selector
eb EventParams
  (RootSelector (DataEventBackend m selector))
  field
  (EventReference (BackendEvent (DataEventBackend m selector)))
params = do
    (MutVar (PrimState m) (Maybe (PendingDataEvent selector))
cell, Int
ref)  DataEventBackend m selector
-> m (MutVar (PrimState m) (Maybe (PendingDataEvent selector)),
      Int)
forall (m :: * -> *) (selector :: * -> *).
PrimMonad m =>
DataEventBackend m selector
-> m (MutVar (PrimState m) (Maybe (PendingDataEvent selector)),
      Int)
newCell DataEventBackend m selector
eb
    MutVar (PrimState m) (Seq field)
fields  Seq field -> m (MutVar (PrimState m) (Seq field))
forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar (Seq field -> m (MutVar (PrimState m) (Seq field)))
-> Seq field -> m (MutVar (PrimState m) (Seq field))
forall a b. (a -> b) -> a -> b
$ [field] -> Seq field
forall a. [a] -> Seq a
Seq.fromList EventParams selector field Int
EventParams
  (RootSelector (DataEventBackend m selector))
  field
  (EventReference (BackendEvent (DataEventBackend m selector)))
params.initialFields
    DataEventBackendEvent m selector field
-> m (DataEventBackendEvent m selector field)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DataEventBackendEvent{MutVar (PrimState m) (Seq field)
$sel:fields:DataEventBackendEvent :: MutVar (PrimState m) (Seq field)
fields :: MutVar (PrimState m) (Seq field)
fields, $sel:reference:DataEventBackendEvent :: Int
reference = Int
ref, EventParams selector field Int
EventParams
  (RootSelector (DataEventBackend m selector))
  field
  (EventReference (BackendEvent (DataEventBackend m selector)))
$sel:params:DataEventBackendEvent :: EventParams selector field Int
params :: EventParams
  (RootSelector (DataEventBackend m selector))
  field
  (EventReference (BackendEvent (DataEventBackend m selector)))
params, MutVar (PrimState m) (Maybe (PendingDataEvent selector))
$sel:cell:DataEventBackendEvent :: MutVar (PrimState m) (Maybe (PendingDataEvent selector))
cell :: MutVar (PrimState m) (Maybe (PendingDataEvent selector))
cell}
  newInstantEvent :: forall field.
DataEventBackend m selector
-> EventParams
     (RootSelector (DataEventBackend m selector))
     field
     (EventReference (BackendEvent (DataEventBackend m selector)))
-> m (EventReference (BackendEvent (DataEventBackend m selector)))
newInstantEvent DataEventBackend m selector
eb EventParams
  (RootSelector (DataEventBackend m selector))
  field
  (EventReference (BackendEvent (DataEventBackend m selector)))
params = do
    (MutVar (PrimState m) (Maybe (PendingDataEvent selector))
cell, Int
ref)  DataEventBackend m selector
-> m (MutVar (PrimState m) (Maybe (PendingDataEvent selector)),
      Int)
forall (m :: * -> *) (selector :: * -> *).
PrimMonad m =>
DataEventBackend m selector
-> m (MutVar (PrimState m) (Maybe (PendingDataEvent selector)),
      Int)
newCell DataEventBackend m selector
eb
    MutVar (PrimState m) (Maybe (PendingDataEvent selector))
-> Maybe (PendingDataEvent selector) -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar MutVar (PrimState m) (Maybe (PendingDataEvent selector))
cell (Maybe (PendingDataEvent selector) -> m ())
-> (PendingDataEvent selector -> Maybe (PendingDataEvent selector))
-> PendingDataEvent selector
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PendingDataEvent selector -> Maybe (PendingDataEvent selector)
forall a. a -> Maybe a
Just (PendingDataEvent selector -> m ())
-> PendingDataEvent selector -> m ()
forall a b. (a -> b) -> a -> b
$
      PendingDataEvent
        { $sel:reference:PendingDataEvent :: Int
reference = Int
ref
        , $sel:selectors:PendingDataEvent :: Selectors selector field
selectors = EventParams selector field Int
EventParams
  (RootSelector (DataEventBackend m selector))
  field
  (EventReference (BackendEvent (DataEventBackend m selector)))
params.selectors
        , $sel:parent:PendingDataEvent :: Maybe Int
parent = EventParams selector field Int
EventParams
  (RootSelector (DataEventBackend m selector))
  field
  (EventReference (BackendEvent (DataEventBackend m selector)))
params.parent
        , $sel:causes:PendingDataEvent :: [Int]
causes = EventParams selector field Int
EventParams
  (RootSelector (DataEventBackend m selector))
  field
  (EventReference (BackendEvent (DataEventBackend m selector)))
params.causes
        , $sel:err:PendingDataEvent :: Maybe SomeException
err = Maybe SomeException
forall a. Maybe a
Nothing
        , $sel:fields:PendingDataEvent :: Seq field
fields = [field] -> Seq field
forall a. [a] -> Seq a
Seq.fromList EventParams selector field Int
EventParams
  (RootSelector (DataEventBackend m selector))
  field
  (EventReference (BackendEvent (DataEventBackend m selector)))
params.initialFields
        , $sel:instant:PendingDataEvent :: Bool
instant = Bool
True
        }
    Int -> m Int
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
ref