{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Miso.Reload
(
reload
) where
import Control.Monad
#if __GLASGOW_HASKELL__ > 865
import GHC.Conc.Sync (threadLabel)
import GHC.Conc (listThreads, killThread)
#endif
import Miso.String (MisoString)
import Miso.Runtime (resetComponentState)
import Miso.DSL (jsg, (!), setField)
reload
:: IO ()
-> IO ()
reload :: IO () -> IO ()
reload IO ()
action = do
IO ()
clear
#if __GLASGOW_HASKELL__ > 865
threads <- IO [ThreadId]
listThreads
forM_ threads $ \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
action
where
clear :: IO ()
clear :: IO ()
clear = IO () -> IO ()
resetComponentState (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
body_ <- MisoString -> IO JSVal
jsg MisoString
"document" IO JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! (MisoString
"body" :: MisoString)
setField body_ "innerHTML" ("" :: MisoString)
head_ <- jsg "document" ! ("head" :: MisoString)
setField head_ "innerHTML" ("" :: MisoString)