packages feed

jsaddle-wkwebview (empty) → 0.6.0.0

raw patch · 5 files changed

+192/−0 lines, 5 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, jsaddle

Files

+ LICENSE view
@@ -0,0 +1,21 @@+Copyright (c) 2010-2012 Hamish Mackenzie, Victor Nazarov, Luite Stegeman++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+
+ Setup.lhs view
@@ -0,0 +1,6 @@+#!/usr/bin/runhaskell +> module Main where+> import Distribution.Simple+> main :: IO ()+> main = defaultMain+
+ cbits/WKWebView.m view
@@ -0,0 +1,55 @@+#include "HsFFI.h"+#import <Foundation/Foundation.h>+#import <WebKit/WebKit.h>++extern void jsaddleStart(HsStablePtr);+extern void jsaddleResult(HsStablePtr, const char *  _Nonnull result);++@interface JSaddleHandler : NSObject<WKNavigationDelegate, WKScriptMessageHandler>++@property (nonatomic, assign) HsStablePtr startHandler;+@property (nonatomic, assign) HsStablePtr resultHandler;++- (instancetype)initHandler:(HsStablePtr)startHandler resultHandler:(HsStablePtr)resultHandler;++@end++@implementation JSaddleHandler++- (instancetype)initHandler:(HsStablePtr)startHandler resultHandler:(HsStablePtr)resultHandler+{+    self = [super init];+    if (self) {+        _startHandler = startHandler;+        _resultHandler = resultHandler;+    }+    return self;+}++- (void)webView:(WKWebView *)webView didFinishNavigation:(WKNavigation *)navigation+{+    jsaddleStart(self.startHandler);+}++- (void)userContentController:(WKUserContentController *)userContentController didReceiveScriptMessage:(WKScriptMessage *)message+{+    NSString * s = (NSString *) message.body;+    jsaddleResult(self.resultHandler, [s UTF8String]);+}++@end++void addJSaddleHandler(WKWebView *webView, HsStablePtr startHandler,  HsStablePtr resultHandler) {+    JSaddleHandler * handler = [[JSaddleHandler alloc] initHandler:startHandler resultHandler:resultHandler];+    [[[webView configuration] userContentController] addScriptMessageHandler:handler name:@"jsaddle"];+    webView.navigationDelegate = handler;+}++void evaluateJavaScript(WKWebView *webView, const char * _Nonnull js) {+    [webView evaluateJavaScript:[NSString stringWithCString:js encoding:NSUTF8StringEncoding] completionHandler:NULL];+}++void loadHTMLString(WKWebView *webView, const char * _Nonnull html) {+    [webView loadHTMLString:[NSString stringWithCString:html encoding:NSUTF8StringEncoding] baseURL:NULL];+}+
+ jsaddle-wkwebview.cabal view
@@ -0,0 +1,33 @@+name: jsaddle-wkwebview+version: 0.6.0.0+cabal-version: >=1.10+build-type: Simple+license: MIT+license-file: LICENSE+maintainer: Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+synopsis: Interface for JavaScript that works with GHCJS and GHC+description:+    This package provides an EDSL for calling JavaScript that+    can be used both from GHCJS and GHC.  When using GHC+    the application is run using Warp and WebSockets to+    drive a small JavaScipt helper.+category: Web, Javascript+author: Hamish Mackenzie++source-repository head+    type: git+    location: https://github.com/ghcjs/jsaddle++library+    exposed-modules:+        Language.Javascript.JSaddle.WKWebView+    build-depends:+        aeson >=0.8.0.2 && <1.1,+        base <5,+        bytestring >=0.10.6.0 && <0.11,+        jsaddle >= 0.6.0.0 && <0.7+    default-language: Haskell2010+    hs-source-dirs: src+    ghc-options: -ferror-spans -Wall+    c-sources: cbits/WKWebView.m+
+ src/Language/Javascript/JSaddle/WKWebView.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE ForeignFunctionInterface, OverloadedStrings #-}+module Language.Javascript.JSaddle.WKWebView+    ( jsaddleMain+    , WKWebView(..)+    ) where++import Control.Monad (void, join)+import Control.Concurrent (forkIO)++import Data.Monoid ((<>))+import Data.ByteString (useAsCString, packCString)+import Data.ByteString.Lazy (ByteString, toStrict, fromStrict)+import Data.Aeson (encode, decode)++import Foreign.C.String (CString)+import Foreign.Ptr (Ptr)+import Foreign.StablePtr (StablePtr, newStablePtr, deRefStablePtr)++import Language.Javascript.JSaddle (Result, JSM)+import Language.Javascript.JSaddle.Run (runJavaScript)+import Language.Javascript.JSaddle.Run.Files (initState, runBatch)++newtype WKWebView = WKWebView (Ptr WKWebView)++foreign export ccall jsaddleStart :: StablePtr (IO ()) -> IO ()+foreign export ccall jsaddleResult :: StablePtr (Result -> IO ()) -> CString -> IO ()+foreign import ccall addJSaddleHandler :: WKWebView -> StablePtr (IO ()) -> StablePtr (Result -> IO ()) -> IO ()+foreign import ccall loadHTMLString :: WKWebView -> CString -> IO ()+foreign import ccall evaluateJavaScript :: WKWebView -> CString -> IO ()++jsaddleMain :: JSM () -> WKWebView -> IO ()+jsaddleMain f webView = do+    (processResult, start) <- runJavaScript (\batch ->+        useAsCString (toStrict $ "runJSaddleBatch(" <> encode batch <> ");") $+            evaluateJavaScript webView)+        f++    startHandler <- newStablePtr (void $ forkIO start)+    resultHandler <- newStablePtr processResult+    addJSaddleHandler webView startHandler resultHandler++    useAsCString (toStrict indexHtml) $ loadHTMLString webView+    useAsCString (toStrict jsaddleJs) $ evaluateJavaScript webView++jsaddleStart :: StablePtr (IO ()) -> IO ()+jsaddleStart ptrHandler = join (deRefStablePtr ptrHandler)++jsaddleResult :: StablePtr (Result -> IO ()) -> CString -> IO ()+jsaddleResult ptrHandler s = do+    processResult <- deRefStablePtr ptrHandler+    result <- packCString s+    case decode (fromStrict result) of+        Nothing -> error $ "jsaddle WebSocket decode failed : " <> show result+        Just r  -> processResult r++jsaddleJs :: ByteString+jsaddleJs = "\+    \runJSaddleBatch = (function() {\n\+    \ " <> initState <> "\n\+    \ return function(batch) {\n\+    \ " <> runBatch (\a -> "window.webkit.messageHandlers.jsaddle.postMessage(JSON.stringify(" <> a <> "));") <> "\+    \ };\n\+    \})();\n\+    \"++indexHtml :: ByteString+indexHtml =+    "<!DOCTYPE html>\n\+    \<html>\n\+    \<head>\n\+    \<title>JSaddle</title>\n\+    \</head>\n\+    \<body>\n\+    \</body>\n\+    \</html>"++-- jsaddle