{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Yesod.AutoReload
(
getAutoReloadR,
getAutoReloadRWith,
autoReloadWidgetFor,
)
where
import Control.Concurrent
import Control.Monad
import Data.Text (Text)
import Text.Julius
import Yesod.Core
import Yesod.WebSockets
autoReloadWidgetFor :: Route site -> WidgetFor site ()
autoReloadWidgetFor :: Route site -> WidgetFor site ()
autoReloadWidgetFor Route site
reloadWebsocketRoute =
JavascriptUrl (Route site) -> WidgetFor site ()
forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
toWidget
[julius|
function connect (reloadAfterConnecting) {
var uri = new URL("@{reloadWebsocketRoute}",document.baseURI).href.replace(/^http/i, "ws");
var conn = new WebSocket(uri)
conn.onopen = function() {
console.log("Listening for file changes.");
if(reloadAfterConnecting) {
reloadAfterConnecting = false; // Just incase this is run twice
location.reload();
}
}
conn.onclose = function(e) {
console.log("Connection closed using the following event, reloading.");
console.log(e);
if (e) {
console.log(e.reason);
if (e.reason && e.reason === "change") {
console.log("Only reloading, not reconnecting.");
location.reload();
} else {
console.log("Reconnecting before we reload.");
setTimeout(function() {
connect(true);
}, 1000);
}
} else {
console.log("Received something that didn't look like an event, not reloading.");
}
}
}
connect(false);
|]
getAutoReloadRWith :: (MonadHandler m, MonadUnliftIO m) => WebSocketsT m () -> m ()
getAutoReloadRWith :: WebSocketsT m () -> m ()
getAutoReloadRWith WebSocketsT m ()
waitingFunc = WebSocketsT m () -> m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadHandler m) =>
WebSocketsT m () -> m ()
webSockets (WebSocketsT m () -> m ()) -> WebSocketsT m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
WebSocketsT m ()
waitingFunc
Text -> WebSocketsT m ()
forall (m :: * -> *) a.
(MonadIO m, WebSocketsData a, MonadReader Connection m) =>
a -> m ()
sendClose (Text
"change" :: Text)
getAutoReloadR :: (MonadHandler m, MonadUnliftIO m) => m ()
getAutoReloadR :: m ()
getAutoReloadR =
WebSocketsT m () -> m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadHandler m) =>
WebSocketsT m () -> m ()
webSockets (WebSocketsT m () -> m ()) -> WebSocketsT m () -> m ()
forall a b. (a -> b) -> a -> b
$
WebSocketsT m () -> WebSocketsT m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (WebSocketsT m () -> WebSocketsT m ())
-> WebSocketsT m () -> WebSocketsT m ()
forall a b. (a -> b) -> a -> b
$ do
Text -> WebSocketsT m ()
forall (m :: * -> *) a.
(MonadIO m, WebSocketsData a, MonadReader Connection m) =>
a -> m ()
sendPing (Text
"Ping" :: Text)
IO () -> WebSocketsT m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> WebSocketsT m ()) -> IO () -> WebSocketsT m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
1_000_000