-----------------------------------------------------------------------------
{-# 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, initComponent, topLevelComponentId, globalContext, 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, Any
_) <- StablePtr (Any, IORef ThreadId, Any)
-> IO (Any, IORef ThreadId, Any)
forall a. StablePtr a -> IO a
deRefStablePtr (StablePtr (Any, IORef ThreadId, Any)
 -> IO (Any, IORef ThreadId, Any))
-> IO (StablePtr (Any, IORef ThreadId, Any))
-> IO (Any, IORef ThreadId, Any)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (StablePtr (Any, IORef ThreadId, Any))
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' writes 'globalContext' with the value we pass it.)
   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,
   IORef Any)
-> IO ()
forall a. StablePtr a -> IO ()
x_store (StablePtr
   (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId,
    IORef Any)
 -> IO ())
-> IO
     (StablePtr
        (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId,
         IORef Any))
-> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId,
 IORef Any)
-> IO
     (StablePtr
        (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId,
         IORef Any))
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, IORef context
forall {context}. IORef context
globalContext :: IORef context)
-----------------------------------------------------------------------------
-- | 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 Any Any model Any))
oldComponentsRef, IORef ThreadId
oldSchedulerRef, IORef context
oldContextRef) <- StablePtr
  (IORef (IntMap (ComponentState Any Any model Any)), IORef ThreadId,
   IORef context)
-> IO
     (IORef (IntMap (ComponentState Any Any model Any)), IORef ThreadId,
      IORef context)
forall a. StablePtr a -> IO a
deRefStablePtr (StablePtr
   (IORef (IntMap (ComponentState Any Any model Any)), IORef ThreadId,
    IORef context)
 -> IO
      (IORef (IntMap (ComponentState Any Any model Any)), IORef ThreadId,
       IORef context))
-> IO
     (StablePtr
        (IORef (IntMap (ComponentState Any Any model Any)), IORef ThreadId,
         IORef context))
-> IO
     (IORef (IntMap (ComponentState Any Any model Any)), IORef ThreadId,
      IORef context)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO
  (StablePtr
     (IORef (IntMap (ComponentState Any Any model Any)), IORef ThreadId,
      IORef context))
forall a. IO (StablePtr a)
x_get
          context
oldContext <- IORef context -> IO context
forall a. IORef a -> IO a
readIORef IORef context
oldContextRef
          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 Any Any model Any)
_oldState <- IORef (IntMap (ComponentState Any Any model Any))
-> IO (IntMap (ComponentState Any Any model Any))
forall a. IORef a -> IO a
readIORef IORef (IntMap (ComponentState Any Any model Any))
oldComponentsRef
          let oldModel :: model
oldModel = (IntMap (ComponentState Any Any model Any)
_oldState IntMap (ComponentState Any Any model Any)
-> Key -> ComponentState Any Any model Any
forall a. IntMap a -> Key -> a
IM.! Key
topLevelComponentId) ComponentState Any Any model Any
-> Lens (ComponentState Any Any model Any) model -> model
forall record field. record -> Lens record field -> field
^. Lens (ComponentState Any 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 }

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

          -- Perform initial draw, recovering the old model and the old context.
          -- ('initComponent' seeds 'globalContext' with the context we pass it.)
          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

          -- 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,
   IORef Any)
-> IO ()
forall a. StablePtr a -> IO ()
x_store (StablePtr
   (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId,
    IORef Any)
 -> IO ())
-> IO
     (StablePtr
        (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId,
         IORef Any))
-> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId,
 IORef Any)
-> IO
     (StablePtr
        (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId,
         IORef Any))
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, IORef context
forall {context}. IORef context
globalContext :: IORef context)
        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,
   IORef Any)
-> IO ()
forall a. StablePtr a -> IO ()
x_store (StablePtr
   (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId,
    IORef Any)
 -> IO ())
-> IO
     (StablePtr
        (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId,
         IORef Any))
-> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId,
 IORef Any)
-> IO
     (StablePtr
        (IORef (IntMap (ComponentState Any Any Any Any)), IORef ThreadId,
         IORef Any))
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, IORef context
forall {context}. IORef context
globalContext :: IORef context)
-----------------------------------------------------------------------------
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)
-----------------------------------------------------------------------------