module Halogen.IO.Driver.State
  ( LifecycleHandlers (..)
  , DriverState (..)
  , DriverStateRef (..)
  , DriverStateX (..)
  , unDriverStateX
  -- , mkDriverStateXRef
  , readDriverStateRef
  , RenderStateX (..)
  , renderStateX
  , renderStateX_
  -- , unRenderStateX
  , initDriverState
  )
where

import Control.Monad.Fork
import Data.Row
import HPrelude hiding (state)
import Halogen.Component
import Halogen.Data.Slot as SlotStorage
import Halogen.Query.HalogenM
import Halogen.Subscription qualified as HS
import Web.DOM.Element (Element)

data LifecycleHandlers m = LifecycleHandlers
  { forall (m :: * -> *). LifecycleHandlers m -> [m ()]
initializers :: [m ()]
  , forall (m :: * -> *). LifecycleHandlers m -> [m ()]
finalizers :: [m ()]
  }

data DriverState m r s f act ps i o = DriverState
  { forall (m :: * -> *) (r :: * -> * -> Row (*) -> * -> *) s
       (f :: * -> *) act (ps :: Row (*)) i o.
DriverState m r s f act ps i o -> ComponentSpec s f act ps i o m
component :: ComponentSpec s f act ps i o m
  , forall (m :: * -> *) (r :: * -> * -> Row (*) -> * -> *) s
       (f :: * -> *) act (ps :: Row (*)) i o.
DriverState m r s f act ps i o -> s
state :: s
  , forall (m :: * -> *) (r :: * -> * -> Row (*) -> * -> *) s
       (f :: * -> *) act (ps :: Row (*)) i o.
DriverState m r s f act ps i o -> Map Text Element
refs :: Map Text Element
  , forall (m :: * -> *) (r :: * -> * -> Row (*) -> * -> *) s
       (f :: * -> *) act (ps :: Row (*)) i o.
DriverState m r s f act ps i o
-> SlotStorage ps (DriverStateRef m r)
children :: SlotStorage ps (DriverStateRef m r)
  , forall (m :: * -> *) (r :: * -> * -> Row (*) -> * -> *) s
       (f :: * -> *) act (ps :: Row (*)) i o.
DriverState m r s f act ps i o
-> IORef (SlotStorage ps (DriverStateRef m r))
childrenIn :: IORef (SlotStorage ps (DriverStateRef m r))
  , forall (m :: * -> *) (r :: * -> * -> Row (*) -> * -> *) s
       (f :: * -> *) act (ps :: Row (*)) i o.
DriverState m r s f act ps i o
-> IORef (SlotStorage ps (DriverStateRef m r))
childrenOut :: IORef (SlotStorage ps (DriverStateRef m r))
  , forall (m :: * -> *) (r :: * -> * -> Row (*) -> * -> *) s
       (f :: * -> *) act (ps :: Row (*)) i o.
DriverState m r s f act ps i o
-> IORef (DriverState m r s f act ps i o)
selfRef :: IORef (DriverState m r s f act ps i o)
  , forall (m :: * -> *) (r :: * -> * -> Row (*) -> * -> *) s
       (f :: * -> *) act (ps :: Row (*)) i o.
DriverState m r s f act ps i o -> IORef (o -> m ())
handlerRef :: IORef (o -> m ())
  , forall (m :: * -> *) (r :: * -> * -> Row (*) -> * -> *) s
       (f :: * -> *) act (ps :: Row (*)) i o.
DriverState m r s f act ps i o -> IORef (Maybe [m ()])
pendingQueries :: IORef (Maybe [m ()])
  , forall (m :: * -> *) (r :: * -> * -> Row (*) -> * -> *) s
       (f :: * -> *) act (ps :: Row (*)) i o.
DriverState m r s f act ps i o -> IORef (Maybe [m ()])
pendingOuts :: IORef (Maybe [m ()])
  , forall (m :: * -> *) (r :: * -> * -> Row (*) -> * -> *) s
       (f :: * -> *) act (ps :: Row (*)) i o.
DriverState m r s f act ps i o -> IORef (Maybe [m ()])
pendingHandlers :: IORef (Maybe [m ()])
  , forall (m :: * -> *) (r :: * -> * -> Row (*) -> * -> *) s
       (f :: * -> *) act (ps :: Row (*)) i o.
DriverState m r s f act ps i o -> Maybe (r s act ps o)
rendering :: Maybe (r s act ps o)
  , forall (m :: * -> *) (r :: * -> * -> Row (*) -> * -> *) s
       (f :: * -> *) act (ps :: Row (*)) i o.
DriverState m r s f act ps i o -> IORef Int
fresh :: IORef Int
  , forall (m :: * -> *) (r :: * -> * -> Row (*) -> * -> *) s
       (f :: * -> *) act (ps :: Row (*)) i o.
DriverState m r s f act ps i o
-> IORef (Maybe (Map SubscriptionId (Subscription m)))
subscriptions :: IORef (Maybe (Map SubscriptionId (HS.Subscription m)))
  , forall (m :: * -> *) (r :: * -> * -> Row (*) -> * -> *) s
       (f :: * -> *) act (ps :: Row (*)) i o.
DriverState m r s f act ps i o -> IORef (Map ForkId (Fork m ()))
forks :: IORef (Map ForkId (Fork m ()))
  , forall (m :: * -> *) (r :: * -> * -> Row (*) -> * -> *) s
       (f :: * -> *) act (ps :: Row (*)) i o.
DriverState m r s f act ps i o -> IORef (LifecycleHandlers m)
lifecycleHandlers :: IORef (LifecycleHandlers m)
  }

data DriverStateX m r f o = forall s act ps i. DriverStateX (DriverState m r s f act ps i o)

data DriverStateRef m r f o = forall s act ps i. DriverStateRef (IORef (DriverState m r s f act ps i o))

{-# INLINE readDriverStateRef #-}
readDriverStateRef :: (MonadIO m) => DriverStateRef m r f o -> m (DriverStateX m r f o)
readDriverStateRef :: forall (m :: * -> *) (r :: * -> * -> Row (*) -> * -> *)
       (f :: * -> *) o.
MonadIO m =>
DriverStateRef m r f o -> m (DriverStateX m r f o)
readDriverStateRef (DriverStateRef IORef (DriverState m r s f act ps i o)
ref) = DriverState m r s f act ps i o -> DriverStateX m r f o
forall (m :: * -> *) (r :: * -> * -> Row (*) -> * -> *)
       (f :: * -> *) o s act (ps :: Row (*)) i.
DriverState m r s f act ps i o -> DriverStateX m r f o
DriverStateX (DriverState m r s f act ps i o -> DriverStateX m r f o)
-> m (DriverState m r s f act ps i o) -> m (DriverStateX m r f o)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (DriverState m r s f act ps i o)
-> m (DriverState m r s f act ps i o)
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef (DriverState m r s f act ps i o)
ref

data RenderStateX (r :: Type -> Type -> Row Type -> Type -> Type) = forall s act ps o. RenderStateX (r s act ps o)

{-# INLINE renderStateX #-}
renderStateX
  :: (Functor m)
  => (forall s act ps. Maybe (r s act ps o) -> m (r s act ps o))
  -> DriverStateX m r f o
  -> m (RenderStateX r)
renderStateX :: forall (m :: * -> *) (r :: * -> * -> Row (*) -> * -> *) o
       (f :: * -> *).
Functor m =>
(forall s act (ps :: Row (*)).
 Maybe (r s act ps o) -> m (r s act ps o))
-> DriverStateX m r f o -> m (RenderStateX r)
renderStateX forall s act (ps :: Row (*)).
Maybe (r s act ps o) -> m (r s act ps o)
f = (forall s act (ps :: Row (*)) i.
 DriverState m r s f act ps i o -> m (RenderStateX r))
-> DriverStateX m r f o -> m (RenderStateX r)
forall (m :: * -> *) (r :: * -> * -> Row (*) -> * -> *)
       (f :: * -> *) o a.
(forall s act (ps :: Row (*)) i.
 DriverState m r s f act ps i o -> a)
-> DriverStateX m r f o -> a
unDriverStateX ((forall s act (ps :: Row (*)) i.
  DriverState m r s f act ps i o -> m (RenderStateX r))
 -> DriverStateX m r f o -> m (RenderStateX r))
-> (forall s act (ps :: Row (*)) i.
    DriverState m r s f act ps i o -> m (RenderStateX r))
-> DriverStateX m r f o
-> m (RenderStateX r)
forall a b. (a -> b) -> a -> b
$ \DriverState m r s f act ps i o
st ->
  r s act ps o -> RenderStateX r
forall (r :: * -> * -> Row (*) -> * -> *) s act (ps :: Row (*)) o.
r s act ps o -> RenderStateX r
RenderStateX (r s act ps o -> RenderStateX r)
-> m (r s act ps o) -> m (RenderStateX r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (r s act ps o) -> m (r s act ps o)
forall s act (ps :: Row (*)).
Maybe (r s act ps o) -> m (r s act ps o)
f DriverState m r s f act ps i o
st.rendering

{-# INLINE renderStateX_ #-}
renderStateX_
  :: (Applicative m)
  => (forall s act ps. r s act ps o -> m ())
  -> DriverStateX m r f o
  -> m ()
renderStateX_ :: forall (m :: * -> *) (r :: * -> * -> Row (*) -> * -> *) o
       (f :: * -> *).
Applicative m =>
(forall s act (ps :: Row (*)). r s act ps o -> m ())
-> DriverStateX m r f o -> m ()
renderStateX_ forall s act (ps :: Row (*)). r s act ps o -> m ()
f = (forall s act (ps :: Row (*)) i.
 DriverState m r s f act ps i o -> m ())
-> DriverStateX m r f o -> m ()
forall (m :: * -> *) (r :: * -> * -> Row (*) -> * -> *)
       (f :: * -> *) o a.
(forall s act (ps :: Row (*)) i.
 DriverState m r s f act ps i o -> a)
-> DriverStateX m r f o -> a
unDriverStateX ((forall s act (ps :: Row (*)) i.
  DriverState m r s f act ps i o -> m ())
 -> DriverStateX m r f o -> m ())
-> (forall s act (ps :: Row (*)) i.
    DriverState m r s f act ps i o -> m ())
-> DriverStateX m r f o
-> m ()
forall a b. (a -> b) -> a -> b
$ \DriverState m r s f act ps i o
st ->
  (r s act ps o -> m ()) -> Maybe (r s act ps o) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ r s act ps o -> m ()
forall s act (ps :: Row (*)). r s act ps o -> m ()
f DriverState m r s f act ps i o
st.rendering

{-# INLINE unDriverStateX #-}
unDriverStateX :: (forall s act ps i. DriverState m r s f act ps i o -> a) -> DriverStateX m r f o -> a
unDriverStateX :: forall (m :: * -> *) (r :: * -> * -> Row (*) -> * -> *)
       (f :: * -> *) o a.
(forall s act (ps :: Row (*)) i.
 DriverState m r s f act ps i o -> a)
-> DriverStateX m r f o -> a
unDriverStateX forall s act (ps :: Row (*)) i. DriverState m r s f act ps i o -> a
f (DriverStateX DriverState m r s f act ps i o
st) = DriverState m r s f act ps i o -> a
forall s act (ps :: Row (*)) i. DriverState m r s f act ps i o -> a
f DriverState m r s f act ps i o
st

{-# SPECIALIZE initDriverState :: ComponentSpec s f act ps i o IO -> i -> (o -> IO ()) -> IORef (LifecycleHandlers IO) -> IO (DriverState IO r s f act ps i o) #-}
initDriverState
  :: (MonadIO m)
  => ComponentSpec s f act ps i o m
  -> i
  -> (o -> m ())
  -> IORef (LifecycleHandlers m)
  -> m (DriverState m r s f act ps i o)
initDriverState :: forall (m :: * -> *) s (f :: * -> *) act (ps :: Row (*)) i o
       (r :: * -> * -> Row (*) -> * -> *).
MonadIO m =>
ComponentSpec s f act ps i o m
-> i
-> (o -> m ())
-> IORef (LifecycleHandlers m)
-> m (DriverState m r s f act ps i o)
initDriverState ComponentSpec s f act ps i o m
component i
input o -> m ()
handler IORef (LifecycleHandlers m)
lchs = do
  selfRef <- DriverState m r s f act ps i o
-> m (IORef (DriverState m r s f act ps i o))
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef ((DriverState m r s f act ps i o -> DriverState m r s f act ps i o)
-> DriverState m r s f act ps i o
forall a. (a -> a) -> a
fix DriverState m r s f act ps i o -> DriverState m r s f act ps i o
forall a. a -> a
identity)
  childrenIn <- newIORef SlotStorage.empty
  childrenOut <- newIORef SlotStorage.empty
  handlerRef <- newIORef handler
  pendingQueries <- newIORef (Just [])
  pendingOuts <- newIORef (Just [])
  pendingHandlers <- newIORef Nothing
  fresh <- newIORef 1
  subscriptions <- newIORef (Just mempty)
  forks <- newIORef mempty
  state <- component.initialState input
  let ds =
        DriverState
          { ComponentSpec s f act ps i o m
component :: ComponentSpec s f act ps i o m
component :: ComponentSpec s f act ps i o m
component
          , s
state :: s
state :: s
state
          , refs :: Map Text Element
refs = Map Text Element
forall a. Monoid a => a
mempty
          , children :: SlotStorage ps (DriverStateRef m r)
children = SlotStorage ps (DriverStateRef m r)
forall (slots' :: Row (*)) (slot :: (* -> *) -> * -> *).
SlotStorage slots' slot
SlotStorage.empty
          , IORef (SlotStorage ps (DriverStateRef m r))
childrenIn :: IORef (SlotStorage ps (DriverStateRef m r))
childrenIn :: IORef (SlotStorage ps (DriverStateRef m r))
childrenIn
          , IORef (SlotStorage ps (DriverStateRef m r))
childrenOut :: IORef (SlotStorage ps (DriverStateRef m r))
childrenOut :: IORef (SlotStorage ps (DriverStateRef m r))
childrenOut
          , IORef (DriverState m r s f act ps i o)
selfRef :: IORef (DriverState m r s f act ps i o)
selfRef :: IORef (DriverState m r s f act ps i o)
selfRef
          , IORef (o -> m ())
handlerRef :: IORef (o -> m ())
handlerRef :: IORef (o -> m ())
handlerRef
          , IORef (Maybe [m ()])
pendingQueries :: IORef (Maybe [m ()])
pendingQueries :: IORef (Maybe [m ()])
pendingQueries
          , IORef (Maybe [m ()])
pendingOuts :: IORef (Maybe [m ()])
pendingOuts :: IORef (Maybe [m ()])
pendingOuts
          , IORef (Maybe [m ()])
pendingHandlers :: IORef (Maybe [m ()])
pendingHandlers :: IORef (Maybe [m ()])
pendingHandlers
          , rendering :: Maybe (r s act ps o)
rendering = Maybe (r s act ps o)
forall a. Maybe a
Nothing
          , IORef Int
fresh :: IORef Int
fresh :: IORef Int
fresh
          , IORef (Maybe (Map SubscriptionId (Subscription m)))
subscriptions :: IORef (Maybe (Map SubscriptionId (Subscription m)))
subscriptions :: IORef (Maybe (Map SubscriptionId (Subscription m)))
subscriptions
          , IORef (Map ForkId (Fork m ()))
forks :: IORef (Map ForkId (Fork m ()))
forks :: IORef (Map ForkId (Fork m ()))
forks
          , lifecycleHandlers :: IORef (LifecycleHandlers m)
lifecycleHandlers = IORef (LifecycleHandlers m)
lchs
          }
  atomicWriteIORef selfRef ds
  pure ds