From 603be994457f4a2d78f32ec30e5d8d38eac06217 Mon Sep 17 00:00:00 2001 From: yamadapc Date: Sat, 18 Jun 2016 12:38:10 -0300 Subject: [PATCH] Get hello world to working state --- example-react-serverside-rendering/LICENSE | 20 ++ example-react-serverside-rendering/Setup.hs | 2 + .../example-react-serverside-rendering.cabal | 17 ++ .../src/Main.hs | 4 + examples/.#ghcjs-require.js | 1 + examples/Makefile | 3 + examples/README.md | 4 + examples/hello-world/Main.hs | 8 + examples/hello-world/README.md | 29 +++ examples/hello-world/Setup.hs | 2 + .../ghcjs-commonjs-hello-world.cabal | 14 ++ examples/hello-world/index.js | 8 + examples/hello-world/package.json | 15 ++ examples/hello-world/stack.yaml | 13 ++ ghcjs-commonjs/ghcjs-commonjs.cabal | 4 +- ghcjs-commonjs/src/GHCJS/CommonJS.hs | 210 ++++++++++++++++++ ghcjs-commonjs/src/GHCJS/CommonJS/Internal.hs | 34 +++ ghcjs-commonjs/src/GHCJS/Require.hs | 83 ------- ghcjs-require/ghcjs-require.js | 60 +++-- 19 files changed, 430 insertions(+), 101 deletions(-) create mode 100644 example-react-serverside-rendering/LICENSE create mode 100644 example-react-serverside-rendering/Setup.hs create mode 100644 example-react-serverside-rendering/example-react-serverside-rendering.cabal create mode 100644 example-react-serverside-rendering/src/Main.hs create mode 120000 examples/.#ghcjs-require.js create mode 100644 examples/Makefile create mode 100644 examples/README.md create mode 100644 examples/hello-world/Main.hs create mode 100644 examples/hello-world/README.md create mode 100644 examples/hello-world/Setup.hs create mode 100644 examples/hello-world/ghcjs-commonjs-hello-world.cabal create mode 100644 examples/hello-world/index.js create mode 100644 examples/hello-world/package.json create mode 100644 examples/hello-world/stack.yaml create mode 100644 ghcjs-commonjs/src/GHCJS/CommonJS.hs create mode 100644 ghcjs-commonjs/src/GHCJS/CommonJS/Internal.hs delete mode 100644 ghcjs-commonjs/src/GHCJS/Require.hs diff --git a/example-react-serverside-rendering/LICENSE b/example-react-serverside-rendering/LICENSE new file mode 100644 index 0000000..c36c656 --- /dev/null +++ b/example-react-serverside-rendering/LICENSE @@ -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. diff --git a/example-react-serverside-rendering/Setup.hs b/example-react-serverside-rendering/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/example-react-serverside-rendering/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/example-react-serverside-rendering/example-react-serverside-rendering.cabal b/example-react-serverside-rendering/example-react-serverside-rendering.cabal new file mode 100644 index 0000000..5d941fa --- /dev/null +++ b/example-react-serverside-rendering/example-react-serverside-rendering.cabal @@ -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 diff --git a/example-react-serverside-rendering/src/Main.hs b/example-react-serverside-rendering/src/Main.hs new file mode 100644 index 0000000..c2e4af9 --- /dev/null +++ b/example-react-serverside-rendering/src/Main.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = undefined diff --git a/examples/.#ghcjs-require.js b/examples/.#ghcjs-require.js new file mode 120000 index 0000000..9407bb3 --- /dev/null +++ b/examples/.#ghcjs-require.js @@ -0,0 +1 @@ +yamadapc@Pedros-MBP.42571 \ No newline at end of file diff --git a/examples/Makefile b/examples/Makefile new file mode 100644 index 0000000..f892c5c --- /dev/null +++ b/examples/Makefile @@ -0,0 +1,3 @@ +hello-world: FORCE + +FORCE: diff --git a/examples/README.md b/examples/README.md new file mode 100644 index 0000000..33e1e42 --- /dev/null +++ b/examples/README.md @@ -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. diff --git a/examples/hello-world/Main.hs b/examples/hello-world/Main.hs new file mode 100644 index 0000000..d02ab5e --- /dev/null +++ b/examples/hello-world/Main.hs @@ -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") + ] diff --git a/examples/hello-world/README.md b/examples/hello-world/README.md new file mode 100644 index 0000000..bb6dd05 --- /dev/null +++ b/examples/hello-world/README.md @@ -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**. diff --git a/examples/hello-world/Setup.hs b/examples/hello-world/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/examples/hello-world/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/examples/hello-world/ghcjs-commonjs-hello-world.cabal b/examples/hello-world/ghcjs-commonjs-hello-world.cabal new file mode 100644 index 0000000..9ba8dd1 --- /dev/null +++ b/examples/hello-world/ghcjs-commonjs-hello-world.cabal @@ -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 diff --git a/examples/hello-world/index.js b/examples/hello-world/index.js new file mode 100644 index 0000000..675adc6 --- /dev/null +++ b/examples/hello-world/index.js @@ -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'); + }); +}); diff --git a/examples/hello-world/package.json b/examples/hello-world/package.json new file mode 100644 index 0000000..a0bd151 --- /dev/null +++ b/examples/hello-world/package.json @@ -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" + } +} diff --git a/examples/hello-world/stack.yaml b/examples/hello-world/stack.yaml new file mode 100644 index 0000000..d6b2bcb --- /dev/null +++ b/examples/hello-world/stack.yaml @@ -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 diff --git a/ghcjs-commonjs/ghcjs-commonjs.cabal b/ghcjs-commonjs/ghcjs-commonjs.cabal index 553f746..3923b84 100644 --- a/ghcjs-commonjs/ghcjs-commonjs.cabal +++ b/ghcjs-commonjs/ghcjs-commonjs.cabal @@ -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 diff --git a/ghcjs-commonjs/src/GHCJS/CommonJS.hs b/ghcjs-commonjs/src/GHCJS/CommonJS.hs new file mode 100644 index 0000000..2740ff1 --- /dev/null +++ b/ghcjs-commonjs/src/GHCJS/CommonJS.hs @@ -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 diff --git a/ghcjs-commonjs/src/GHCJS/CommonJS/Internal.hs b/ghcjs-commonjs/src/GHCJS/CommonJS/Internal.hs new file mode 100644 index 0000000..a4d1238 --- /dev/null +++ b/ghcjs-commonjs/src/GHCJS/CommonJS/Internal.hs @@ -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 () diff --git a/ghcjs-commonjs/src/GHCJS/Require.hs b/ghcjs-commonjs/src/GHCJS/Require.hs deleted file mode 100644 index a197292..0000000 --- a/ghcjs-commonjs/src/GHCJS/Require.hs +++ /dev/null @@ -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 diff --git a/ghcjs-require/ghcjs-require.js b/ghcjs-require/ghcjs-require.js index ff9b416..6d75d1a 100644 --- a/ghcjs-require/ghcjs-require.js +++ b/ghcjs-require/ghcjs-require.js @@ -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;