mirror of
https://github.com/beijaflor-io/ghcjs-commonjs.git
synced 2024-10-26 19:13:10 +03:00
Get hello world to working state
This commit is contained in:
parent
306ff5c90e
commit
603be99445
20
example-react-serverside-rendering/LICENSE
Normal file
20
example-react-serverside-rendering/LICENSE
Normal file
@ -0,0 +1,20 @@
|
||||
Copyright (c) 2016 Pedro Tacla Yamada
|
||||
|
||||
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.
|
2
example-react-serverside-rendering/Setup.hs
Normal file
2
example-react-serverside-rendering/Setup.hs
Normal file
@ -0,0 +1,2 @@
|
||||
import Distribution.Simple
|
||||
main = defaultMain
|
@ -0,0 +1,17 @@
|
||||
name: example-react-serverside-rendering
|
||||
version: 0.1.0.0
|
||||
synopsis: An example for ghcjs-commonjs
|
||||
homepage: https://github.com/beijaflor-io/ghcjs-commonjs
|
||||
license: MIT
|
||||
license-file: LICENSE
|
||||
author: Pedro Tacla Yamada
|
||||
maintainer: tacla.yamada@gmail.com
|
||||
category: Web
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
|
||||
executable example-react-serverside-rendering
|
||||
main-is: Main.hs
|
||||
build-depends: base >=4.8 && <4.9
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
4
example-react-serverside-rendering/src/Main.hs
Normal file
4
example-react-serverside-rendering/src/Main.hs
Normal file
@ -0,0 +1,4 @@
|
||||
module Main where
|
||||
|
||||
main :: IO ()
|
||||
main = undefined
|
1
examples/.#ghcjs-require.js
Symbolic link
1
examples/.#ghcjs-require.js
Symbolic link
@ -0,0 +1 @@
|
||||
yamadapc@Pedros-MBP.42571
|
3
examples/Makefile
Normal file
3
examples/Makefile
Normal file
@ -0,0 +1,3 @@
|
||||
hello-world: FORCE
|
||||
|
||||
FORCE:
|
4
examples/README.md
Normal file
4
examples/README.md
Normal file
@ -0,0 +1,4 @@
|
||||
# ghcjs-commonjs-examples
|
||||
This is a collection of runnable examples for **ghcjs-commonjs**, there's a
|
||||
`Vagrantfile` and `Dockerfile` in this directory so you can get everything up
|
||||
and running quickly.
|
8
examples/hello-world/Main.hs
Normal file
8
examples/hello-world/Main.hs
Normal file
@ -0,0 +1,8 @@
|
||||
module Main where
|
||||
|
||||
import qualified GHCJS.CommonJS as CommonJS
|
||||
|
||||
main :: IO ()
|
||||
main = CommonJS.exportMain
|
||||
[ CommonJS.pack ("sayHello", putStrLn "Hello, I'm a Haskell")
|
||||
]
|
29
examples/hello-world/README.md
Normal file
29
examples/hello-world/README.md
Normal file
@ -0,0 +1,29 @@
|
||||
# ghcjs-commonjs-hello-world
|
||||
GHCJS CommonJS Hello Haskell World example.
|
||||
|
||||
## Building
|
||||
Running:
|
||||
```
|
||||
npm install
|
||||
```
|
||||
Will install dependencies and run an initial build. To re-build you can run:
|
||||
```
|
||||
npm run build
|
||||
```
|
||||
|
||||
## Running
|
||||
The generated code should be executable in **Node.js** and the **Browser**.
|
||||
|
||||
### Running on the Browser
|
||||
```
|
||||
npm run start-browser
|
||||
```
|
||||
|
||||
Should open a **Browser** window running the code.
|
||||
|
||||
### Running on Node.js
|
||||
```
|
||||
npm run start-node
|
||||
```
|
||||
|
||||
Should run the code on **Node.js**.
|
2
examples/hello-world/Setup.hs
Normal file
2
examples/hello-world/Setup.hs
Normal file
@ -0,0 +1,2 @@
|
||||
import Distribution.Simple
|
||||
main = defaultMain
|
14
examples/hello-world/ghcjs-commonjs-hello-world.cabal
Normal file
14
examples/hello-world/ghcjs-commonjs-hello-world.cabal
Normal file
@ -0,0 +1,14 @@
|
||||
name: ghcjs-commonjs-hello-world
|
||||
version: 0.1.0.0
|
||||
author: Pedro Tacla Yamada
|
||||
maintainer: tacla.yamada@gmail.com
|
||||
category: Web
|
||||
build-type: Simple
|
||||
extra-source-files: README.md
|
||||
cabal-version: >=1.10
|
||||
|
||||
executable ghcjs-commonjs-hello-world
|
||||
main-is: Main.hs
|
||||
build-depends: base >=4.8 && <4.9
|
||||
, ghcjs-commonjs
|
||||
default-language: Haskell2010
|
8
examples/hello-world/index.js
Normal file
8
examples/hello-world/index.js
Normal file
@ -0,0 +1,8 @@
|
||||
const ghcjsRequire = require('ghcjs-require');
|
||||
const HelloWorld = ghcjsRequire(module, 'ghcjs-commonjs-hello-world');
|
||||
|
||||
HelloWorld(({wrapped}) => {
|
||||
wrapped.sayHello().then(() => {
|
||||
console.log('And I\'m a JavaScript');
|
||||
});
|
||||
});
|
15
examples/hello-world/package.json
Normal file
15
examples/hello-world/package.json
Normal file
@ -0,0 +1,15 @@
|
||||
{
|
||||
"name": "ghcjs-commonjs-hello-world",
|
||||
"version": "1.0.0",
|
||||
"description": "GHCJS CommonJS Hello Haskell World example",
|
||||
"main": "index.js",
|
||||
"scripts": {
|
||||
"build": "stack build --install-ghc",
|
||||
"test": "mocha"
|
||||
},
|
||||
"author": "Pedro Tacla Yamada",
|
||||
"license": "MIT",
|
||||
"dependencies": {
|
||||
"ghcjs-require": "file:///Users/yamadapc/program/github.com/beijaflor-io/ghcjs-commonjs/ghcjs-require"
|
||||
}
|
||||
}
|
13
examples/hello-world/stack.yaml
Normal file
13
examples/hello-world/stack.yaml
Normal file
@ -0,0 +1,13 @@
|
||||
resolver: lts-6.3
|
||||
compiler: ghcjs-0.2.0.20160414_ghc-7.10.3
|
||||
compiler-check: match-exact
|
||||
setup-info:
|
||||
ghcjs:
|
||||
source:
|
||||
ghcjs-0.2.0.20160414_ghc-7.10.3:
|
||||
url: https://s3.amazonaws.com/ghcjs/ghcjs-0.2.0.20160414_ghc-7.10.3.tar.gz
|
||||
sha1: 6d6f307503be9e94e0c96ef1308c7cf224d06be3
|
||||
|
||||
packages:
|
||||
- .
|
||||
- ../../ghcjs-commonjs
|
@ -12,10 +12,12 @@ build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
|
||||
library
|
||||
exposed-modules: GHCJS.Require
|
||||
exposed-modules: GHCJS.CommonJS
|
||||
, JavaScript.EventEmitter
|
||||
, JavaScript.EventEmitter.Internal
|
||||
build-depends: base >=4.8 && <4.9
|
||||
, containers >= 0.5.6.3
|
||||
, ghcjs-base
|
||||
, hashtables
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
|
210
ghcjs-commonjs/src/GHCJS/CommonJS.hs
Normal file
210
ghcjs-commonjs/src/GHCJS/CommonJS.hs
Normal file
@ -0,0 +1,210 @@
|
||||
{-# LANGUAGE ExistentialQuantification #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE ImpredicativeTypes #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverlappingInstances #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module GHCJS.CommonJS
|
||||
where
|
||||
|
||||
import Control.Concurrent
|
||||
import Control.Monad
|
||||
import qualified Data.JSString as JSString (unpack)
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.String
|
||||
import GHCJS.Foreign.Callback
|
||||
import GHCJS.Marshal
|
||||
import GHCJS.Types
|
||||
import qualified JavaScript.Array as JSArray (fromList)
|
||||
import JavaScript.EventEmitter
|
||||
|
||||
import GHCJS.CommonJS.Internal
|
||||
import System.IO.Unsafe
|
||||
|
||||
data CommonJSExportArity t = CommonJSExportArity Int
|
||||
| CommonJSExportArityApply
|
||||
|
||||
type CommonJSExport = [JSVal] -> IO [JSVal]
|
||||
|
||||
class ToCommonJSExport t where
|
||||
exportName :: t -> String
|
||||
toCommonJSExport :: t -> CommonJSExport
|
||||
arity :: CommonJSExportArity t
|
||||
|
||||
instance ToCommonJSExport (String, IO ()) where
|
||||
exportName = fst
|
||||
toCommonJSExport (_, action) _ = void action >> return []
|
||||
arity = CommonJSExportArity 0
|
||||
|
||||
instance ToJSVal () where
|
||||
toJSVal _ = return nullRef
|
||||
|
||||
instance (FromJSVal a, ToJSVal b) => ToCommonJSExport (String, a -> IO b) where
|
||||
exportName = fst
|
||||
toCommonJSExport (n, action) (a:_) = do
|
||||
v <- fromJSValIO n a >>= action
|
||||
jsV <- toJSVal v
|
||||
return [jsV]
|
||||
toCommonJSExport (n, _) _ = error ("Missing required argument to " ++ n)
|
||||
arity = CommonJSExportArity 1
|
||||
|
||||
instance (FromJSVal a1, FromJSVal a2, ToJSVal b) => ToCommonJSExport (String, a1 -> a2 -> IO b) where
|
||||
exportName = fst
|
||||
toCommonJSExport (n, action) (a1:a2:_) = do
|
||||
a1' <- fromJSValIO n a1
|
||||
a2' <- fromJSValIO n a2
|
||||
v <- action a1' a2'
|
||||
jsV <- toJSVal v
|
||||
return [jsV]
|
||||
toCommonJSExport (n, _) _ = error ("Missing required argument(s) to " ++ n)
|
||||
arity = CommonJSExportArity 2
|
||||
|
||||
instance (FromJSVal a1, FromJSVal a2, FromJSVal a3, ToJSVal b) => ToCommonJSExport (String, a1 -> a2 -> a3 -> IO b) where
|
||||
exportName = fst
|
||||
toCommonJSExport (n, action) (a1:a2:a3:_) = do
|
||||
a1' <- fromJSValIO n a1
|
||||
a2' <- fromJSValIO n a2
|
||||
a3' <- fromJSValIO n a3
|
||||
v <- action a1' a2' a3'
|
||||
jsV <- toJSVal v
|
||||
return [jsV]
|
||||
toCommonJSExport (n, _) _ = error ("Missing required argument(s) to " ++ n)
|
||||
arity = CommonJSExportArity 2
|
||||
|
||||
instance (FromJSVal a, ToJSVal b) => ToCommonJSExport (String, [a] -> IO [b]) where
|
||||
exportName = fst
|
||||
toCommonJSExport (n, action) as = do
|
||||
as' <- fromJSValListOfIO n as
|
||||
v <- action as'
|
||||
mapM toJSVal v
|
||||
arity = CommonJSExportArityApply
|
||||
|
||||
instance ToCommonJSExport (String, [JSVal] -> IO [JSVal]) where
|
||||
exportName = fst
|
||||
toCommonJSExport = snd
|
||||
arity = CommonJSExportArityApply
|
||||
|
||||
instance (ToJSVal a) => ToCommonJSExport (String, IO a) where
|
||||
exportName = fst
|
||||
toCommonJSExport (_, action) _ = do
|
||||
v <- action
|
||||
mv <- toJSVal v
|
||||
return [mv]
|
||||
arity = CommonJSExportArity 0
|
||||
|
||||
instance (FromJSVal b, ToJSVal a) => ToCommonJSExport (String, b -> a) where
|
||||
exportName = fst
|
||||
toCommonJSExport (n, action) (a:_) = do
|
||||
a' <- fromJSValIO n a
|
||||
let v = action a'
|
||||
mv <- toJSVal v
|
||||
return [mv]
|
||||
toCommonJSExport (n, _) _ = error ("Missing required argument(s) to " ++ n)
|
||||
arity = CommonJSExportArity 1
|
||||
|
||||
instance (ToJSVal a) => ToCommonJSExport (String, a) where
|
||||
exportName = fst
|
||||
toCommonJSExport (_, action) _ = do
|
||||
let v = action
|
||||
mv <- toJSVal v
|
||||
return [mv]
|
||||
arity = CommonJSExportArity 0
|
||||
|
||||
fromJSValListOfIO :: FromJSVal a => String -> [JSVal] -> IO [a]
|
||||
fromJSValListOfIO n as = do
|
||||
asms <- mapM fromJSVal as -- :: FromJSVal a => IO [Maybe a]
|
||||
case sequence asms of -- :: Maybe [a] of
|
||||
Nothing -> error ("Wrong type of arguments suplied to " ++ n ++
|
||||
". All arguments should have the same type")
|
||||
Just as' -> return as'
|
||||
|
||||
fromJSValIO :: FromJSVal a => String -> JSVal -> IO a
|
||||
fromJSValIO n a = fromJSVal a >>= \case
|
||||
Nothing -> error ("Wrong type of argument suplied to " ++ n)
|
||||
Just a' -> return a'
|
||||
|
||||
-- data Export where
|
||||
-- Export :: CommonJSExport e => e -> Export
|
||||
-- forall e . CommonJSExport e => Export e
|
||||
type ExportMap = Map.Map String CommonJSExport
|
||||
|
||||
defaultMain :: IO ()
|
||||
defaultMain = do
|
||||
em <- getRequireEmitter
|
||||
on3 em "ghcjs-require:runexport" onRunExport
|
||||
void $ emit0 em "ghcjs-require:loaded"
|
||||
return ()
|
||||
|
||||
exportMain :: (Foldable t) => t (String, CommonJSExport) -> IO ()
|
||||
exportMain es = do
|
||||
mapM_ (uncurry exportWrapped) es
|
||||
defaultMain
|
||||
|
||||
fibs :: [Int]
|
||||
fibs = 1 : 1 : zipWith (+) fibs (tail fibs)
|
||||
|
||||
pack :: ToCommonJSExport (String, e) => (String, e) -> (String, CommonJSExport)
|
||||
pack e = (exportName e, toCommonJSExport e)
|
||||
|
||||
test =
|
||||
exportMain [ pack ("hello", print "Hello")
|
||||
, pack ("fibs", \n -> (take n fibs))
|
||||
, pack ("yo", print "yo")
|
||||
]
|
||||
|
||||
onRunExport :: JSVal -> JSVal -> JSVal -> IO ()
|
||||
onRunExport name args cb = do
|
||||
Just str <- fromJSVal name :: IO (Maybe JSString)
|
||||
let hsName = JSString.unpack str
|
||||
maction <- getExport hsName
|
||||
ret <- case maction of
|
||||
Nothing -> error ("No function " ++ hsName ++ " exported")
|
||||
Just action -> fromJSValListOf args >>= \case
|
||||
Nothing -> error ("Second parameter to the ghcjs-require:runexport " ++
|
||||
"event should be a list of arguments")
|
||||
Just args' -> action args'
|
||||
call cb (nullRef : ret)
|
||||
|
||||
call :: JSVal -> [JSVal] -> IO ()
|
||||
call fn [] = js_call0 fn
|
||||
call fn [a1] = js_call1 fn a1
|
||||
call fn [a1, a2] = js_call2 fn a1 a2
|
||||
call fn [a1, a2, a3] = js_call3 fn a1 a2 a3
|
||||
call fn args = js_apply fn (JSArray.fromList args)
|
||||
|
||||
exports :: MVar ExportMap
|
||||
exports = unsafePerformIO $ newMVar Map.empty
|
||||
{-# NOINLINE exports #-}
|
||||
|
||||
getExport :: String -> IO (Maybe CommonJSExport)
|
||||
getExport name = do
|
||||
es <- readMVar exports
|
||||
return $ Map.lookup name es
|
||||
|
||||
registerExport' :: (String, CommonJSExport) -> IO ()
|
||||
registerExport' e = modifyMVar_ exports $ \es ->
|
||||
return $ uncurry Map.insert e es
|
||||
|
||||
registerExport :: ToCommonJSExport e => e -> IO ()
|
||||
registerExport e =
|
||||
registerExport' (exportName e, toCommonJSExport e)
|
||||
|
||||
require :: String -> IO JSVal
|
||||
require = js_require . fromString
|
||||
|
||||
exportWrapped :: ToCommonJSExport (String, e) => String -> e -> IO ()
|
||||
exportWrapped name action = do
|
||||
registerExport (name, action)
|
||||
let name' = fromString name
|
||||
js_registerWrapped name'
|
||||
|
||||
export :: String -> IO () -> IO ()
|
||||
export name action = do
|
||||
callback <- asyncCallback action
|
||||
let name' = fromString name
|
||||
js_export name' callback
|
||||
|
||||
getRequireEmitter :: IO EventEmitter
|
||||
getRequireEmitter = emitter <$> js_getRequireEmitter
|
34
ghcjs-commonjs/src/GHCJS/CommonJS/Internal.hs
Normal file
34
ghcjs-commonjs/src/GHCJS/CommonJS/Internal.hs
Normal file
@ -0,0 +1,34 @@
|
||||
module GHCJS.CommonJS.Internal where
|
||||
|
||||
import Data.JSString
|
||||
import GHCJS.Foreign.Callback
|
||||
import GHCJS.Types
|
||||
import JavaScript.Array
|
||||
import JavaScript.Object
|
||||
|
||||
foreign import javascript unsafe "$r = require($1)"
|
||||
js_require :: JSString -> IO JSVal
|
||||
|
||||
foreign import javascript unsafe "global.wrappedExports.push($1)"
|
||||
js_registerWrapped :: JSString -> IO ()
|
||||
|
||||
foreign import javascript unsafe "global.exports[$1] = $2"
|
||||
js_export :: JSString -> Callback a -> IO ()
|
||||
|
||||
foreign import javascript unsafe "global.emitter"
|
||||
js_getRequireEmitter :: IO Object
|
||||
|
||||
foreign import javascript unsafe "$1()"
|
||||
js_call0 :: JSVal -> IO ()
|
||||
|
||||
foreign import javascript unsafe "$1($2)"
|
||||
js_call1 :: JSVal -> JSVal -> IO ()
|
||||
|
||||
foreign import javascript unsafe "$1($2, $3)"
|
||||
js_call2 :: JSVal -> JSVal -> JSVal -> IO ()
|
||||
|
||||
foreign import javascript unsafe "$1($2, $3, $4)"
|
||||
js_call3 :: JSVal -> JSVal -> JSVal -> JSVal -> IO ()
|
||||
|
||||
foreign import javascript unsafe "$1.apply(null, $2)"
|
||||
js_apply :: JSVal -> JSArray -> IO ()
|
@ -1,83 +0,0 @@
|
||||
module GHCJS.Require
|
||||
where
|
||||
|
||||
import Control.Concurrent
|
||||
import Control.Monad
|
||||
import Data.JSString
|
||||
import Data.String
|
||||
import GHCJS.Foreign
|
||||
import GHCJS.Foreign.Callback
|
||||
import GHCJS.Marshal
|
||||
import GHCJS.Types
|
||||
import JavaScript.Array
|
||||
import JavaScript.Object
|
||||
import JavaScript.EventEmitter
|
||||
import Data.Coerce
|
||||
|
||||
import System.IO.Unsafe
|
||||
|
||||
defaultMain = do
|
||||
emitter <- getRequireEmitter
|
||||
|
||||
on2 emitter "ghcjs-require:runexport" $ \name cb -> do
|
||||
Just str <- fromJSVal name :: IO (Maybe JSString)
|
||||
maction <- getExport (unpack str)
|
||||
mvl <- case maction of
|
||||
Just action -> action
|
||||
Nothing -> return Nothing
|
||||
case mvl of
|
||||
Just vl -> call2 cb nullRef vl
|
||||
Nothing -> call1 cb nullRef
|
||||
|
||||
emit0 emitter "ghcjs-require:loaded"
|
||||
|
||||
foreign import javascript unsafe "$1()"
|
||||
call0 :: JSVal -> IO ()
|
||||
|
||||
foreign import javascript unsafe "$1($2)"
|
||||
call1 :: JSVal -> JSVal -> IO ()
|
||||
|
||||
foreign import javascript unsafe "$1($2, $3)"
|
||||
call2 :: JSVal -> JSVal -> JSVal -> IO ()
|
||||
|
||||
exports = unsafePerformIO (newMVar [])
|
||||
{-# NOINLINE exports #-}
|
||||
|
||||
getExport :: String -> IO (Maybe (IO (Maybe JSVal)))
|
||||
getExport name = lookup name <$> readMVar exports
|
||||
|
||||
registerExport :: String -> IO (Maybe JSVal) -> IO ()
|
||||
registerExport name action = modifyMVar_ exports $ \e ->
|
||||
return $ (name, action):e
|
||||
|
||||
require :: String -> IO JSVal
|
||||
require = js_require . fromString
|
||||
|
||||
export :: String -> IO (Maybe JSVal) -> IO ()
|
||||
export name action = do
|
||||
let name' = fromString name
|
||||
registerExport name $ action
|
||||
callback <- asyncCallback (void action)
|
||||
js_export name' callback
|
||||
|
||||
export0 name action = export name $ do
|
||||
action
|
||||
return Nothing
|
||||
|
||||
getRequireEmitter :: IO EventEmitter
|
||||
getRequireEmitter = emitter <$> js_getRequireEmitter
|
||||
|
||||
foreign import javascript unsafe "$r = require($1)"
|
||||
js_require :: JSString -> IO JSVal
|
||||
|
||||
-- foreign import javascript unsafe "global.startAction"
|
||||
-- js_startAction :: IO JSString
|
||||
|
||||
-- foreign import javascript unsafe "global.finishAction"
|
||||
-- js_finishAction0 :: JSString -> IO ()
|
||||
|
||||
foreign import javascript unsafe "global.exports[$1] = $2"
|
||||
js_export :: JSString -> Callback a -> IO ()
|
||||
|
||||
foreign import javascript unsafe "global.emitter"
|
||||
js_getRequireEmitter :: IO Object
|
@ -1,3 +1,4 @@
|
||||
const childProcess = require('child_process');
|
||||
const fs = require('fs');
|
||||
const path = require('path');
|
||||
|
||||
@ -13,34 +14,29 @@ function generateWrapper(fp, mod) {
|
||||
const rts = fs.readFileSync(path.join(fp, '/rts.js'));
|
||||
const lib = fs.readFileSync(path.join(fp, '/lib.js'));
|
||||
const out = fs.readFileSync(path.join(fp, '/out.js'));
|
||||
mod = rts.toString() + lib.toString() + out.toString();
|
||||
mod =
|
||||
rts.toString() +
|
||||
lib.toString() +
|
||||
out.toString();
|
||||
}
|
||||
|
||||
return stripBOM(`
|
||||
function mapValues(obj, fn) {
|
||||
var keys = Object.keys(obj);
|
||||
var ret = {}
|
||||
for (var i = 0, len = keys.length; i < len; i++) {
|
||||
var key = keys[i];
|
||||
ret[key] = fn(obj[key], key);
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
exports = module.exports = function bootAndRunHaskellModule(onLoaded) {
|
||||
var md = exports.boot();
|
||||
|
||||
md.emitter.on('ghcjs-require:loaded', function() {
|
||||
md.wrapped = mapValues(md.exports, function(fn, key) {
|
||||
return function() {
|
||||
md.wrapped = md.wrappedExports.reduce(function(memo, key) {
|
||||
memo[key] = function() {
|
||||
var args = Array.prototype.slice.apply(arguments);
|
||||
return new Promise(function(resolve, reject) {
|
||||
md.emitter.emit('ghcjs-require:runexport', key, function(err, result) {
|
||||
md.emitter.emit('ghcjs-require:runexport', key, args, function(err, result) {
|
||||
if (err) return reject(err);
|
||||
resolve(result);
|
||||
});
|
||||
});
|
||||
};
|
||||
});
|
||||
return memo;
|
||||
}, {});
|
||||
|
||||
if (onLoaded) onLoaded(md);
|
||||
});
|
||||
@ -56,6 +52,7 @@ function generateWrapper(fp, mod) {
|
||||
exports.boot = function bootHaskellModule() {
|
||||
var global = {};
|
||||
global.exports = {};
|
||||
global.wrappedExports = [];
|
||||
return (function(global, exports, module) {
|
||||
${mod}
|
||||
;
|
||||
@ -83,11 +80,40 @@ function addWrapper(fp) {
|
||||
fs.writeFileSync(path.join(fp, 'index.js'), idx);
|
||||
}
|
||||
|
||||
function ghcjsRequire(fp) {
|
||||
function find(root) {
|
||||
try {
|
||||
const ls = fs.readdirSync(process.cwd()); // Replace with the module
|
||||
if (ls.indexOf('.stack-work') > -1) {
|
||||
const installRoot = childProcess.execSync('stack path --dist-dir', {
|
||||
chdir: ls,
|
||||
}).toString().split('\n')[0];
|
||||
const bins = fs.readdirSync(path.join(installRoot, 'build', root));
|
||||
const exeIdx = bins.indexOf(root + '.jsexe');
|
||||
if (exeIdx > -1) {
|
||||
const out = path.join(installRoot, 'build', root, bins[exeIdx]);
|
||||
return out;
|
||||
}
|
||||
}
|
||||
} catch (err) {
|
||||
return null;
|
||||
}
|
||||
}
|
||||
|
||||
function ghcjsRequire(module, fp) {
|
||||
if (path.extname(fp) !== '.jsexe') {
|
||||
const jsexe = find(fp);
|
||||
if (jsexe) {
|
||||
return ghcjsRequire(module, jsexe)
|
||||
}
|
||||
|
||||
throw new Error('Could not resolve Haskell source for ' + fp);
|
||||
}
|
||||
|
||||
addWrapper(fp);
|
||||
return require(fp);
|
||||
return module.require('./' + path.join(fp, 'index.js'));
|
||||
}
|
||||
|
||||
exports = module.exports = ghcjsRequire;
|
||||
exports.addWrapper = addWrapper;
|
||||
exports.find = find;
|
||||
exports.generateWrapper = generateWrapper;
|
||||
|
Loading…
Reference in New Issue
Block a user