-----------------------------------------------------------------------------
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Reload
-- Copyright   :  (C) 2016-2026 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- = Overview
--
-- "Miso.Reload" supports hot-reloading of miso applications during
-- interactive development with GHC WASM browser mode (@ghciwatch@ +
-- WASM GHCi). It provides two entry points that replace @startApp@ in
-- your @main@:
--
-- ['reload'] clears @\<head\>@ and @\<body\>@ — full reset on every @:r@; model is lost
-- ['live'] clears @\<body\>@ only — model state survives @:r@
--
-- If your top-level t'Component' uses a non-trivial app-global @context@ (see
-- 'Miso.startAppWithContext'), use 'reloadWithContext' \/ 'liveWithContext',
-- which seed the @context@ just as 'Miso.startAppWithContext' does.
--
-- = reload
--
-- Clears both @\<head\>@ and @\<body\>@, kills any running scheduler thread,
-- and re-mounts the component from scratch. All application state is lost.
-- Use this when you are actively changing the @model@ type.
--
-- @
-- main :: IO ()
-- main = 'reload' 'Miso.Event.Types.defaultEvents' app
-- @
--
-- = live
--
-- Clears only @\<body\>@, then re-mounts the component using the __old
-- model__ value recovered from the previous GHCi session via a C-heap
-- stable pointer. @\<head\>@ injections (stylesheets, scripts) from the
-- previous session are preserved.
--
-- @
-- main :: IO ()
-- main = 'live' 'Miso.Event.Types.defaultEvents' app
-- @
--
-- __Warning__: 'live' is unsafe if you change the @model@ type between
-- reloads (adding, removing, or changing a field's type). Such a change
-- will produce a segfault because the old in-memory model is coerced
-- directly into the new type. Use 'reload' whenever you alter the model
-- schema.
--
-- = See also
--
-- * <https://github.com/haskell-miso/miso-sampler miso-sampler> — reference project demonstrating 'live'
-- * "Miso.Runtime" — 'Miso.Runtime.initComponent' and component lifecycle
-- * "Miso.Event.Types" — 'Miso.Event.Types.defaultEvents' used as first argument
----------------------------------------------------------------------------
module Miso.Reload
  ( -- ** Functions
    reload
  , reloadWithContext
  , live
  , liveWithContext
  ) where
-----------------------------------------------------------------------------
import           Control.Concurrent
import           Control.Monad
-----------------------------------------------------------------------------
import           Miso.DSL ((!), jsg, setField)
import qualified Miso.FFI.Internal as FFI
import           Miso.Types (Component(..), Events)
import           Miso.String (MisoString)
import           Miso.Runtime (componentModel, componentContext, initComponent, topLevelComponentId, Hydrate(..))
import           Miso.Runtime.Internal (components, schedulerThread)
-----------------------------------------------------------------------------
import           Miso.Lens
-----------------------------------------------------------------------------
import qualified Data.IntMap.Strict as IM
import           Data.IORef
import           Foreign hiding (void)
import           Foreign.C.Types
#ifdef NATIVE
import           Miso.JSON
#endif
-----------------------------------------------------------------------------
foreign import ccall unsafe "miso_x_store"
  x_store :: StablePtr a -> IO ()
-----------------------------------------------------------------------------
foreign import ccall unsafe "miso_x_get"
  x_get :: IO (StablePtr a)
-----------------------------------------------------------------------------
foreign import ccall unsafe "miso_x_exists"
  x_exists :: IO CInt
-----------------------------------------------------------------------------
foreign import ccall unsafe "miso_x_clear"
  x_clear :: IO ()
-----------------------------------------------------------------------------
#define MISO_JS_PATH "js/miso.js"
-----------------------------------------------------------------------------
-- | Clears the \<body\> and \<head\> on each 'reload'.
--
-- Meant to be used with WASM browser mode.
--
-- @
-- main :: IO ()
-- main = 'reload' 'Miso.Event.Types.defaultEvents' app
-- @
--
-- N.B. This also resets the internal 'Miso.Types.component' state. This means all currently
-- mounted components become unmounted and @ComponentId@ are reset to their
-- original form factory.
--
-- If you'd like to preserve application state between calls to GHCi `:r`, see 'live'.
--
-- @since 1.9.0.0
reload
#ifdef NATIVE
  :: (FromJSON action, ToJSON model, ToJSON action, Eq model)
#else
  :: (Eq model)
#endif
  => Events
  -- ^ Event delegation map (typically 'Miso.Event.Types.defaultEvents')
  -> Component () () model action
  -- ^ Top-level application component to (re-)mount
  -> IO ()
reload :: forall model action.
Eq model =>
Events -> Component () () model action -> IO ()
reload Events
events = Events -> () -> Component () () model action -> IO ()
forall context model action.
(Eq context, Eq model) =>
Events -> context -> Component context () model action -> IO ()
reloadWithContext Events
events ()
-----------------------------------------------------------------------------
-- | Like 'reload', but seeds the app-global React-style @context@ with an
-- initial value (see 'Miso.startAppWithContext').
--
-- Use this instead of 'reload' when your top-level t'Component' uses a
-- non-trivial @context@, since 'reload' fixes the @context@ to @()@.
--
-- @
-- main :: IO ()
-- main = 'reloadWithContext' 'Miso.Event.Types.defaultEvents' Light (static (mount_ app))
-- @
--
-- @since 1.13.0.0
reloadWithContext
#ifdef NATIVE
  :: (FromJSON action, ToJSON model, Eq context, Eq model, ToJSON action)
#else
  :: (Eq context, Eq model)
#endif
  => Events
  -- ^ Event delegation map (typically 'Miso.Event.Types.defaultEvents')
  -> context
  -- ^ Initial app-global @context@
  -> Component context () model action
  -- ^ Top-level application component to (re-)mount
  -> IO ()
reloadWithContext :: forall context model action.
(Eq context, Eq model) =>
Events -> context -> Component context () model action -> IO ()
reloadWithContext Events
events context
initialContext Component context () model action
comp = do
   CInt
exists <- IO CInt
x_exists
   Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
exists CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
     (Any
_, IORef ThreadId
oldSchedulerRef) <- StablePtr (Any, IORef ThreadId) -> IO (Any, IORef ThreadId)
forall a. StablePtr a -> IO a
deRefStablePtr (StablePtr (Any, IORef ThreadId) -> IO (Any, IORef ThreadId))
-> IO (StablePtr (Any, IORef ThreadId)) -> IO (Any, IORef ThreadId)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (StablePtr (Any, IORef ThreadId))
forall a. IO (StablePtr a)
x_get
     ThreadId -> IO ()
killThread (ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef ThreadId -> IO ThreadId
forall a. IORef a -> IO a
readIORef IORef ThreadId
oldSchedulerRef
     IO ()
x_clear
   IO ()
clearPage
   -- 'reload' is a full reset: seed the freshly-supplied context.
   -- ('initComponent' stores it in every component it mounts.)
   IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Events
-> Hydrate
-> Bool
-> context
-> Component context () model action
-> Maybe Key
-> ()
-> Maybe StaticKey
-> IO ()
forall context props model action.
(Eq context, Eq model, Eq props) =>
Events
-> Hydrate
-> Bool
-> context
-> Component context props model action
-> Maybe Key
-> props
-> Maybe StaticKey
-> IO ()
initComponent Events
events Hydrate
Draw Bool
False context
initialContext Component context () model action
comp Maybe Key
forall a. Maybe a
Nothing () Maybe StaticKey
forall a. Maybe a
Nothing)
   StablePtr
  (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId)
-> IO ()
forall a. StablePtr a -> IO ()
x_store (StablePtr
   (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId)
 -> IO ())
-> IO
     (StablePtr
        (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId))
-> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId)
-> IO
     (StablePtr
        (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId))
forall a. a -> IO (StablePtr a)
newStablePtr (IORef (IntMap (ComponentState Any Any Any Any))
forall context props model action.
IORef (IntMap (ComponentState context props model action))
components, IORef ThreadId
schedulerThread)
-----------------------------------------------------------------------------
-- | Live reloading. Persists all t'Component' @model@ between successive GHCi reloads.
--
-- This means application state should persist between GHCi reloads
--
-- Schema changes to @model@ are currently unsupported. If you're
-- changing fields in @model@ (adding, removing, changing a field's type), this
-- will more than likely segfault. If you change the 'Miso.Lens.view' or @update@ functions
-- it will be fine.
--
-- Use 'reload' if you're changing the @model@ frequently and 'live'
-- if you're adjusting the 'Miso.Lens.view' / @update@ function logic.
--
-- @
-- main :: IO ()
-- main = 'live' 'Miso.Event.Types.defaultEvents' app
-- @
--
-- @since 1.9.0.0
live
#ifdef NATIVE
  :: (Eq model, ToJSON model, ToJSON action, FromJSON action)
#else
  :: Eq model
#endif
  => Events
  -- ^ Event delegation map (typically 'Miso.Event.Types.defaultEvents')
  -> Component () () model action
  -- ^ Top-level application component to (re-)mount with preserved model state
  -> IO ()
live :: forall model action.
Eq model =>
Events -> Component () () model action -> IO ()
live Events
events Component () () model action
vcomp_ = Events -> () -> Component () () model action -> IO ()
forall context model action.
(Eq context, Eq model) =>
Events -> context -> Component context () model action -> IO ()
liveWithContext Events
events () Component () () model action
vcomp_
-----------------------------------------------------------------------------
-- | Like 'live', but seeds the app-global React-style @context@ with an
-- initial value (see 'Miso.startAppWithContext').
--
-- Use this instead of 'live' when your top-level t'Component' uses a
-- non-trivial @context@, since 'live' fixes the @context@ to @()@.
--
-- The seeded @context@ is only used on the initial load; on subsequent reloads
-- the preserved @model@ is recovered exactly as with 'live'.
--
-- @
-- main :: IO ()
-- main = 'liveWithContext' 'Miso.Event.Types.defaultEvents' Light (static (mount_ app))
-- @
--
-- @since 1.13.0.0
liveWithContext
#ifdef NATIVE
  :: (Eq context, Eq model, ToJSON model, ToJSON action, FromJSON action)
#else
  :: (Eq context, Eq model)
#endif
  => Events
  -- ^ Event delegation map (typically 'Miso.Event.Types.defaultEvents')
  -> context
  -- ^ Initial app-global @context@
  -> Component context () model action
  -- ^ Top-level application component to (re-)mount with preserved model state
  -> IO ()
liveWithContext :: forall context model action.
(Eq context, Eq model) =>
Events -> context -> Component context () model action -> IO ()
liveWithContext Events
events context
initialContext Component context () model action
vcomp_ = do
      CInt
exists <- IO CInt
x_exists
      if CInt
exists CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
1
        then do
          -- clearBody (only clear the body)
          IO ()
clearBody

          -- Deref old state, update new state, set pointer in C heap.
          (IORef (IntMap (ComponentState context Any model Any))
oldComponentsRef, IORef ThreadId
oldSchedulerRef) <- StablePtr
  (IORef (IntMap (ComponentState context Any model Any)),
   IORef ThreadId)
-> IO
     (IORef (IntMap (ComponentState context Any model Any)),
      IORef ThreadId)
forall a. StablePtr a -> IO a
deRefStablePtr (StablePtr
   (IORef (IntMap (ComponentState context Any model Any)),
    IORef ThreadId)
 -> IO
      (IORef (IntMap (ComponentState context Any model Any)),
       IORef ThreadId))
-> IO
     (StablePtr
        (IORef (IntMap (ComponentState context Any model Any)),
         IORef ThreadId))
-> IO
     (IORef (IntMap (ComponentState context Any model Any)),
      IORef ThreadId)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO
  (StablePtr
     (IORef (IntMap (ComponentState context Any model Any)),
      IORef ThreadId))
forall a. IO (StablePtr a)
x_get
          ThreadId -> IO ()
killThread (ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef ThreadId -> IO ThreadId
forall a. IORef a -> IO a
readIORef IORef ThreadId
oldSchedulerRef

          IntMap (ComponentState context Any model Any)
_oldState <- IORef (IntMap (ComponentState context Any model Any))
-> IO (IntMap (ComponentState context Any model Any))
forall a. IORef a -> IO a
readIORef IORef (IntMap (ComponentState context Any model Any))
oldComponentsRef
          let oldModel :: model
oldModel = (IntMap (ComponentState context Any model Any)
_oldState IntMap (ComponentState context Any model Any)
-> Key -> ComponentState context Any model Any
forall a. IntMap a -> Key -> a
IM.! Key
topLevelComponentId) ComponentState context Any model Any
-> Lens (ComponentState context Any model Any) model -> model
forall record field. record -> Lens record field -> field
^. Lens (ComponentState context Any model Any) model
forall context props model action.
Lens (ComponentState context props model action) model
componentModel
              initialVComp :: Component context () model action
initialVComp = Component context () model action
vcomp_ { model = oldModel }
          -- There is one @context@ cell per app, reached through any component;
          -- the root is the one guaranteed to be present. 'initComponent' below
          -- creates a fresh cell seeded with this value rather than reusing the
          -- old one, so the reloaded tree cannot share a cell with the old.
          context
oldContext <- IORef context -> IO context
forall a. IORef a -> IO a
readIORef ((IntMap (ComponentState context Any model Any)
_oldState IntMap (ComponentState context Any model Any)
-> Key -> ComponentState context Any model Any
forall a. IntMap a -> Key -> a
IM.! Key
topLevelComponentId) ComponentState context Any model Any
-> Lens (ComponentState context Any model Any) (IORef context)
-> IORef context
forall record field. record -> Lens record field -> field
^. Lens (ComponentState context Any model Any) (IORef context)
forall context props model action.
Lens (ComponentState context props model action) (IORef context)
componentContext)

          -- Overwrite new components state with old components state.
          IORef (IntMap (ComponentState context Any model Any))
-> IntMap (ComponentState context Any model Any) -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef IORef (IntMap (ComponentState context Any model Any))
forall context props model action.
IORef (IntMap (ComponentState context props model action))
components IntMap (ComponentState context Any model Any)
_oldState

          -- Perform initial draw, recovering the old model and the old context.
          -- ('initComponent' creates the new cell and seeds it with this value.)
          Events
-> Hydrate
-> Bool
-> context
-> Component context () model action
-> Maybe Key
-> ()
-> Maybe StaticKey
-> IO ()
forall context props model action.
(Eq context, Eq model, Eq props) =>
Events
-> Hydrate
-> Bool
-> context
-> Component context props model action
-> Maybe Key
-> props
-> Maybe StaticKey
-> IO ()
initComponent Events
events Hydrate
Draw Bool
True context
oldContext Component context () model action
initialVComp Maybe Key
forall a. Maybe a
Nothing () Maybe StaticKey
forall a. Maybe a
Nothing

          -- 'cleanup' with @live = True@ deliberately keeps 'components', and
          -- the fresh tree only overwrites the ids it reuses. A reloaded tree
          -- smaller than the previous one therefore leaves entries behind that
          -- still reference the PREVIOUS app's context cell, and the scheduler's
          -- propagation pass would draw them against a context nothing updates
          -- any more. Re-point every surviving entry at the new root's cell so
          -- the whole map shares one cell again. This rewrites references, once
          -- per reload — not values, and not per context change.
          IntMap (ComponentState Any Any Any Any)
newState <- IORef (IntMap (ComponentState Any Any Any Any))
-> IO (IntMap (ComponentState Any Any Any Any))
forall a. IORef a -> IO a
readIORef IORef (IntMap (ComponentState Any Any Any Any))
forall context props model action.
IORef (IntMap (ComponentState context props model action))
components
          Maybe (ComponentState Any Any Any Any)
-> (ComponentState Any Any Any Any -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Key
-> IntMap (ComponentState Any Any Any Any)
-> Maybe (ComponentState Any Any Any Any)
forall a. Key -> IntMap a -> Maybe a
IM.lookup Key
topLevelComponentId IntMap (ComponentState Any Any Any Any)
newState) ((ComponentState Any Any Any Any -> IO ()) -> IO ())
-> (ComponentState Any Any Any Any -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ComponentState Any Any Any Any
root -> do
            let newCell :: IORef Any
newCell = ComponentState Any Any Any Any
root ComponentState Any Any Any Any
-> Lens (ComponentState Any Any Any Any) (IORef Any) -> IORef Any
forall record field. record -> Lens record field -> field
^. Lens (ComponentState Any Any Any Any) (IORef Any)
forall context props model action.
Lens (ComponentState context props model action) (IORef context)
componentContext
            IORef (IntMap (ComponentState Any Any Any Any))
-> (IntMap (ComponentState Any Any Any Any)
    -> (IntMap (ComponentState Any Any Any Any), ()))
-> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (IntMap (ComponentState Any Any Any Any))
forall context props model action.
IORef (IntMap (ComponentState context props model action))
components ((IntMap (ComponentState Any Any Any Any)
  -> (IntMap (ComponentState Any Any Any Any), ()))
 -> IO ())
-> (IntMap (ComponentState Any Any Any Any)
    -> (IntMap (ComponentState Any Any Any Any), ()))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \IntMap (ComponentState Any Any Any Any)
m ->
              ((ComponentState Any Any Any Any -> ComponentState Any Any Any Any)
-> IntMap (ComponentState Any Any Any Any)
-> IntMap (ComponentState Any Any Any Any)
forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map (Lens (ComponentState Any Any Any Any) (IORef Any)
forall context props model action.
Lens (ComponentState context props model action) (IORef context)
componentContext Lens (ComponentState Any Any Any Any) (IORef Any)
-> IORef Any
-> ComponentState Any Any Any Any
-> ComponentState Any Any Any Any
forall record field. Lens record field -> field -> record -> record
.~ IORef Any
newCell) IntMap (ComponentState Any Any Any Any)
m, ())

          -- Don't forget to flush (native mobile needs this too)
          IO ()
FFI.flush

          -- Clear and set static ptr to use new state (new CAF state)
          IO ()
x_clear
          StablePtr
  (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId)
-> IO ()
forall a. StablePtr a -> IO ()
x_store (StablePtr
   (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId)
 -> IO ())
-> IO
     (StablePtr
        (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId))
-> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId)
-> IO
     (StablePtr
        (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId))
forall a. a -> IO (StablePtr a)
newStablePtr (IORef (IntMap (ComponentState Any Any Any Any))
forall context props model action.
IORef (IntMap (ComponentState context props model action))
components, IORef ThreadId
schedulerThread)
        else do
          -- This means it is initial load, just store the pointer.
          IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Events
-> Hydrate
-> Bool
-> context
-> Component context () model action
-> Maybe Key
-> ()
-> Maybe StaticKey
-> IO ()
forall context props model action.
(Eq context, Eq model, Eq props) =>
Events
-> Hydrate
-> Bool
-> context
-> Component context props model action
-> Maybe Key
-> props
-> Maybe StaticKey
-> IO ()
initComponent Events
events Hydrate
Draw Bool
False context
initialContext Component context () model action
vcomp_ Maybe Key
forall a. Maybe a
Nothing () Maybe StaticKey
forall a. Maybe a
Nothing)
          StablePtr
  (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId)
-> IO ()
forall a. StablePtr a -> IO ()
x_store (StablePtr
   (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId)
 -> IO ())
-> IO
     (StablePtr
        (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId))
-> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId)
-> IO
     (StablePtr
        (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId))
forall a. a -> IO (StablePtr a)
newStablePtr (IORef (IntMap (ComponentState Any Any Any Any))
forall context props model action.
IORef (IntMap (ComponentState context props model action))
components, IORef ThreadId
schedulerThread)
-----------------------------------------------------------------------------
clearPage, clearBody, clearHead :: IO ()
clearPage :: IO ()
clearPage = IO ()
clearBody IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
clearHead
clearBody :: IO ()
clearBody = do
  JSVal
body_ <- MisoString -> IO JSVal
jsg MisoString
"document" IO JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! (MisoString
"body" :: MisoString)
  JSVal -> MisoString -> MisoString -> IO ()
forall o v.
(ToObject o, ToJSVal v) =>
o -> MisoString -> v -> IO ()
setField JSVal
body_ MisoString
"innerHTML" (MisoString
"" :: MisoString)
clearHead :: IO ()
clearHead = do
  JSVal
head_ <- MisoString -> IO JSVal
jsg MisoString
"document" IO JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! (MisoString
"head" :: MisoString)
  JSVal -> MisoString -> MisoString -> IO ()
forall o v.
(ToObject o, ToJSVal v) =>
o -> MisoString -> v -> IO ()
setField JSVal
head_ MisoString
"innerHTML" (MisoString
"" :: MisoString)
-----------------------------------------------------------------------------