module Reflex.Dom.Contrib.Router where
import Control.Monad
import Control.Monad.Trans
import GHCJS.DOM
import GHCJS.DOM.Document
import GHCJS.DOM.Types (unWindow)
import GHCJS.DOM.Window
import GHCJS.DOM.HTMLDocument
#ifdef ghcjs_HOST_OS
import GHCJS.Foreign.Callback
import GHCJS.Types
import GHCJS.Prim
#endif
import Prelude hiding (mapM, mapM_, all, sequence)
import Reflex.Dom
import Reflex.Dom.Contrib.Utils
setUrl
:: MonadWidget t m
=> Event t String
-> m ()
setUrl e = do
performEvent_ $ ffor e $ \url -> liftIO $ do
windowHistoryPushState url
getWindowLocation :: Window -> IO String
#ifdef ghcjs_HOST_OS
getWindowLocation w = do
liftM fromJSString $ js_windowLocationPathname (unWindow w)
foreign import javascript unsafe
"$1['location']['pathname']"
js_windowLocationPathname :: JSVal -> IO JSVal
#else
getWindowLocation =
error "getWindowLocation: only works in GHCJS"
#endif
setupHistoryHandler :: Window -> (String -> IO ()) -> IO ()
#ifdef ghcjs_HOST_OS
setupHistoryHandler w cb = do
cbRef <- syncCallback1 ThrowWouldBlock (cb . fromJSString)
js_setupHistoryHandler (unWindow w) cbRef
foreign import javascript unsafe
"$1.onpopstate = function(event) { $2($1['location']['pathname']); }"
js_setupHistoryHandler :: JSVal -> Callback (JSVal -> IO ()) -> IO ()
#else
setupHistoryHandler =
error "setupHistoryHandler: only works in GHCJS"
#endif
--routeSite
routeSite siteFunc = runWebGUI $ \webView -> do
w <- waitUntilJust currentWindow
path <- getWindowLocation w
doc <- waitUntilJust $ liftM (fmap castToHTMLDocument) $
webViewGetDomDocument webView
body <- waitUntilJust $ getBody doc
attachWidget body webView $ do
changes <- siteFunc path
setUrl changes
return ()