@@ -37,12 +37,16 @@ import Data.Monoid ((<>))
3737import Data.Text (Text)
3838import qualified Data.Text as T
3939import qualified Data.Text.Encoding as T
40−import GHCJS.DOM.Types (Location(..))
40+import GHCJS.Foreign (isFunction)
41+import GHCJS.DOM.Types (Location(..), PopStateEvent(..))
42+import qualified GHCJS.DOM.Types as DOM
4143import Reflex.Dom.Core hiding (EventName, Window)
4244import qualified URI.ByteString as U
43−import GHCJS.DOM.Types (MonadJSM)
45+import GHCJS.DOM.Types (uncheckedCastTo, MonadJSM)
4446import GHCJS.DOM.History (History, back, forward, pushState)
45−import GHCJS.DOM (currentWindow)
47+import GHCJS.DOM (currentWindowUnchecked, currentDocumentUnchecked)
48+import GHCJS.DOM.Document (createEvent)
49+import GHCJS.DOM.Event (initEvent)
4650import GHCJS.DOM.EventM (on)
4751import GHCJS.DOM.EventTarget (dispatchEvent_)
4852import GHCJS.DOM.Location (getHref)
@@ -55,7 +59,7 @@ import GHCJS.DOM.Window (popState)
5559#endif
5660import GHCJS.Marshal.Pure (pFromJSVal)
5761import qualified Language.Javascript.JSaddle as JS
58−import Language.Javascript.JSaddle (JSM, liftJSM, Object(..))
62+import Language.Javascript.JSaddle (ghcjsPure, JSM, liftJSM, Object(..))
5963------------------------------------------------------------------------------
6064
6165
@@ -178,7 +182,7 @@ getPopState
178182 , TriggerEvent t m
179183 , MonadJSM m) => m (Event t URI)
180184getPopState = do
181− Just window <- currentWindow
185+ window <- currentWindowUnchecked
182186 wrapDomEventMaybe window (`on` popState) $ do
183187#if MIN_VERSION_ghcjs_dom(0,8,0)
184188 loc
@@ -203,7 +207,7 @@ goBack = withHistory back
203207-------------------------------------------------------------------------------
204208withHistory :: (HasJSContext m, MonadJSM m) => (History -> m a) -> m a
205209withHistory act = do
206− Just w <- currentWindow
210+ w <- currentWindowUnchecked
207211#if MIN_VERSION_ghcjs_dom(0,8,0)
208212 h
209213#else
@@ -217,7 +221,7 @@ withHistory act = do
217221-- | (Unsafely) get the 'GHCJS.DOM.Location.Location' of a window
218222getLoc :: (HasJSContext m, MonadJSM m) => m Location
219223getLoc = do
220− Just win <- currentWindow
224+ win <- currentWindowUnchecked
221225#if MIN_VERSION_ghcjs_dom(0,8,0)
222226 loc
223227#else
@@ -247,12 +251,20 @@ getURI = do
247251
248252dispatchEvent' :: JSM ()
249253dispatchEvent' = do
250− Just window <- currentWindow
254+ window <- currentWindowUnchecked
251255 obj@(Object o) <- JS.create
252256 JS.objSetPropertyByName obj ("cancelable" :: Text) True
253257 JS.objSetPropertyByName obj ("bubbles" :: Text) True
254258 JS.objSetPropertyByName obj ("view" :: Text) window
255− event <- newPopStateEvent ("popstate" :: Text) $ Just $ pFromJSVal o
259+ event <- JS.jsg ("PopStateEvent" :: Text) >>= ghcjsPure . isFunction >>= \case
260+ True -> newPopStateEvent ("popstate" :: Text) $ Just $ pFromJSVal o
261+ False -> do
262+ doc <- currentDocumentUnchecked
263+ event <- createEvent doc ("PopStateEvent" :: Text)
264+ initEvent event ("popstate" :: Text) True True
265+ JS.objSetPropertyByName obj ("view" :: Text) window
266+ return $ uncheckedCastTo PopStateEvent event
267+
256268 dispatchEvent_ window event
257269
258270