ghcjs-promise (empty) → 0.1.0.0
raw patch · 5 files changed
+236/−0 lines, 5 filesdep +basedep +ghcjs-basedep +randomsetup-changed
Dependencies added: base, ghcjs-base, random
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- ghcjs-promise.cabal +28/−0
- src/Data/JSVal/Promise.hs +123/−0
- src/js/promise_functions.js +53/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2016, Alejandro Durán Pallarés.++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 Alejandro D.P. 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
+ ghcjs-promise.cabal view
@@ -0,0 +1,28 @@+name: ghcjs-promise+version: 0.1.0.0+synopsis: Bidirectional bidings to javascript's promise.+description: Bidirectional bidings to javascript's promise.+homepage: https://github.com/vwwv/ghcjs-promise+license: BSD3+license-file: LICENSE+author: Alejandro Durán Pallarés+maintainer: vwwv@correo.ugr.es+category: Data+build-type: Simple+-- extra-source-files:+cabal-version: >=1.10++library+ hs-source-dirs: src+ js-sources: src/js/promise_functions.js+ exposed-modules: Data.JSVal.Promise+ build-depends: base >= 4.7 && < 5+ , ghcjs-base+ -- , uuid+ , random++ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/vwwv/ghcjs-promise
+ src/Data/JSVal/Promise.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE JavaScriptFFI+ , OverloadedStrings+ #-}++{-|++Module : Data.JSVal.Promise +Copyright : (c) Alejandro Durán Pallarés, 2016+License : BSD3+Maintainer : vwwv@correo.ugr.es+Stability : experimental+++Data.JSVal.Promise defines `Promise`, a direct bind to javascript promise objects.++- You can import/export them from javascript code using its `FromJSVal` and `ToJSVal` instances.++- You can extract its value, blocking till computation has finished, using `await`. (you can safely call + it several time from different threads, the associated computation will run once, and then memorized)++- You can create new promise (to possible use js side) containing arbitrary haskell code using `promise`.++For some usage example, checkout this [blog entry](http://the.spaghetticodeball.xyz/haskell/javascript/2016/10/10/new-library-ghcjs-promise.html).++-}+++module Data.JSVal.Promise( Promise()+ , await+ , promise+ ) where++import GHCJS.Marshal+import GHCJS.Types+import GHCJS.Foreign+import Control.Exception+import Control.Concurrent+++newtype Promise = Promise {fromPromise :: JSVal}++instance FromJSVal Promise where+ fromJSVal x = do is_promise <- js_check_if_promise x+ if is_promise+ then return . Just $ Promise x+ else return Nothing++instance ToJSVal Promise where+ toJSVal = return . fromPromise++-- | If the promise is return through "then", it will return `Right`;+-- if it return through "catch", then it will return `Left`+await :: Promise -> IO (Either JSVal JSVal)+await (Promise jsval) = do result <- js_await jsval+ x <- js_attribute "result" result+ ok <- isTruthy <$> js_attribute "ok" result+ if ok+ then return (Right x)+ else return (Left x)++-- | A `Right` value will be sent as a normal value through "then", a left+-- value will be sent through "catch" (by javascript convention, representing +-- an exception).+--+-- The block will start executing immediately, no mater if there's something waiting+-- for it or not.+--+-- If the execution block launches an exception, then the promise will be receive+-- as "reject", the javascript value "new Error('Haskell side error')"+promise :: IO (Either JSVal JSVal) -> IO Promise+promise action = do ref <- js_book_promise+ promise <- js_set_promise ref+ myid <- myThreadId+ forkIO $ do val_ <- try action+ case val_ of+ + Right (Right x) -> js_do_resolve ref x+ + Right (Left x) -> js_do_reject ref x+ + Left exc -> do throwTo myid (exc::SomeException)+ js_do_reject ref =<< create_error + return $ Promise promise+-----------------------------------------------------------------------+-----------------------------------------------------------------------+++-- This works because the [algorithm](http://www.ecma-international.org/ecma-262/6.0/#sec-promise.resolve) +-- explicitly demands that Promise.resolve must return the exact object passed in if and only if +-- it is a promise by the definition of the spec.+-- (from stackoverflow http://stackoverflow.com/questions/27746304/how-do-i-tell-if-an-object-is-a-promise)+foreign import javascript safe + "Promise.resolve($1) == $1" + js_check_if_promise :: JSVal -> IO Bool++foreign import javascript safe + "$2[$1]"+ js_attribute :: JSString -> JSVal -> IO JSVal++foreign import javascript safe + "new Error('Haskell side error')"+ create_error :: IO JSVal+++foreign import javascript safe + "__js_book_promise()" + js_book_promise :: IO JSVal ++foreign import javascript safe + "__js_set_promise($1)"+ js_set_promise :: JSVal -> IO JSVal++foreign import javascript safe + "__js_do_reject($1,$2);"+ js_do_reject :: JSVal -> JSVal -> IO ()++foreign import javascript safe + "__js_do_resolve($1, $2);"+ js_do_resolve :: JSVal -> JSVal -> IO ()++foreign import javascript interruptible+ "__js_await($1,$c);" + js_await :: JSVal -> IO JSVal
+ src/js/promise_functions.js view
@@ -0,0 +1,53 @@+++++++++var counter = 0;+var booked = {};++function __js_book_promise(){+ counter = counter + 1;+ return counter;+}++function __js_set_promise(ref){+ return new Promise(+ function(resolve, reject){+ booked[''+ref] = { resolve : resolve+ , reject : reject+ };+ }+ );+}++function __js_do_reject(ref, val){+ booked[''+ref].reject(val);+ delete booked[''+ref]+}+++function __js_do_resolve(ref, val){+ booked[''+ref].resolve(val);+ delete booked[''+ref]+}++function __js_await(promise,continuation){+ promise.then( function(x){ + continuation({ result : x, ok : true}) + } + ); + + promise['catch']( function(x){ + continuation({ result : x, ok : false}) + } + ); +}+++++