packages feed

android-activity (empty) → 0.1

raw patch · 7 files changed

+554/−0 lines, 7 filesdep +basedep +data-defaultsetup-changed

Dependencies added: base, data-default

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2017, Obsidian Systems LLC++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Obsidian Systems LLC nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ android-activity.cabal view
@@ -0,0 +1,27 @@+name: android-activity+version: 0.1+synopsis: Turn regular Haskell programs into Android Activities+homepage: https://github.com/obsidiansystems/android-activity+license: BSD3+license-file: LICENSE+author: Obsidian Systems LLC+maintainer: maintainer@obsidian.systems+copyright: Obsidian Systems LLC 2017+category: Mobile+build-type: Simple+extra-source-files:+  java/systems/obsidian/HaskellActivity.java+cabal-version: >=1.10++library+  other-extensions: ForeignFunctionInterface+  build-depends: base >=4.9 && <4.11+               , data-default == 0.7.*+  hs-source-dirs: src+  build-tools: hsc2hs+  default-language: Haskell2010+  c-sources: cbits/HaskellActivity.c+  include-dirs: cbits/include+  install-includes: HaskellActivity.h+  exposed-modules:+    Android.HaskellActivity
+ cbits/HaskellActivity.c view
@@ -0,0 +1,217 @@+#include <stdlib.h>+#include <assert.h>+#include <pthread.h>+#include <unistd.h>+#include <jni.h>+#include <stdio.h>+#include <android/log.h>+#include <setjmp.h>+#include "HsFFI.h"+#include "Rts.h"+#include "HaskellActivity.h"++// From ghc/rts/RtsStartup.c+extern void (*exitFn)(int);++extern StgClosure ZCMain_main_closure;++//TODO: Get everything above this from an existing header file if possible++JavaVM* HaskellActivity_jvm = NULL;++JNIEXPORT void JNICALL Java_systems_obsidian_HaskellActivity_haskellOnCreate (JNIEnv *env, jobject thisObj, long callbacksLong) {+  const ActivityCallbacks *callbacks = (const ActivityCallbacks *)callbacksLong;+  if(callbacks->onCreate) {+    callbacks->onCreate();+  }+}++JNIEXPORT void JNICALL Java_systems_obsidian_HaskellActivity_haskellOnStart (JNIEnv *env, jobject thisObj, long callbacksLong) {+  const ActivityCallbacks *callbacks = (const ActivityCallbacks *)callbacksLong;+  if(callbacks->onStart) {+    callbacks->onStart();+  }+}++JNIEXPORT void JNICALL Java_systems_obsidian_HaskellActivity_haskellOnResume (JNIEnv *env, jobject thisObj, long callbacksLong) {+  const ActivityCallbacks *callbacks = (const ActivityCallbacks *)callbacksLong;+  if(callbacks->onResume) {+    callbacks->onResume();+  }+}++JNIEXPORT void JNICALL Java_systems_obsidian_HaskellActivity_haskellOnPause (JNIEnv *env, jobject thisObj, long callbacksLong) {+  const ActivityCallbacks *callbacks = (const ActivityCallbacks *)callbacksLong;+  if(callbacks->onPause) {+    callbacks->onPause();+  }+}++JNIEXPORT void JNICALL Java_systems_obsidian_HaskellActivity_haskellOnStop (JNIEnv *env, jobject thisObj, long callbacksLong) {+  const ActivityCallbacks *callbacks = (const ActivityCallbacks *)callbacksLong;+  if(callbacks->onStop) {+    callbacks->onStop();+  }+}++JNIEXPORT void JNICALL Java_systems_obsidian_HaskellActivity_haskellOnDestroy (JNIEnv *env, jobject thisObj, long callbacksLong) {+  const ActivityCallbacks *callbacks = (const ActivityCallbacks *)callbacksLong;+  if(callbacks->onDestroy) {+    callbacks->onDestroy();+  }+}++JNIEXPORT void JNICALL Java_systems_obsidian_HaskellActivity_haskellOnRestart (JNIEnv *env, jobject thisObj, long callbacksLong) {+  const ActivityCallbacks *callbacks = (const ActivityCallbacks *)callbacksLong;+  if(callbacks->onRestart) {+    callbacks->onRestart();+  }+}++JNIEXPORT void JNICALL Java_systems_obsidian_HaskellActivity_haskellOnNewIntent (JNIEnv *env, jobject thisObj, long callbacksLong, jstring intent, jstring intentdata) {+  const ActivityCallbacks *callbacks = (const ActivityCallbacks *)callbacksLong;+  if(callbacks->onNewIntent) {+    const char *cstring_intent = (*env)->GetStringUTFChars(env, intent, 0);+    const char *cstring_intentdata = (*env)->GetStringUTFChars(env, intentdata, 0);+    callbacks->onNewIntent(cstring_intent, cstring_intentdata);+    (*env)->ReleaseStringUTFChars(env, intent, cstring_intent);+    (*env)->ReleaseStringUTFChars(env, intentdata, cstring_intentdata);+  }+}++static jmp_buf mainJmpbuf;++// setjmp returns 0 on its initial call, but we want to be able to return all+// exit codes (0 - 255) through it.  So, we offset them by this amount and then+// subtract it off later.+#define EXIT_CODE_OFFSET 0x10000++static void mainFinished(int exitCode) {+	longjmp(mainJmpbuf, exitCode + EXIT_CODE_OFFSET);+}++// Filled in by Java_systems_obsidian_HaskellActivity_haskellStartMain and disposed+// of by haskellActivityContinueWithCallbacks+static jobject haskellActivity = 0;+static jobject setCallbacksQueue = 0;++jobject HaskellActivity_get() {+  return haskellActivity;+}++// Continue constructing the HaskellActivity.+// WARNING: This may only be invoked once per Haskell 'main' invocation+void HaskellActivity_continueWithCallbacks(const ActivityCallbacks *callbacks) {+  assert(haskellActivity);++  JNIEnv *env;+  jint attachResult = (*HaskellActivity_jvm)->AttachCurrentThread(HaskellActivity_jvm, &env, NULL);+  assert(attachResult == JNI_OK);++  jclass cls = (*env)->GetObjectClass(env, haskellActivity);+  jmethodID continueWithCallbacks = (*env)->GetStaticMethodID(env, cls, "continueWithCallbacks", "(Ljava/util/concurrent/SynchronousQueue;J)V");+  assert(continueWithCallbacks);++  (*env)->CallStaticVoidMethod(env, cls, continueWithCallbacks, setCallbacksQueue, callbacks);+  if((*env)->ExceptionOccurred(env)) {+    __android_log_write(ANDROID_LOG_DEBUG, "HaskellActivity", "continueWithCallbacks exception");+    (*env)->ExceptionDescribe(env);+  }++  //TODO: Provide a better way of having access to this+  // (*env)->DeleteGlobalRef(env, haskellActivity);+  // haskellActivity = 0;++  (*env)->DeleteGlobalRef(env, setCallbacksQueue);+  setCallbacksQueue = 0;+}++JNIEXPORT int JNICALL Java_systems_obsidian_HaskellActivity_haskellStartMain (JNIEnv *env, jobject thisObj, jobject setCallbacksQueue_) {+  // Retain the HaskellActivity that we're running under+  haskellActivity = (*env)->NewGlobalRef(env, thisObj);+  setCallbacksQueue = (*env)->NewGlobalRef(env, setCallbacksQueue_);++  // Override Haskell's exit behavior so that it returns here instead of exiting+  // the program when 'main' finishes+  exitFn = mainFinished;+  int exitCode;+  if(exitCode = setjmp(mainJmpbuf)) {+    return exitCode - EXIT_CODE_OFFSET;+  }++  static int argc = 5;+  static char *argv[] = {"jsaddle", "+RTS", "-N2", "-I0", "-RTS"};++  RtsConfig rts_opts = defaultRtsConfig;+  rts_opts.rts_opts_enabled = RtsOptsAll;++  hs_main(argc, argv, &ZCMain_main_closure, rts_opts);++  return 0; // Should never hit this+}++////////////////////////////////////////////////////////////////////////////////+// Logger+////////////////////////////////////////////////////////////////////////////////+// Converts output on stdout and stderr to android log messages++typedef struct loggerConfig {+  int pipe;+  const char *tag;+} loggerConfig;++void *loggerThread(void *cfgVoid) {+  assert(cfgVoid);+  const loggerConfig *cfg = (const loggerConfig *)cfgVoid;+  ssize_t rdsz;+  char buf[256];++  __android_log_write(ANDROID_LOG_DEBUG, cfg->tag, "Logger running");+  while((rdsz = read(cfg->pipe, buf, sizeof buf - 1)) > 0) {+    //TODO: This elides '\n's at the end of the buffer, but what should we do with ones in the middle?+    if(buf[rdsz - 1] == '\n')+      --rdsz;++    buf[rdsz] = 0; // Add null terminator+    __android_log_write(ANDROID_LOG_DEBUG, cfg->tag, buf);+  }+}++// Start the logging thread.  tag will not be copied, and must continue to+// be available indefinitely.+// Note: if the thread is killed, the loggerConfig will be leaked+void startLogger(const char *tag) {+  int pfd[2];++  setvbuf(stdout, 0, _IOLBF, 0);+  setvbuf(stderr, 0, _IOLBF, 0);++  // Create the pipe and redirect stdout and stderr+  pipe(pfd);+  dup2(pfd[1], 1);+  dup2(pfd[1], 2);++  loggerConfig *cfg = malloc(sizeof(loggerConfig));+  cfg->pipe = pfd[0];+  cfg->tag = tag;++  pthread_t thr;+  // Spawn the logging thread+  if(pthread_create(&thr, 0, loggerThread, cfg) == -1) {+      __android_log_write(ANDROID_LOG_DEBUG, tag, "Could not start logger");+      assert(false);+  }+  pthread_detach(thr);+}++////////////////////////////////////////////////////////////////////////////////+// JNI Initialization+////////////////////////////////////////////////////////////////////////////////++JNIEXPORT jint JNICALL JNI_OnLoad ( JavaVM *vm, void *reserved ) {+  HaskellActivity_jvm = vm;++  startLogger("HaskellActivity"); //TODO: Use the app name++  return JNI_VERSION_1_6;+}
+ cbits/include/HaskellActivity.h view
@@ -0,0 +1,19 @@+#ifndef HASKELLACTIVITY_H_INCLUDED+#define HASKELLACTIVITY_H_INCLUDED++#include <jni.h>++typedef struct ActivityCallbacks {+  void (*onCreate) (); //TODO: Support savedInstanceState+  void (*onStart) ();+  void (*onResume) ();+  void (*onPause) ();+  void (*onStop) ();+  void (*onDestroy) ();+  void (*onRestart) ();+  void (*onNewIntent) (const char *, const char *); //TODO: Pass the whole argument and use JNI+} ActivityCallbacks;++extern JavaVM* HaskellActivity_jvm;++#endif
+ java/systems/obsidian/HaskellActivity.java view
@@ -0,0 +1,138 @@+package systems.obsidian;++import android.app.Activity;+import android.content.Context;+import android.content.Intent;+import android.os.Bundle;+import android.util.Log;+import android.view.ViewGroup.LayoutParams;+import android.view.Window;+import android.webkit.CookieManager;+import android.webkit.WebSettings;+import android.webkit.WebView;+import java.util.concurrent.SynchronousQueue;++public class HaskellActivity extends Activity {+  public native int haskellStartMain(SynchronousQueue<Long> setCallbacks);+  public native void haskellOnCreate(long callbacks);+  public native void haskellOnStart(long callbacks);+  public native void haskellOnResume(long callbacks);+  public native void haskellOnPause(long callbacks);+  public native void haskellOnStop(long callbacks);+  public native void haskellOnDestroy(long callbacks);+  public native void haskellOnRestart(long callbacks);+  public native void haskellOnNewIntent(long callbacks, String intent, String intentdata);++  // Apparently 'long' is the right way to store a C pointer in Java+  // See https://stackoverflow.com/questions/337268/what-is-the-correct-way-to-store-a-native-pointer-inside-a-java-object+  final long callbacks;++  static {+    System.loadLibrary("HaskellActivity");+  }++  public HaskellActivity() throws InterruptedException {+    final SynchronousQueue<Long> setCallbacks = new SynchronousQueue<Long>();+    new Thread() {+      public void run() {+        final int exitCode = haskellStartMain(setCallbacks);+        Log.d("HaskellActivity", String.format("Haskell main action exited with status %d", exitCode));+        try {+          // Since Haskell's main has exited, it won't call mainStarted.+          // Instead, we unblock the main thread here.+          //TODO: If continueWithCallbacks has already been called, is this safe?+          setCallbacks.put(0L); //TODO: Always call finish() if we hit this+        } catch(InterruptedException e) {+          //TODO: Should we do something with this?+        }+      }+    }.start();+    callbacks = setCallbacks.take();+  }++  // This can be called by the Haskell application to unblock the construction+  // of the HaskellActivity and proced with the given callbacks++  // NOTE: This shouldn't be an instance method, because it must be called *before*+  // the constructor returns (it *causes* the constructor to return).+  // 'callbacks' should never be 0+  private static void continueWithCallbacks(SynchronousQueue<Long> setCallbacks, long callbacks) {+    try {+      setCallbacks.put(callbacks);+    } catch(InterruptedException e) {+      Log.d("HaskellActivity", "setting callbacks interrupted");+      //TODO: Should we do something with this?+    }+  }++  @Override+  public void onCreate(Bundle savedInstanceState) {+    super.onCreate(savedInstanceState);+    // We can't call finish() in the constructor, as it will have no effect, so+    // we call it here whenever we reach this code without having hit+    // 'continueWithCallbacks'+    if(callbacks == 0) {+      finish();+    } else {+      haskellOnCreate(callbacks); //TODO: Pass savedInstanceState as well+    }+  }++  @Override+  public void onStart() {+    super.onStart();+    if(callbacks != 0) {+      haskellOnStart(callbacks);+    }+  }++  @Override+  public void onResume() {+    super.onResume();+    if(callbacks != 0) {+      haskellOnResume(callbacks);+    }+  }++  @Override+  public void onPause() {+    super.onPause();+    if(callbacks != 0) {+      haskellOnPause(callbacks);+    }+  }++  @Override+  public void onStop() {+    super.onStop();+    if(callbacks != 0) {+      haskellOnStop(callbacks);+    }+  }++  @Override+  public void onDestroy() {+    super.onDestroy();+    if(callbacks != 0) {+      haskellOnDestroy(callbacks);+    }+    //TODO: Should we call hs_exit somehow here?+    android.os.Process.killProcess(android.os.Process.myPid()); //TODO: Properly handle the process surviving between invocations which means that the Haskell RTS needs to not be initialized twice.+  }++  @Override+  public void onRestart() {+    super.onRestart();+    if(callbacks != 0) {+      haskellOnRestart(callbacks);+    }+  }++  @Override+  public void onNewIntent(Intent intent) {+    super.onNewIntent(intent);+    if(callbacks != 0 && intent != null && intent.getData() != null && intent.getAction() != null) {+      haskellOnNewIntent(callbacks, intent.getAction(), intent.getDataString()); //TODO: Use a more canonical way of passing this data - i.e. pass the Intent and let the Haskell side get the data out with JNI+    }+  }+}
+ src/Android/HaskellActivity.hsc view
@@ -0,0 +1,121 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Android.HaskellActivity+  ( ActivityCallbacks (..)+  , HaskellActivity (..)+  , getHaskellActivity+  , continueWithCallbacks+  , traceActivityCallbacks+  ) where++import Control.Exception+import Data.Default+import Data.Monoid+import Debug.Trace+import Foreign.C.String+import Foreign.Marshal.Utils+import Foreign.Ptr+import Foreign.Storable++#include "HaskellActivity.h"++newtype HaskellActivity = HaskellActivity { unHaskellActivity :: Ptr HaskellActivity }++foreign import ccall unsafe "HaskellActivity_get" getHaskellActivity :: IO HaskellActivity++-- | Allow the HaskellActivity to proceed.  The given callbacks will be invoked+-- at the appropriate times in the Android Activity lifecycle.+-- WARNING: This should only be invoked once per application execution.+continueWithCallbacks :: ActivityCallbacks -> IO ()+continueWithCallbacks ac = do+  continueWithCallbacks_ =<< new =<< activityCallbacksToPtrs ac++foreign import ccall safe "HaskellActivity_continueWithCallbacks" continueWithCallbacks_ :: Ptr ActivityCallbacksPtrs -> IO ()++data ActivityCallbacks = ActivityCallbacks+  { _activityCallbacks_onCreate :: () -> IO () -- The () input here will eventually become a representation of the Bundle that Android passes in; this placeholder is to make the change easier+  , _activityCallbacks_onStart :: IO ()+  , _activityCallbacks_onResume :: IO ()+  , _activityCallbacks_onPause :: IO ()+  , _activityCallbacks_onStop :: IO ()+  , _activityCallbacks_onDestroy :: IO ()+  , _activityCallbacks_onRestart :: IO ()+  , _activityCallbacks_onNewIntent :: String -> String -> IO ()+  }++instance Default ActivityCallbacks where+  def = ActivityCallbacks+    { _activityCallbacks_onCreate = \_ -> return ()+    , _activityCallbacks_onStart = return ()+    , _activityCallbacks_onResume = return ()+    , _activityCallbacks_onPause = return ()+    , _activityCallbacks_onStop = return ()+    , _activityCallbacks_onDestroy = return ()+    , _activityCallbacks_onRestart = return ()+    , _activityCallbacks_onNewIntent = \_ _ -> return ()+    }++traceBracket :: String -> IO a -> IO a+traceBracket s = bracket (traceIO $ s <> " entered") (\_ -> traceIO $ s <> " exited") . const++traceActivityCallbacks :: ActivityCallbacks -> ActivityCallbacks+traceActivityCallbacks ac = ActivityCallbacks+  { _activityCallbacks_onCreate = \x -> traceBracket "onCreate" $ _activityCallbacks_onCreate ac x+  , _activityCallbacks_onStart = traceBracket "onStart" $ _activityCallbacks_onStart ac+  , _activityCallbacks_onResume = traceBracket "onResume" $ _activityCallbacks_onResume ac+  , _activityCallbacks_onPause = traceBracket "onPause" $ _activityCallbacks_onPause ac+  , _activityCallbacks_onStop = traceBracket "onStop" $ _activityCallbacks_onStop ac+  , _activityCallbacks_onDestroy = traceBracket "onDestroy" $ _activityCallbacks_onDestroy ac+  , _activityCallbacks_onRestart = traceBracket "onRestart" $ _activityCallbacks_onRestart ac+  , _activityCallbacks_onNewIntent = \x y -> traceBracket "onNewIntent" $ _activityCallbacks_onNewIntent ac x y+  }++foreign import ccall "wrapper" wrapIO :: IO () -> IO (FunPtr (IO ()))++foreign import ccall "wrapper" wrapCStringCStringIO :: (CString -> CString -> IO ()) -> IO (FunPtr (CString -> CString -> IO ()))++activityCallbacksToPtrs :: ActivityCallbacks -> IO ActivityCallbacksPtrs+activityCallbacksToPtrs ac = ActivityCallbacksPtrs+  <$> wrapIO (_activityCallbacks_onCreate ac ())+  <*> wrapIO (_activityCallbacks_onStart ac)+  <*> wrapIO (_activityCallbacks_onResume ac)+  <*> wrapIO (_activityCallbacks_onPause ac)+  <*> wrapIO (_activityCallbacks_onStop ac)+  <*> wrapIO (_activityCallbacks_onDestroy ac)+  <*> wrapIO (_activityCallbacks_onRestart ac)+  <*> wrapCStringCStringIO (\a b -> do+                               a' <- peekCString a+                               b' <- peekCString b+                               _activityCallbacks_onNewIntent ac a' b')++data ActivityCallbacksPtrs = ActivityCallbacksPtrs+  { _activityCallbacksPtrs_onCreate :: FunPtr (IO ())+  , _activityCallbacksPtrs_onStart :: FunPtr (IO ())+  , _activityCallbacksPtrs_onResume :: FunPtr (IO ())+  , _activityCallbacksPtrs_onPause :: FunPtr (IO ())+  , _activityCallbacksPtrs_onStop :: FunPtr (IO ())+  , _activityCallbacksPtrs_onDestroy :: FunPtr (IO ())+  , _activityCallbacksPtrs_onRestart :: FunPtr (IO ())+  , _activityCallbacksPtrs_onNewIntent :: FunPtr (CString -> CString -> IO ())+  }++instance Storable ActivityCallbacksPtrs where+  sizeOf _ = #{size ActivityCallbacks}+  alignment _ = #{alignment ActivityCallbacks}+  poke p ac = do+    #{poke ActivityCallbacks, onCreate} p $ _activityCallbacksPtrs_onCreate ac+    #{poke ActivityCallbacks, onStart} p $ _activityCallbacksPtrs_onStart ac+    #{poke ActivityCallbacks, onResume} p $ _activityCallbacksPtrs_onResume ac+    #{poke ActivityCallbacks, onPause} p $ _activityCallbacksPtrs_onPause ac+    #{poke ActivityCallbacks, onStop} p $ _activityCallbacksPtrs_onStop ac+    #{poke ActivityCallbacks, onDestroy} p $ _activityCallbacksPtrs_onDestroy ac+    #{poke ActivityCallbacks, onRestart} p $ _activityCallbacksPtrs_onRestart ac+    #{poke ActivityCallbacks, onNewIntent} p $ _activityCallbacksPtrs_onNewIntent ac+  peek p = ActivityCallbacksPtrs+    <$> #{peek ActivityCallbacks, onCreate} p+    <*> #{peek ActivityCallbacks, onStart} p+    <*> #{peek ActivityCallbacks, onResume} p+    <*> #{peek ActivityCallbacks, onPause} p+    <*> #{peek ActivityCallbacks, onStop} p+    <*> #{peek ActivityCallbacks, onDestroy} p+    <*> #{peek ActivityCallbacks, onRestart} p+    <*> #{peek ActivityCallbacks, onNewIntent} p