Merge remote-tracking branch 'origin/jg/history-management-for-androi…

…d' into develop

reflex-dom-core/src/Reflex/Dom/Location.hs

@@ -13,10 +13,12 @@ module Reflex.Dom.Location
   , getLocationUrl
   , manageHistory
   , manageHistory'
+  , manageHistoryExposingExternalUpdates
   , HistoryCommand (..)
   , HistoryStateUpdate (..)
   , HistoryItem (..)
   , getLocationUri
+  , popHistoryState
   ) where
 
 import Reflex
@@ -170,7 +172,15 @@ manageHistory'
   -- ^ Don't do anything until this event has fired
   -> Event t HistoryCommand
   -> m (Dynamic t HistoryItem)
-manageHistory' switchover runCmd = do
+manageHistory' switchover runCmd = fst <$> manageHistoryExposingExternalUpdates switchover runCmd
+
+manageHistoryExposingExternalUpdates
+  :: (MonadFix m, MonadJSM m, TriggerEvent t m, MonadHold t m, PerformEvent t m, MonadJSM (Performable m))
+  => Event t ()
+  -- ^ Don't do anything until this event has fired
+  -> Event t HistoryCommand
+  -> m (Dynamic t HistoryItem, Event t HistoryItem)
+manageHistoryExposingExternalUpdates switchover runCmd = do
   window <- DOM.currentWindowUnchecked
   location <- Window.getLocation window
   history <- Window.getHistory window
@@ -196,5 +206,16 @@ manageHistory' switchover runCmd = do
   itemSetInternal <- performEvent $ ffor itemSetInternal' $ \cmd -> liftJSM $ do
     runHistoryCommand history cmd
     getCurrentHistoryItem
-  holdDyn item0 $ leftmost [itemSetInternal, itemSetExternal]
+  currentHistoryItem <- holdDyn item0 $ leftmost [itemSetInternal, itemSetExternal]
+  pure (currentHistoryItem, itemSetExternal)
 --TODO: Handle title setting better
+
+popHistoryState
+  :: (PerformEvent t m, MonadJSM (Performable m))
+  => Event t ()
+  -> m ()
+popHistoryState evt =
+  performEvent_ $ ffor evt $ \_ -> do
+    window <- DOM.currentWindowUnchecked
+    history <- Window.getHistory window
+    History.back history

reflex-dom/ChangeLog.md

@@ -2,7 +2,8 @@
 
 ## 0.6.2.0
 
-* Allow file access on newer android
+* [#452](https://github.com/reflex-frp/reflex-dom/pull/452) Allow file access on newer android, following usage recommended by the [official docs](https://developer.android.com/reference/androidx/webkit/WebViewAssetLoader)
+* [#453](https://github.com/reflex-frp/reflex-dom/pull/453) History management for android
 
 ## 0.6.1.1-r1
 

reflex-dom/cbits/MainWidget.c

@@ -53,6 +53,40 @@ void Reflex_Dom_Android_MainWidget_runJS(jobject jsExecutor, const char* js, siz
   (*env)->PopLocalFrame(env, 0);
 }
 
+void Reflex_Dom_Android_MainWidget_back(jobject jsExecutor) {
+  JNIEnv *env;
+  jint attachResult = (*HaskellActivity_jvm)->AttachCurrentThread(HaskellActivity_jvm, &env, NULL);
+  assert (attachResult == JNI_OK);
+
+  (*env)->PushLocalFrame(env, 5);
+
+  //TODO: Don't search for this method every time
+  jclass cls = (*env)->GetObjectClass(env, jsExecutor);
+  assert(cls);
+  jmethodID evaluateJavascript = (*env)->GetMethodID(env, cls, "goBack", "()V");
+  assert(evaluateJavascript);
+  (*env)->CallVoidMethod(env, jsExecutor, evaluateJavascript);
+
+  (*env)->PopLocalFrame(env, 0);
+}
+
+void Reflex_Dom_Android_MainWidget_clearHistory(jobject jsExecutor) {
+  JNIEnv *env;
+  jint attachResult = (*HaskellActivity_jvm)->AttachCurrentThread(HaskellActivity_jvm, &env, NULL);
+  assert (attachResult == JNI_OK);
+
+  (*env)->PushLocalFrame(env, 5);
+
+  //TODO: Don't search for this method every time
+  jclass cls = (*env)->GetObjectClass(env, jsExecutor);
+  assert(cls);
+  jmethodID evaluateJavascript = (*env)->GetMethodID(env, cls, "clearHistory", "()V");
+  assert(evaluateJavascript);
+  (*env)->CallVoidMethod(env, jsExecutor, evaluateJavascript);
+
+  (*env)->PopLocalFrame(env, 0);
+}
+
 JNIEXPORT void JNICALL Java_org_reflexfrp_reflexdom_MainWidget_00024JSaddleCallbacks_startProcessing (JNIEnv *env, jobject thisObj, jlong callbacksLong) {
   const JSaddleCallbacks *callbacks = (const JSaddleCallbacks *)callbacksLong;
   (*(callbacks->jsaddleStart))();

reflex-dom/java/org/reflexfrp/reflexdom/MainWidget.java

@@ -86,7 +86,7 @@ public WebResourceResponse shouldInterceptRequest (WebView view, WebResourceRequ
 
         @Override
         public boolean shouldOverrideUrlLoading(WebView view, String url) {
-            if( url != null && !url.startsWith("http://") && !url.startsWith("https://") && !url.startsWith("file://")) {
+            if( url != null && !url.startsWith("http://appassets.androidplatform.net") && !url.startsWith("https://appassets.androidplatform.net") && !url.startsWith("file://")) {
                 try {
                     view.getContext().startActivity(new Intent(Intent.ACTION_VIEW, Uri.parse(url)));
                 }
@@ -144,6 +144,18 @@ public void run() {
             }
           });
       }
+      public final void goBack() {
+        hnd.post(new Runnable() {
+          @Override
+	  public void run() {
+            if(wv.canGoBack()) {
+              wv.goBack();
+            } else {
+              a.defaultOnBackPressed();
+            }
+	  }
+	});
+      }
     };
   }
 

reflex-dom/reflex-dom.cabal

@@ -104,6 +104,7 @@ library
   exposed-modules:
     Reflex.Dom
     Reflex.Dom.Internal
+    Reflex.Dom.Location.Platform
   reexported-modules:
       Foreign.JavaScript.Orphans
     , Foreign.JavaScript.TH

reflex-dom/src-android/Reflex/Dom/Android/MainWidget.hsc

@@ -2,11 +2,15 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Reflex.Dom.Android.MainWidget
   ( startMainWidget
+  , goBack
+  , JSExecutor(..)
+  , withGlobalJSExecutor
   ) where
 
 import Android.HaskellActivity
 import Control.Concurrent
 import Control.Monad
+import Control.Monad.IO.Class
 import Data.Aeson
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
@@ -23,10 +27,10 @@ import Foreign.Storable
 import Language.Javascript.JSaddle (JSM)
 import Language.Javascript.JSaddle.Run (runJavaScript)
 import Language.Javascript.JSaddle.Run.Files (initState, runBatch, ghcjsHelpers)
+import System.IO.Unsafe
 
 #include "MainWidget.h"
 
-
 startMainWidget :: HaskellActivity -> ByteString -> JSM () -> IO ()
 startMainWidget a url jsm = do
   --TODO: Find a way to eventually release this
@@ -57,13 +61,27 @@ startMainWidget a url jsm = do
         \jsaddle.postReady();\n"
     }
   BS.useAsCString url $ \curl -> do
-    writeIORef executorRef =<< startMainWidget_ a curl callbacks
+    executor <- startMainWidget_ a curl callbacks
+    writeIORef executorRef executor
+    writeIORef globalJSExecutor $ Just executor
 
 newtype JSExecutor = JSExecutor { unJSExecutor :: Ptr JSExecutor }
 
+-- Ugh. But not doing this is also unfortunate for being able to clear the history so that the "back" list is good.
+globalJSExecutor :: IORef (Maybe JSExecutor)
+globalJSExecutor = unsafePerformIO $ newIORef Nothing
+
+withGlobalJSExecutor :: MonadIO m => (JSExecutor -> IO ()) -> m ()
+withGlobalJSExecutor f = liftIO $ do
+  executor <- readIORef globalJSExecutor
+  case executor of
+    Just e -> f e
+    _ -> pure ()
+
 foreign import ccall safe "Reflex_Dom_Android_MainWidget_start" startMainWidget_ :: HaskellActivity -> CString -> Ptr JSaddleCallbacksPtrs -> IO JSExecutor
 
 foreign import ccall safe "Reflex_Dom_Android_MainWidget_runJS" runJS :: JSExecutor -> CString -> CSize -> IO ()
+foreign import ccall safe "Reflex_Dom_Android_MainWidget_back" goBack :: JSExecutor -> IO ()
 
 data JSaddleCallbacks = JSaddleCallbacks
   { _jsaddleCallbacks_jsaddleStart :: IO ()

reflex-dom/src/Reflex/Dom/Internal.hs

@@ -38,6 +38,7 @@ run jsm = do
   port <- maybe 3003 read <$> lookupEnv "JSADDLE_WARP_PORT"
   putStrLn $ "Running jsaddle-warp server on port " <> show port
   JW.run port jsm
+
 #elif defined(MIN_VERSION_jsaddle_wkwebview)
 #if defined(ios_HOST_OS)
 import Data.Default
@@ -56,18 +57,24 @@ run jsm = do
       return ""
     Just p -> return $ "file://" <> p <> "/index.html"
   run' def $ jsaddleMainHTMLWithBaseURL indexHtml baseUrl jsm
+
 #else
 import Language.Javascript.JSaddle.WKWebView (run)
 #endif
 #elif defined(ANDROID)
 import Android.HaskellActivity
 import Control.Monad
+import Control.Monad.IO.Class (liftIO, MonadIO)
 import Control.Concurrent
+import Language.Javascript.JSaddle (JSM)
 import Data.Default
+import Data.IORef
+import Data.Maybe
 import Data.String
 import Reflex.Dom.Android.MainWidget
 import System.IO
-import Language.Javascript.JSaddle (JSM)
+import System.IO.Unsafe
+import Language.Javascript.JSaddle (JSM, eval)
 
 run :: JSM () -> IO ()
 run jsm = do
@@ -78,15 +85,22 @@ run jsm = do
         a <- getHaskellActivity
         let startPage = fromString "https://appassets.androidplatform.net/index.html"
         startMainWidget a startPage jsm
+    , _activityCallbacks_onBackPressed = triggerBackButton
     }
   forever $ threadDelay 1000000000
+
+triggerBackButton :: MonadIO m => m ()
+triggerBackButton = withGlobalJSExecutor goBack
+
 #elif defined(wasm32_HOST_ARCH)
 import qualified Language.Javascript.JSaddle.Wasm as Wasm (run)
 import Language.Javascript.JSaddle (JSM)
 run :: JSM () -> IO ()
 run = Wasm.run 0
+
 #else
 import Language.Javascript.JSaddle.WebKitGTK (run)
+
 #endif
 
 mainWidget :: (forall x. Widget x ()) -> IO ()

reflex-dom/src/Reflex/Dom/Location/Platform.hs

@@ -0,0 +1,20 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
+#if defined(ANDROID)
+module Reflex.Dom.Location.Platform where
+
+import Reflex
+import Control.Monad.IO.Class
+import Reflex.Dom.Android.MainWidget
+
+popHistoryState
+  :: (PerformEvent t m, MonadIO (Performable m))
+  => Event t ()
+  -> m ()
+popHistoryState evt = performEvent_ $ withGlobalJSExecutor goBack <$ evt
+#else
+module Reflex.Dom.Location.Platform (Reflex.Dom.Location.popHistoryState) where
+import qualified Reflex.Dom.Location
+
+#endif
+