{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnicodeSyntax #-}
{-# OPTIONS_HADDOCK not-home #-}
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
newtype DataEventBackend m selector = DataEventBackend (MutVar (PrimState m) (Seq (MutVar (PrimState m) (Maybe (PendingDataEvent selector)))))
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))))
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
data DataEvent selector = ∀ f.
DataEvent
{ forall (selector :: * -> *). DataEvent selector -> Int
idx ∷ !Int
, ()
selectors ∷ !(Selectors selector f)
, forall (selector :: * -> *).
DataEvent selector -> Maybe (Either Int (DataEvent selector))
parent ∷ !(Maybe (Either Int (DataEvent selector)))
, forall (selector :: * -> *).
DataEvent selector -> [Either Int (DataEvent selector)]
causes ∷ ![Either Int (DataEvent selector)]
, forall (selector :: * -> *).
DataEvent selector -> Maybe SomeException
err ∷ !(Maybe SomeException)
, ()
fields ∷ !(Seq f)
, forall (selector :: * -> *). DataEvent selector -> Bool
instant ∷ !Bool
}
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
}
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))
}
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
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, ())
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)
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