module Haste.Hash (
onHashChange, onHashChange', setHash, getHash, setHash', getHash'
) where
import Haste.Foreign
import Control.Monad.IO.Class
import Haste.Callback
import Haste.Prim
import Unsafe.Coerce
newtype HashCallback = HashCallback (JSString -> JSString -> IO ())
instance Pack HashCallback where
pack = unsafeCoerce
instance Unpack HashCallback where
unpack = unsafeCoerce
onHashChange :: (MonadIO m, GenericCallback (m ()) m, CB (m ()) ~ IO ())
=> (String -> String -> m ())
-> m ()
onHashChange f = do
firsthash <- getHash'
f' <- toCallback $ \old new -> f (fromJSStr old) (fromJSStr new)
liftIO $ jsOnHashChange firsthash (HashCallback f')
onHashChange' :: (MonadIO m, GenericCallback (m ()) m, CB (m ()) ~ IO ())
=> (JSString -> JSString -> m ())
-> m ()
onHashChange' f = do
firsthash <- getHash'
f' <- toCallback f
liftIO $ jsOnHashChange firsthash (HashCallback f')
jsOnHashChange :: JSString -> HashCallback -> IO ()
jsOnHashChange =
ffi "(function(firsthash,cb){\
\window.__old_hash = firsthash;\
\window.onhashchange = function(e){\
\var oldhash = window.__old_hash;\
\var newhash = window.location.hash.split('#')[1] || '';\
\window.__old_hash = newhash;\
\B(A(cb, [[0,oldhash],[0,newhash],0]));\
\};\
\})"
setHash :: MonadIO m => String -> m ()
setHash = liftIO . jsSetHash . toJSStr
setHash' :: MonadIO m => JSString -> m ()
setHash' = liftIO . jsSetHash
jsSetHash :: JSString -> IO ()
jsSetHash = ffi "(function(h) {location.hash = '#'+h;})"
getHash :: MonadIO m => m String
getHash = liftIO $ fromJSStr `fmap` jsGetHash
getHash' :: MonadIO m => m JSString
getHash' = liftIO jsGetHash
jsGetHash :: IO JSString
jsGetHash = ffi "(function() {return location.hash.substring(1);})"