-----------------------------------------------------------------------------
{-# 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 action model.
(FromJSON action, ToJSON model, ToJSON action, Eq model) =>
Events -> Component () () model action -> IO ()
reload Events
events = Events -> () -> Component () () model action -> IO ()
forall action model context.
(FromJSON action, ToJSON model, Eq context, Eq model,
 ToJSON action) =>
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 action model context.
(FromJSON action, ToJSON model, Eq context, Eq model,
 ToJSON action) =>
Events -> context -> Component context () model action -> IO ()
reloadWithContext Events
events context
initialContext Component context () model action
comp = do
   exists <- IO CInt
x_exists
   when (exists == 1) $ do
     (_, oldSchedulerRef) <- deRefStablePtr =<< x_get
     killThread =<< readIORef oldSchedulerRef
     x_clear
   clearPage
   -- 'reload' is a full reset: seed the freshly-supplied context.
   -- ('initComponent' stores it in every component it mounts.)
   void (initComponent events Draw False initialContext comp Nothing () Nothing)
   x_store =<< newStablePtr (components, 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, ToJSON model, ToJSON action, FromJSON action) =>
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, ToJSON model, ToJSON action,
 FromJSON action) =>
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, ToJSON model, ToJSON action,
 FromJSON action) =>
Events -> context -> Component context () model action -> IO ()
liveWithContext Events
events context
initialContext Component context () model action
vcomp_ = do
      exists <- IO CInt
x_exists
      if exists == 1
        then do
          -- clearBody (only clear the body)
          clearBody

          -- Deref old state, update new state, set pointer in C heap.
          (oldComponentsRef, oldSchedulerRef) <- deRefStablePtr =<< x_get
          killThread =<< readIORef oldSchedulerRef

          _oldState <- readIORef oldComponentsRef
          let oldModel = (IntMap (ComponentState context (ZonkAny 0) model (ZonkAny 1))
_oldState IntMap (ComponentState context (ZonkAny 0) model (ZonkAny 1))
-> Key -> ComponentState context (ZonkAny 0) model (ZonkAny 1)
forall a. IntMap a -> Key -> a
IM.! Key
topLevelComponentId) ComponentState context (ZonkAny 0) model (ZonkAny 1)
-> Lens
     (ComponentState context (ZonkAny 0) model (ZonkAny 1)) model
-> model
forall record field. record -> Lens record field -> field
^. Lens (ComponentState context (ZonkAny 0) model (ZonkAny 1)) model
forall context props model action.
Lens (ComponentState context props model action) model
componentModel
              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.
          oldContext <- readIORef ((_oldState IM.! topLevelComponentId) ^. componentContext)

          -- Overwrite new components state with old components state.
          atomicWriteIORef components _oldState

          -- Perform initial draw, recovering the old model and the old context.
          -- ('initComponent' creates the new cell and seeds it with this value.)
          initComponent events Draw True oldContext initialVComp Nothing () 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.
          newState <- readIORef components
          forM_ (IM.lookup topLevelComponentId newState) $ \ComponentState (ZonkAny 2) (ZonkAny 3) (ZonkAny 4) (ZonkAny 5)
root -> do
            let newCell :: IORef (ZonkAny 2)
newCell = ComponentState (ZonkAny 2) (ZonkAny 3) (ZonkAny 4) (ZonkAny 5)
root ComponentState (ZonkAny 2) (ZonkAny 3) (ZonkAny 4) (ZonkAny 5)
-> Lens
     (ComponentState (ZonkAny 2) (ZonkAny 3) (ZonkAny 4) (ZonkAny 5))
     (IORef (ZonkAny 2))
-> IORef (ZonkAny 2)
forall record field. record -> Lens record field -> field
^. Lens
  (ComponentState (ZonkAny 2) (ZonkAny 3) (ZonkAny 4) (ZonkAny 5))
  (IORef (ZonkAny 2))
forall context props model action.
Lens (ComponentState context props model action) (IORef context)
componentContext
            IORef
  (IntMap
     (ComponentState (ZonkAny 2) (ZonkAny 6) (ZonkAny 7) (ZonkAny 8)))
-> (IntMap
      (ComponentState (ZonkAny 2) (ZonkAny 6) (ZonkAny 7) (ZonkAny 8))
    -> (IntMap
          (ComponentState (ZonkAny 2) (ZonkAny 6) (ZonkAny 7) (ZonkAny 8)),
        ()))
-> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef
  (IntMap
     (ComponentState (ZonkAny 2) (ZonkAny 6) (ZonkAny 7) (ZonkAny 8)))
forall context props model action.
IORef (IntMap (ComponentState context props model action))
components ((IntMap
    (ComponentState (ZonkAny 2) (ZonkAny 6) (ZonkAny 7) (ZonkAny 8))
  -> (IntMap
        (ComponentState (ZonkAny 2) (ZonkAny 6) (ZonkAny 7) (ZonkAny 8)),
      ()))
 -> IO ())
-> (IntMap
      (ComponentState (ZonkAny 2) (ZonkAny 6) (ZonkAny 7) (ZonkAny 8))
    -> (IntMap
          (ComponentState (ZonkAny 2) (ZonkAny 6) (ZonkAny 7) (ZonkAny 8)),
        ()))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \IntMap
  (ComponentState (ZonkAny 2) (ZonkAny 6) (ZonkAny 7) (ZonkAny 8))
m ->
              ((ComponentState (ZonkAny 2) (ZonkAny 6) (ZonkAny 7) (ZonkAny 8)
 -> ComponentState (ZonkAny 2) (ZonkAny 6) (ZonkAny 7) (ZonkAny 8))
-> IntMap
     (ComponentState (ZonkAny 2) (ZonkAny 6) (ZonkAny 7) (ZonkAny 8))
-> IntMap
     (ComponentState (ZonkAny 2) (ZonkAny 6) (ZonkAny 7) (ZonkAny 8))
forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map (Lens
  (ComponentState (ZonkAny 2) (ZonkAny 6) (ZonkAny 7) (ZonkAny 8))
  (IORef (ZonkAny 2))
forall context props model action.
Lens (ComponentState context props model action) (IORef context)
componentContext Lens
  (ComponentState (ZonkAny 2) (ZonkAny 6) (ZonkAny 7) (ZonkAny 8))
  (IORef (ZonkAny 2))
-> IORef (ZonkAny 2)
-> ComponentState (ZonkAny 2) (ZonkAny 6) (ZonkAny 7) (ZonkAny 8)
-> ComponentState (ZonkAny 2) (ZonkAny 6) (ZonkAny 7) (ZonkAny 8)
forall record field. Lens record field -> field -> record -> record
.~ IORef (ZonkAny 2)
newCell) IntMap
  (ComponentState (ZonkAny 2) (ZonkAny 6) (ZonkAny 7) (ZonkAny 8))
m, ())

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

          -- Clear and set static ptr to use new state (new CAF state)
          x_clear
          x_store =<< newStablePtr (components, schedulerThread)
        else do
          -- This means it is initial load, just store the pointer.
          void (initComponent events Draw False initialContext vcomp_ Nothing () Nothing)
          x_store =<< newStablePtr (components, 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
  body_ <- Text -> IO JSVal
jsg Text
"document" IO JSVal -> Text -> IO JSVal
forall o. ToObject o => o -> Text -> IO JSVal
! (Text
"body" :: MisoString)
  setField body_ "innerHTML" ("" :: MisoString)
clearHead :: IO ()
clearHead = do
  head_ <- Text -> IO JSVal
jsg Text
"document" IO JSVal -> Text -> IO JSVal
forall o. ToObject o => o -> Text -> IO JSVal
! (Text
"head" :: MisoString)
  setField head_ "innerHTML" ("" :: MisoString)
-----------------------------------------------------------------------------