-----------------------------------------------------------------------------
{-# LANGUAGE CPP               #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- 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
--
-- Support for live reloading of miso applications.
--
-- = Live Reload
--
-- This module exposes two functions meant to be used during interactive
-- development with GHC WASM browser mode, 'live' and 'reload'.
--
-- == Reload
--
-- Use 'reload' if you'd like to redraw the page on each file change, resetting
-- the working application state.
--
-- @
-- main :: IO ()
-- main = 'reload' 'defaultEvents' app
-- @
--
-- == Live
--
-- Use 'live' if you'd like to persist the working application state (all 'Component' 'model')
-- between GHCi reloads. This only works if you do not alter the 'model' schema (e.g. add, remove, change a field's type).
--
-- @
-- main :: IO ()
-- main = 'live' 'defaultEvents' app
-- @
--
-- See the [miso-sampler](https://github.com/haskell-miso/miso-sampler) for example usage.
--
----------------------------------------------------------------------------
module Miso.Reload
  ( -- ** Functions
    reload
  , live
  ) where
-----------------------------------------------------------------------------
import           Control.Monad
#if __GLASGOW_HASKELL__ > 865
import           GHC.Conc.Sync (threadLabel)
import           GHC.Conc (listThreads, killThread)
#endif
-----------------------------------------------------------------------------
#ifdef WASM
import           Miso.DSL.TH.File (evalFile)
#endif
import           Miso.DSL ((!), jsg, setField)
import qualified Miso.FFI.Internal as FFI
import           Miso.Types (Component(..), Events, App)
import           Miso.String (MisoString)
import           Miso.Runtime (componentModel, initComponent, topLevelComponentId, resetComponentState, Hydrate(..))
import           Miso.Runtime.Internal (components)
-----------------------------------------------------------------------------
import           Miso.Lens
-----------------------------------------------------------------------------
import qualified Data.IntMap.Strict as IM
import           Data.IORef
import           Foreign hiding (void)
import           Foreign.C.Types
-----------------------------------------------------------------------------
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' 'defaultEvents' app
-- @
--
-- N.B. This also resets the internal 'component' state. This means all currently
-- mounted components become unmounted and t'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
  :: Eq model
  => Events
  -> App model action
  -> IO ()
reload :: forall model action.
Eq model =>
Events -> App model action -> IO ()
reload Events
events App model action
vcomp = do
#ifdef WASM
    $(evalFile MISO_JS_PATH)
#endif
    IO () -> IO ()
resetComponentState IO ()
clearPage
#if __GLASGOW_HASKELL__ > 865
    [ThreadId]
threads <- IO [ThreadId]
listThreads
    [ThreadId] -> (ThreadId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ThreadId]
threads ((ThreadId -> IO ()) -> IO ()) -> (ThreadId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ThreadId
threadId -> do
      ThreadId -> IO (Maybe String)
threadLabel ThreadId
threadId IO (Maybe String) -> (Maybe String -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just String
"scheduler" ->
          ThreadId -> IO ()
killThread ThreadId
threadId
        Maybe String
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
#endif
    Events -> Hydrate -> App model action -> IO ()
forall parent model action.
(Eq parent, Eq model) =>
Events -> Hydrate -> Component parent () model action -> IO ()
initComponent Events
events Hydrate
Draw App model action
vcomp
-----------------------------------------------------------------------------
-- | 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 'view' or 'update' functions
-- it will be fine. 
--
-- Use 'reload' if you're changing the 'model' frequently and 'live'
-- if you're adjusting the 'view' / 'update' function logic.
--
-- @
-- main :: IO ()
-- main = 'live' 'defaultEvents' app
-- @
--
-- @since 1.9.0.0
live
  :: Eq model
  => Events
  -> App model action
  -> IO ()
live :: forall model action.
Eq model =>
Events -> App model action -> IO ()
live Events
events App 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
#if __GLASGOW_HASKELL__ > 865
      [ThreadId]
threads <- IO [ThreadId]
listThreads
      [ThreadId] -> (ThreadId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ThreadId]
threads ((ThreadId -> IO ()) -> IO ()) -> (ThreadId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ThreadId
threadId -> do
        ThreadId -> IO (Maybe String)
threadLabel ThreadId
threadId IO (Maybe String) -> (Maybe String -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Just String
"scheduler" ->
            ThreadId -> IO ()
killThread ThreadId
threadId
          Maybe String
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
#endif
      -- clearPage (perform this with the context)
      IO ()
clearPage

      -- Deref old state, update new state, set pointer in C heap.
      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))
 -> IO (IntMap (ComponentState Any Any model Any)))
-> IO (IORef (IntMap (ComponentState Any Any model Any)))
-> IO (IntMap (ComponentState Any Any model Any))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StablePtr (IORef (IntMap (ComponentState Any Any model Any)))
-> IO (IORef (IntMap (ComponentState Any Any model Any)))
forall a. StablePtr a -> IO a
deRefStablePtr (StablePtr (IORef (IntMap (ComponentState Any Any model Any)))
 -> IO (IORef (IntMap (ComponentState Any Any model Any))))
-> IO
     (StablePtr (IORef (IntMap (ComponentState Any Any model Any))))
-> IO (IORef (IntMap (ComponentState Any Any model Any)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (StablePtr (IORef (IntMap (ComponentState Any Any model Any))))
forall a. IO (StablePtr a)
x_get

      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 parent props model action.
Lens (ComponentState parent props model action) model
componentModel
          initialVComp :: App model action
initialVComp = App 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 parent props model action.
IORef (IntMap (ComponentState parent props model action))
components IntMap (ComponentState Any Any model Any)
_oldState

      -- Perform initial draw, this will fetch the model from the old component state
      -- and overwrite the old state with the new state for everything else.
      Events -> Hydrate -> App model action -> IO ()
forall parent model action.
(Eq parent, Eq model) =>
Events -> Hydrate -> Component parent () model action -> IO ()
initComponent Events
events Hydrate
Draw App model action
initialVComp
      
      -- Don't forget to flush (native mobile needs this too)
      IO ()
FFI.flush

      -- Clear and set static ptr to use new state
      IO ()
x_clear
      StablePtr (IORef (IntMap (ComponentState Any Any Any Any)))
-> IO ()
forall a. StablePtr a -> IO ()
x_store (StablePtr (IORef (IntMap (ComponentState Any Any Any Any)))
 -> IO ())
-> IO (StablePtr (IORef (IntMap (ComponentState Any Any Any Any))))
-> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (IntMap (ComponentState Any Any Any Any))
-> IO (StablePtr (IORef (IntMap (ComponentState Any Any Any Any))))
forall a. a -> IO (StablePtr a)
newStablePtr IORef (IntMap (ComponentState Any Any Any Any))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components
    else do
      -- This means it is initial load, just store the pointer.
#ifdef WASM
      $(evalFile MISO_JS_PATH)
#endif
      StablePtr (IORef (IntMap (ComponentState Any Any Any Any)))
-> IO ()
forall a. StablePtr a -> IO ()
x_store (StablePtr (IORef (IntMap (ComponentState Any Any Any Any)))
 -> IO ())
-> IO (StablePtr (IORef (IntMap (ComponentState Any Any Any Any))))
-> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (IntMap (ComponentState Any Any Any Any))
-> IO (StablePtr (IORef (IntMap (ComponentState Any Any Any Any))))
forall a. a -> IO (StablePtr a)
newStablePtr IORef (IntMap (ComponentState Any Any Any Any))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components
      IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Events -> Hydrate -> App model action -> IO ()
forall parent model action.
(Eq parent, Eq model) =>
Events -> Hydrate -> Component parent () model action -> IO ()
initComponent Events
events Hydrate
Draw App model action
vcomp)
-----------------------------------------------------------------------------
clearPage :: IO ()
clearPage :: IO ()
clearPage = 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)
  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)
-----------------------------------------------------------------------------