module Halogen.VDom.DOM
  ( VDomSpec (..)
  , buildVDom
  , buildText
  , buildElem
  , buildWidget
  , buildKeyed
  )
where

import HPrelude hiding (state)
import Halogen.VDom.DOM.Monad
import Halogen.VDom.Machine
import Halogen.VDom.Types
import Halogen.VDom.Utils
import Web.DOM.Element
import Web.DOM.Internal.Types
import Web.DOM.ParentNode

#if defined(javascript_HOST_ARCH)
{-# SPECIALISE buildVDom :: VDomSpec IO a w -> VDomMachine IO a w #-}
{-# SPECIALISE buildText :: VDomSpec IO a w -> VDomMachine IO a w -> Text -> IO (VDomStep IO a w) #-}
{-# SPECIALISE patchText :: TextState IO a w -> VDom a w -> IO (VDomStep IO a w) #-}
{-# SPECIALISE haltText :: TextState IO a w -> IO () #-}
{-# SPECIALISE buildKeyed :: VDomSpec IO a w -> VDomMachine IO a w -> Maybe Namespace -> ElemName -> a -> [(Text, VDom a w)] -> IO (VDomStep IO a w) #-}
{-# SPECIALISE patchKeyed :: KeyedState IO a w -> VDom a w -> IO (VDomStep IO a w) #-}
{-# SPECIALISE haltKeyed :: KeyedState IO a w -> IO () #-}
{-# SPECIALISE buildElem :: VDomSpec IO a w -> VDomMachine IO a w -> Maybe Namespace -> ElemName -> a -> [VDom a w] -> IO (VDomStep IO a w) #-}
{-# SPECIALISE patchElem :: ElemState IO a w -> VDom a w -> IO (VDomStep IO a w) #-}
{-# SPECIALISE haltElem :: ElemState IO a w -> IO () #-}
{-# SPECIALISE buildWidget :: VDomSpec IO a w -> VDomMachine IO a w -> w -> IO (VDomStep IO a w) #-}
{-# SPECIALISE patchWidget :: WidgetState IO a w -> VDom a w -> IO (VDomStep IO a w) #-}
#endif

type VDomMachine m a w = Machine m (VDom a w) Node

type VDomStep m a w = Step m (VDom a w) Node

data VDomSpec m a w = VDomSpec
  { forall (m :: * -> *) a w.
VDomSpec m a w -> VDomSpec m a w -> Machine m w Node
buildWidget :: VDomSpec m a w -> Machine m w Node
  , forall (m :: * -> *) a w.
VDomSpec m a w -> Element -> Machine m a ()
buildAttributes :: Element -> Machine m a ()
  , forall (m :: * -> *) a w. VDomSpec m a w -> Document
document :: Document
  }

buildVDom :: (MonadDOM m) => VDomSpec m a w -> VDomMachine m a w
buildVDom :: forall (m :: * -> *) a w.
MonadDOM m =>
VDomSpec m a w -> VDomMachine m a w
buildVDom VDomSpec m a w
spec = VDomMachine m a w
build
  where
    build :: VDomMachine m a w
build = \case
      Text Text
txt -> VDomSpec m a w -> VDomMachine m a w -> Text -> m (VDomStep m a w)
forall (m :: * -> *) a w.
MonadDOM m =>
VDomSpec m a w -> VDomMachine m a w -> Text -> m (VDomStep m a w)
buildText VDomSpec m a w
spec VDomMachine m a w
build Text
txt
      Elem Maybe Namespace
ns ElemName
n a
props [VDom a w]
children -> VDomSpec m a w
-> VDomMachine m a w
-> Maybe Namespace
-> ElemName
-> a
-> [VDom a w]
-> m (VDomStep m a w)
forall (m :: * -> *) a w.
MonadDOM m =>
VDomSpec m a w
-> VDomMachine m a w
-> Maybe Namespace
-> ElemName
-> a
-> [VDom a w]
-> m (VDomStep m a w)
buildElem VDomSpec m a w
spec VDomMachine m a w
build Maybe Namespace
ns ElemName
n a
props [VDom a w]
children
      Keyed Maybe Namespace
ns ElemName
n a
props [(Text, VDom a w)]
children -> VDomSpec m a w
-> VDomMachine m a w
-> Maybe Namespace
-> ElemName
-> a
-> [(Text, VDom a w)]
-> m (VDomStep m a w)
forall (m :: * -> *) a w.
MonadDOM m =>
VDomSpec m a w
-> VDomMachine m a w
-> Maybe Namespace
-> ElemName
-> a
-> [(Text, VDom a w)]
-> m (VDomStep m a w)
buildKeyed VDomSpec m a w
spec VDomMachine m a w
build Maybe Namespace
ns ElemName
n a
props [(Text, VDom a w)]
children
      Widget w
w -> VDomSpec m a w -> VDomMachine m a w -> w -> m (VDomStep m a w)
forall (m :: * -> *) a w.
Monad m =>
VDomSpec m a w -> VDomMachine m a w -> w -> m (VDomStep m a w)
buildWidget VDomSpec m a w
spec VDomMachine m a w
build w
w
      Grafted Graft a w
g -> VDomMachine m a w
build (Graft a w -> VDom a w
forall a w. Graft a w -> VDom a w
runGraft Graft a w
g)

----------------------------------------------------------------------

data TextState m a w = TextState
  { forall (m :: * -> *) a w. TextState m a w -> VDomMachine m a w
build :: VDomMachine m a w
  , forall (m :: * -> *) a w. TextState m a w -> Node
node :: Node
  , forall (m :: * -> *) a w. TextState m a w -> Text
value :: Text
  }

buildText :: (MonadDOM m) => VDomSpec m a w -> VDomMachine m a w -> Text -> m (VDomStep m a w)
buildText :: forall (m :: * -> *) a w.
MonadDOM m =>
VDomSpec m a w -> VDomMachine m a w -> Text -> m (VDomStep m a w)
buildText VDomSpec m a w
spec VDomMachine m a w
build Text
value = do
  node <- Text -> Document -> m Node
forall (m :: * -> *). MonadDOM m => Text -> Document -> m Node
createTextNode Text
value VDomSpec m a w
spec.document
  let state = TextState {Text
Node
VDomMachine m a w
build :: VDomMachine m a w
node :: Node
value :: Text
build :: VDomMachine m a w
value :: Text
node :: Node
..}
  pure $ Step node state patchText haltText

patchText :: (MonadDOM m) => TextState m a w -> VDom a w -> m (VDomStep m a w)
patchText :: forall (m :: * -> *) a w.
MonadDOM m =>
TextState m a w -> VDom a w -> m (VDomStep m a w)
patchText TextState m a w
state VDom a w
vdom = do
  let TextState {VDomMachine m a w
build :: forall (m :: * -> *) a w. TextState m a w -> VDomMachine m a w
build :: VDomMachine m a w
build, Node
node :: forall (m :: * -> *) a w. TextState m a w -> Node
node :: Node
node, value :: forall (m :: * -> *) a w. TextState m a w -> Text
value = Text
value1} = TextState m a w
state
  case VDom a w
vdom of
    Text Text
value2
      | Text
value1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
value2 ->
          VDomStep m a w -> m (VDomStep m a w)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VDomStep m a w -> m (VDomStep m a w))
-> VDomStep m a w -> m (VDomStep m a w)
forall a b. (a -> b) -> a -> b
$ Node
-> TextState m a w
-> (TextState m a w -> VDomMachine m a w)
-> (TextState m a w -> m ())
-> VDomStep m a w
forall (m :: * -> *) a b s.
b -> s -> (s -> a -> m (Step m a b)) -> (s -> m ()) -> Step m a b
Step Node
node TextState m a w
state TextState m a w -> VDomMachine m a w
forall (m :: * -> *) a w.
MonadDOM m =>
TextState m a w -> VDom a w -> m (VDomStep m a w)
patchText TextState m a w -> m ()
forall (m :: * -> *) a w. MonadDOM m => TextState m a w -> m ()
haltText
      | Bool
otherwise -> do
          let nextState :: TextState m a w
nextState = TextState {VDomMachine m a w
build :: VDomMachine m a w
build :: VDomMachine m a w
build, Node
node :: Node
node :: Node
node, value :: Text
value = Text
value2}
          Text -> Node -> m ()
forall (m :: * -> *). MonadDOM m => Text -> Node -> m ()
setTextContent Text
value2 Node
node
          VDomStep m a w -> m (VDomStep m a w)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VDomStep m a w -> m (VDomStep m a w))
-> VDomStep m a w -> m (VDomStep m a w)
forall a b. (a -> b) -> a -> b
$ Node
-> TextState m a w
-> (TextState m a w -> VDomMachine m a w)
-> (TextState m a w -> m ())
-> VDomStep m a w
forall (m :: * -> *) a b s.
b -> s -> (s -> a -> m (Step m a b)) -> (s -> m ()) -> Step m a b
Step Node
node TextState m a w
nextState TextState m a w -> VDomMachine m a w
forall (m :: * -> *) a w.
MonadDOM m =>
TextState m a w -> VDom a w -> m (VDomStep m a w)
patchText TextState m a w -> m ()
forall (m :: * -> *) a w. MonadDOM m => TextState m a w -> m ()
haltText
    VDom a w
_ -> do
      TextState m a w -> m ()
forall (m :: * -> *) a w. MonadDOM m => TextState m a w -> m ()
haltText TextState m a w
state
      VDomMachine m a w
build VDom a w
vdom

haltText :: (MonadDOM m) => TextState m a w -> m ()
haltText :: forall (m :: * -> *) a w. MonadDOM m => TextState m a w -> m ()
haltText TextState {Node
node :: forall (m :: * -> *) a w. TextState m a w -> Node
node :: Node
node} =
  (ParentNode -> m ()) -> Maybe ParentNode -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Node -> ParentNode -> m ()
forall (m :: * -> *). MonadDOM m => Node -> ParentNode -> m ()
removeChild Node
node) (Maybe ParentNode -> m ()) -> m (Maybe ParentNode) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Node -> m (Maybe ParentNode)
forall (m :: * -> *). MonadDOM m => Node -> m (Maybe ParentNode)
parentNode Node
node

----------------------------------------------------------------------

data KeyedState m a w = KeyedState
  { forall (m :: * -> *) a w. KeyedState m a w -> VDomMachine m a w
build :: VDomMachine m a w
  , forall (m :: * -> *) a w. KeyedState m a w -> Node
node :: Node
  , forall (m :: * -> *) a w. KeyedState m a w -> Step m a ()
attrs :: Step m a ()
  , forall (m :: * -> *) a w. KeyedState m a w -> Maybe Namespace
ns :: Maybe Namespace
  , forall (m :: * -> *) a w. KeyedState m a w -> ElemName
name :: ElemName
  , forall (m :: * -> *) a w.
KeyedState m a w -> Map Text (VDomStep m a w)
children :: Map Text (VDomStep m a w)
  , forall (m :: * -> *) a w. KeyedState m a w -> Int
length :: Int
  }

buildKeyed :: (MonadDOM m) => VDomSpec m a w -> VDomMachine m a w -> Maybe Namespace -> ElemName -> a -> [(Text, VDom a w)] -> m (VDomStep m a w)
buildKeyed :: forall (m :: * -> *) a w.
MonadDOM m =>
VDomSpec m a w
-> VDomMachine m a w
-> Maybe Namespace
-> ElemName
-> a
-> [(Text, VDom a w)]
-> m (VDomStep m a w)
buildKeyed VDomSpec m a w
spec VDomMachine m a w
build Maybe Namespace
ns1 ElemName
name1 a
as1 [(Text, VDom a w)]
ch1 = do
  el <- Maybe Namespace -> ElemName -> Document -> m Element
forall (m :: * -> *).
MonadDOM m =>
Maybe Namespace -> ElemName -> Document -> m Element
createElement Maybe Namespace
ns1 ElemName
name1 VDomSpec m a w
spec.document
  let node = Element -> Node
elementToNode Element
el
      onChild Text
_ Int
ix (Text
_, VDom a w
vdom) = do
        res <- VDomMachine m a w
build VDom a w
vdom
        insertChildIx ix (extract res) $ toParentNode node
        pure res
  children <- strMapWithIxE ch1 fst onChild
  attrs <- spec.buildAttributes el as1
  let state =
        KeyedState
          { VDomMachine m a w
build :: VDomMachine m a w
build :: VDomMachine m a w
build
          , Node
node :: Node
node :: Node
node
          , Step m a ()
attrs :: Step m a ()
attrs :: Step m a ()
attrs
          , ns :: Maybe Namespace
ns = Maybe Namespace
ns1
          , name :: ElemName
name = ElemName
name1
          , Map Text (Step m (VDom a w) Node)
children :: Map Text (Step m (VDom a w) Node)
children :: Map Text (Step m (VDom a w) Node)
children
          , length :: Int
length = [(Text, VDom a w)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, VDom a w)]
ch1
          }
  pure $ Step node state patchKeyed haltKeyed

patchKeyed :: (MonadDOM m) => KeyedState m a w -> VDom a w -> m (VDomStep m a w)
patchKeyed :: forall (m :: * -> *) a w.
MonadDOM m =>
KeyedState m a w -> VDom a w -> m (VDomStep m a w)
patchKeyed KeyedState m a w
state VDom a w
vdom = do
  let KeyedState {VDomMachine m a w
build :: forall (m :: * -> *) a w. KeyedState m a w -> VDomMachine m a w
build :: VDomMachine m a w
build, Node
node :: forall (m :: * -> *) a w. KeyedState m a w -> Node
node :: Node
node, Step m a ()
attrs :: forall (m :: * -> *) a w. KeyedState m a w -> Step m a ()
attrs :: Step m a ()
attrs, ns :: forall (m :: * -> *) a w. KeyedState m a w -> Maybe Namespace
ns = Maybe Namespace
ns1, name :: forall (m :: * -> *) a w. KeyedState m a w -> ElemName
name = ElemName
name1, children :: forall (m :: * -> *) a w.
KeyedState m a w -> Map Text (VDomStep m a w)
children = Map Text (VDomStep m a w)
ch1, length :: forall (m :: * -> *) a w. KeyedState m a w -> Int
length = Int
len1} = KeyedState m a w
state
  case VDom a w
vdom of
    Grafted Graft a w
g ->
      KeyedState m a w -> VDomMachine m a w
forall (m :: * -> *) a w.
MonadDOM m =>
KeyedState m a w -> VDom a w -> m (VDomStep m a w)
patchKeyed KeyedState m a w
state (Graft a w -> VDom a w
forall a w. Graft a w -> VDom a w
runGraft Graft a w
g)
    Keyed Maybe Namespace
ns2 ElemName
name2 a
as2 [(Text, VDom a w)]
ch2 | (Maybe Namespace
ns1, ElemName
name1) (Maybe Namespace, ElemName) -> (Maybe Namespace, ElemName) -> Bool
forall a. Eq a => a -> a -> Bool
== (Maybe Namespace
ns2, ElemName
name2) ->
      case (Int
len1, [(Text, VDom a w)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, VDom a w)]
ch2) of
        (Int
0, Int
0) -> do
          attrs2 <- Step m a () -> a -> m (Step m a ())
forall (m :: * -> *) a b. Step m a b -> a -> m (Step m a b)
step Step m a ()
attrs a
as2
          let nextState =
                KeyedState
                  { VDomMachine m a w
build :: VDomMachine m a w
build :: VDomMachine m a w
build
                  , Node
node :: Node
node :: Node
node
                  , attrs :: Step m a ()
attrs = Step m a ()
attrs2
                  , ns :: Maybe Namespace
ns = Maybe Namespace
ns2
                  , name :: ElemName
name = ElemName
name2
                  , children :: Map Text (VDomStep m a w)
children = Map Text (VDomStep m a w)
ch1
                  , length :: Int
length = Int
0
                  }
          pure $ Step node nextState patchKeyed haltKeyed
        (Int
_, Int
len2) -> do
          let onThese :: Text
-> Int -> VDomStep m a w -> (Text, VDom a w) -> m (VDomStep m a w)
onThese Text
_ Int
ix' VDomStep m a w
s (Text
_, VDom a w
v) = do
                res <- VDomStep m a w -> VDomMachine m a w
forall (m :: * -> *) a b. Step m a b -> a -> m (Step m a b)
step VDomStep m a w
s VDom a w
v
                insertChildIx ix' (extract res) $ toParentNode node
                pure res
              onThis :: p -> Step m a b -> m ()
onThis p
_ = Step m a b -> m ()
forall (m :: * -> *) a b. Step m a b -> m ()
halt
              onThat :: Text -> Int -> (Text, VDom a w) -> m (VDomStep m a w)
onThat Text
_ Int
ix (Text
_, VDom a w
v) = do
                res <- VDomMachine m a w
build VDom a w
v
                insertChildIx ix (extract res) $ toParentNode node
                pure res
          children2 <- Map Text (VDomStep m a w)
-> [(Text, VDom a w)]
-> ((Text, VDom a w) -> Text)
-> (Text
    -> Int -> VDomStep m a w -> (Text, VDom a w) -> m (VDomStep m a w))
-> (Text -> VDomStep m a w -> m ())
-> (Text -> Int -> (Text, VDom a w) -> m (VDomStep m a w))
-> m (Map Text (VDomStep m a w))
forall (m :: * -> *) a b c d.
Monad m =>
Map Text a
-> [b]
-> (b -> Text)
-> (Text -> Int -> a -> b -> m c)
-> (Text -> a -> m d)
-> (Text -> Int -> b -> m c)
-> m (Map Text c)
diffWithKeyAndIxE Map Text (VDomStep m a w)
ch1 [(Text, VDom a w)]
ch2 (Text, VDom a w) -> Text
forall a b. (a, b) -> a
fst Text
-> Int -> VDomStep m a w -> (Text, VDom a w) -> m (VDomStep m a w)
onThese Text -> VDomStep m a w -> m ()
forall {p} {m :: * -> *} {a} {b}. p -> Step m a b -> m ()
onThis Text -> Int -> (Text, VDom a w) -> m (VDomStep m a w)
onThat
          attrs2 <- step attrs as2
          let nextState =
                KeyedState
                  { VDomMachine m a w
build :: VDomMachine m a w
build :: VDomMachine m a w
build
                  , Node
node :: Node
node :: Node
node
                  , attrs :: Step m a ()
attrs = Step m a ()
attrs2
                  , ns :: Maybe Namespace
ns = Maybe Namespace
ns2
                  , name :: ElemName
name = ElemName
name2
                  , children :: Map Text (VDomStep m a w)
children = Map Text (VDomStep m a w)
children2
                  , length :: Int
length = Int
len2
                  }
          pure $ Step node nextState patchKeyed haltKeyed
    VDom a w
_ -> do
      KeyedState m a w -> m ()
forall (m :: * -> *) a w. MonadDOM m => KeyedState m a w -> m ()
haltKeyed KeyedState m a w
state
      VDomMachine m a w
build VDom a w
vdom

haltKeyed :: (MonadDOM m) => KeyedState m a w -> m ()
haltKeyed :: forall (m :: * -> *) a w. MonadDOM m => KeyedState m a w -> m ()
haltKeyed (KeyedState {Node
node :: forall (m :: * -> *) a w. KeyedState m a w -> Node
node :: Node
node, Step m a ()
attrs :: forall (m :: * -> *) a w. KeyedState m a w -> Step m a ()
attrs :: Step m a ()
attrs, Map Text (VDomStep m a w)
children :: forall (m :: * -> *) a w.
KeyedState m a w -> Map Text (VDomStep m a w)
children :: Map Text (VDomStep m a w)
children}) = do
  parent <- Node -> m (Maybe ParentNode)
forall (m :: * -> *). MonadDOM m => Node -> m (Maybe ParentNode)
parentNode Node
node
  traverse_ (removeChild node) parent
  for_ children halt
  halt attrs

----------------------------------------------------------------------

data ElemState m a w = ElemState
  { forall (m :: * -> *) a w. ElemState m a w -> VDomMachine m a w
build :: VDomMachine m a w
  , forall (m :: * -> *) a w. ElemState m a w -> Node
node :: Node
  , forall (m :: * -> *) a w. ElemState m a w -> Step m a ()
attrs :: Step m a ()
  , forall (m :: * -> *) a w. ElemState m a w -> Maybe Namespace
ns :: Maybe Namespace
  , forall (m :: * -> *) a w. ElemState m a w -> ElemName
name :: ElemName
  , forall (m :: * -> *) a w. ElemState m a w -> [VDomStep m a w]
children :: [VDomStep m a w]
  }

buildElem
  :: (MonadDOM m)
  => VDomSpec m a w
  -> VDomMachine m a w
  -> Maybe Namespace
  -> ElemName
  -> a
  -> [VDom a w]
  -> m (VDomStep m a w)
buildElem :: forall (m :: * -> *) a w.
MonadDOM m =>
VDomSpec m a w
-> VDomMachine m a w
-> Maybe Namespace
-> ElemName
-> a
-> [VDom a w]
-> m (VDomStep m a w)
buildElem VDomSpec m a w
spec VDomMachine m a w
build Maybe Namespace
ns1 ElemName
name1 a
as1 [VDom a w]
ch1 = do
  el <- Maybe Namespace -> ElemName -> Document -> m Element
forall (m :: * -> *).
MonadDOM m =>
Maybe Namespace -> ElemName -> Document -> m Element
createElement Maybe Namespace
ns1 ElemName
name1 VDomSpec m a w
spec.document
  let node = Element -> Node
elementToNode Element
el
      onChild Int
ix VDom a w
child = do
        res <- VDomMachine m a w
build VDom a w
child
        insertChildIx ix (extract res) $ toParentNode node
        pure res

  children <- for (zip [0 ..] ch1) (uncurry onChild)
  attrs <- spec.buildAttributes el as1
  let state = ElemState {VDomMachine m a w
build :: VDomMachine m a w
build :: VDomMachine m a w
build, Node
node :: Node
node :: Node
node, Step m a ()
attrs :: Step m a ()
attrs :: Step m a ()
attrs, ns :: Maybe Namespace
ns = Maybe Namespace
ns1, name :: ElemName
name = ElemName
name1, [Step m (VDom a w) Node]
children :: [Step m (VDom a w) Node]
children :: [Step m (VDom a w) Node]
children}
  pure $ Step node state patchElem haltElem

patchElem :: (MonadDOM m) => ElemState m a w -> VDom a w -> m (VDomStep m a w)
patchElem :: forall (m :: * -> *) a w.
MonadDOM m =>
ElemState m a w -> VDom a w -> m (VDomStep m a w)
patchElem ElemState m a w
state VDom a w
vdom = do
  let ElemState {VDomMachine m a w
build :: forall (m :: * -> *) a w. ElemState m a w -> VDomMachine m a w
build :: VDomMachine m a w
build, Node
node :: forall (m :: * -> *) a w. ElemState m a w -> Node
node :: Node
node, Step m a ()
attrs :: forall (m :: * -> *) a w. ElemState m a w -> Step m a ()
attrs :: Step m a ()
attrs, ns :: forall (m :: * -> *) a w. ElemState m a w -> Maybe Namespace
ns = Maybe Namespace
ns1, name :: forall (m :: * -> *) a w. ElemState m a w -> ElemName
name = ElemName
name1, children :: forall (m :: * -> *) a w. ElemState m a w -> [VDomStep m a w]
children = [VDomStep m a w]
ch1} = ElemState m a w
state
  case VDom a w
vdom of
    Grafted Graft a w
g ->
      ElemState m a w -> VDomMachine m a w
forall (m :: * -> *) a w.
MonadDOM m =>
ElemState m a w -> VDom a w -> m (VDomStep m a w)
patchElem ElemState m a w
state (Graft a w -> VDom a w
forall a w. Graft a w -> VDom a w
runGraft Graft a w
g)
    Elem Maybe Namespace
ns2 ElemName
name2 a
as2 [VDom a w]
ch2 | (Maybe Namespace
ns1, ElemName
name1) (Maybe Namespace, ElemName) -> (Maybe Namespace, ElemName) -> Bool
forall a. Eq a => a -> a -> Bool
== (Maybe Namespace
ns2, ElemName
name2) ->
      case ([VDomStep m a w]
ch1, [VDom a w]
ch2) of
        ([], []) -> do
          attrs2 <- Step m a () -> a -> m (Step m a ())
forall (m :: * -> *) a b. Step m a b -> a -> m (Step m a b)
step Step m a ()
attrs a
as2
          let nextState = ElemState {attrs :: Step m a ()
attrs = Step m a ()
attrs2, ns :: Maybe Namespace
ns = Maybe Namespace
ns2, name :: ElemName
name = ElemName
name2, children :: [VDomStep m a w]
children = [VDomStep m a w]
ch1, Node
VDomMachine m a w
build :: VDomMachine m a w
node :: Node
build :: VDomMachine m a w
node :: Node
..}
          pure $ Step node nextState patchElem haltElem
        ([VDomStep m a w], [VDom a w])
_ -> do
          let onThese :: Int -> VDomStep m a w -> VDom a w -> m (Maybe (VDomStep m a w))
onThese Int
ix VDomStep m a w
s VDom a w
v = do
                res <- VDomStep m a w -> VDomMachine m a w
forall (m :: * -> *) a b. Step m a b -> a -> m (Step m a b)
step VDomStep m a w
s VDom a w
v
                insertChildIx ix (extract res) $ toParentNode node
                pure $ Just res
              onThis :: p -> Step f a b -> f (Maybe a)
onThis p
_ Step f a b
s = Step f a b -> f ()
forall (m :: * -> *) a b. Step m a b -> m ()
halt Step f a b
s f () -> Maybe a -> f (Maybe a)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe a
forall a. Maybe a
Nothing
              onThat :: Int -> VDom a w -> m (Maybe (VDomStep m a w))
onThat Int
ix VDom a w
v = do
                res <- VDomMachine m a w
build VDom a w
v
                insertChildIx ix (extract res) $ toParentNode node
                pure $ Just res
          children2 <- [VDomStep m a w]
-> [VDom a w]
-> (Int
    -> VDomStep m a w -> VDom a w -> m (Maybe (VDomStep m a w)))
-> (Int -> VDomStep m a w -> m (Maybe (VDomStep m a w)))
-> (Int -> VDom a w -> m (Maybe (VDomStep m a w)))
-> m [VDomStep m a w]
forall (m :: * -> *) b c d.
Monad m =>
[b]
-> [c]
-> (Int -> b -> c -> m (Maybe d))
-> (Int -> b -> m (Maybe d))
-> (Int -> c -> m (Maybe d))
-> m [d]
diffWithIxE [VDomStep m a w]
ch1 [VDom a w]
ch2 Int -> VDomStep m a w -> VDom a w -> m (Maybe (VDomStep m a w))
onThese Int -> VDomStep m a w -> m (Maybe (VDomStep m a w))
forall {f :: * -> *} {p} {a} {b} {a}.
Functor f =>
p -> Step f a b -> f (Maybe a)
onThis Int -> VDom a w -> m (Maybe (VDomStep m a w))
onThat
          attrs2 <- step attrs as2
          let nextState = ElemState {attrs :: Step m a ()
attrs = Step m a ()
attrs2, ns :: Maybe Namespace
ns = Maybe Namespace
ns2, name :: ElemName
name = ElemName
name2, children :: [VDomStep m a w]
children = [VDomStep m a w]
children2, Node
VDomMachine m a w
build :: VDomMachine m a w
node :: Node
build :: VDomMachine m a w
node :: Node
..}
          pure $ Step node nextState patchElem haltElem
    VDom a w
_ -> do
      ElemState m a w -> m ()
forall (m :: * -> *) a w. MonadDOM m => ElemState m a w -> m ()
haltElem ElemState m a w
state
      VDomMachine m a w
build VDom a w
vdom

haltElem :: (MonadDOM m) => ElemState m a w -> m ()
haltElem :: forall (m :: * -> *) a w. MonadDOM m => ElemState m a w -> m ()
haltElem ElemState {Node
node :: forall (m :: * -> *) a w. ElemState m a w -> Node
node :: Node
node, Step m a ()
attrs :: forall (m :: * -> *) a w. ElemState m a w -> Step m a ()
attrs :: Step m a ()
attrs, [VDomStep m a w]
children :: forall (m :: * -> *) a w. ElemState m a w -> [VDomStep m a w]
children :: [VDomStep m a w]
children} = do
  (ParentNode -> m ()) -> Maybe ParentNode -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Node -> ParentNode -> m ()
forall (m :: * -> *). MonadDOM m => Node -> ParentNode -> m ()
removeChild Node
node) (Maybe ParentNode -> m ()) -> m (Maybe ParentNode) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Node -> m (Maybe ParentNode)
forall (m :: * -> *). MonadDOM m => Node -> m (Maybe ParentNode)
parentNode Node
node
  [VDomStep m a w] -> (VDomStep m a w -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [VDomStep m a w]
children VDomStep m a w -> m ()
forall (m :: * -> *) a b. Step m a b -> m ()
halt
  Step m a () -> m ()
forall (m :: * -> *) a b. Step m a b -> m ()
halt Step m a ()
attrs

----------------------------------------------------------------------

data WidgetState m a w = WidgetState
  { forall (m :: * -> *) a w. WidgetState m a w -> VDomMachine m a w
build :: VDomMachine m a w
  , forall (m :: * -> *) a w. WidgetState m a w -> Step m w Node
widget :: Step m w Node
  }

buildWidget :: (Monad m) => VDomSpec m a w -> VDomMachine m a w -> w -> m (VDomStep m a w)
buildWidget :: forall (m :: * -> *) a w.
Monad m =>
VDomSpec m a w -> VDomMachine m a w -> w -> m (VDomStep m a w)
buildWidget VDomSpec m a w
spec VDomMachine m a w
build w
w = do
  res@(Step node _ _ _) <- VDomSpec m a w
spec.buildWidget VDomSpec m a w
spec w
w
  pure $ Step node (WidgetState {build, widget = res}) patchWidget haltWidget

patchWidget :: (Monad m) => WidgetState m a w -> VDom a w -> m (VDomStep m a w)
patchWidget :: forall (m :: * -> *) a w.
Monad m =>
WidgetState m a w -> VDom a w -> m (VDomStep m a w)
patchWidget WidgetState m a w
state VDom a w
vdom = do
  let WidgetState {VDomMachine m a w
build :: forall (m :: * -> *) a w. WidgetState m a w -> VDomMachine m a w
build :: VDomMachine m a w
build, Step m w Node
widget :: forall (m :: * -> *) a w. WidgetState m a w -> Step m w Node
widget :: Step m w Node
widget} = WidgetState m a w
state
  case VDom a w
vdom of
    Grafted Graft a w
g -> WidgetState m a w -> VDomMachine m a w
forall (m :: * -> *) a w.
Monad m =>
WidgetState m a w -> VDom a w -> m (VDomStep m a w)
patchWidget WidgetState m a w
state (Graft a w -> VDom a w
forall a w. Graft a w -> VDom a w
runGraft Graft a w
g)
    Widget w
w -> do
      res@(Step n _ _ _) <- Step m w Node -> w -> m (Step m w Node)
forall (m :: * -> *) a b. Step m a b -> a -> m (Step m a b)
step Step m w Node
widget w
w

      pure $ Step n (WidgetState {build, widget = res}) patchWidget haltWidget
    VDom a w
_ -> do
      WidgetState m a w -> m ()
forall (m :: * -> *) a w. WidgetState m a w -> m ()
haltWidget WidgetState m a w
state
      VDomMachine m a w
build VDom a w
vdom

haltWidget :: WidgetState m a w -> m ()
haltWidget :: forall (m :: * -> *) a w. WidgetState m a w -> m ()
haltWidget WidgetState {Step m w Node
widget :: forall (m :: * -> *) a w. WidgetState m a w -> Step m w Node
widget :: Step m w Node
widget} = Step m w Node -> m ()
forall (m :: * -> *) a b. Step m a b -> m ()
halt Step m w Node
widget