Merge pull request #34 from ethul/topic/psc-webpack-plugin

Topic/psc webpack plugin

12 files changed, 91 insertions, 380 deletions

diff --git a/src/PursLoader/ChildProcess.js b/src/PursLoader/ChildProcess.js
deleted file mode 100644
index d62aef6..0000000
--- a/src/PursLoader/ChildProcess.js
+++ /dev/null
@@ -1,40 +0,0 @@
-'use strict';
-
-// module PursLoader.ChildProcess
-
-var child_process = require('child_process');
-
-var chalk = require('chalk');
-
-function spawnFn(command, args, errback, callback) {
-  return function(){
-    var process = child_process.spawn(command, args);
-
-    var stdout = new Buffer(0);
-
-    var stderr = new Buffer(0);
-
-    process.stdout.on('data', function(data){
-      stdout = Buffer.concat([stdout, new Buffer(data)]);
-    });
-
-    process.stderr.on('data', function(data){
-      stderr = Buffer.concat([stderr, new Buffer(data)]);
-    });
-
-    process.on('close', function(code){
-      var output = stdout.toString('utf-8');
-
-      var error = stderr.toString('utf-8');
-
-      if (error.length > 0) {
-         console.error('\n' + chalk.red('*') + ' ' + error);
-      }
-
-      if (code !== 0) errback(new Error('Process terminated with code ' + code))();
-      else callback(output)();
-    });
-  };
-}
-
-exports.spawnFn = spawnFn;
diff --git a/src/PursLoader/ChildProcess.purs b/src/PursLoader/ChildProcess.purs
deleted file mode 100644
index 3bd960b..0000000
--- a/src/PursLoader/ChildProcess.purs
+++ /dev/null
@@ -1,23 +0,0 @@
-module PursLoader.ChildProcess
-  ( ChildProcess()
-  , spawn
-  ) where
-
-import Prelude (Unit(), ($))
-
-import Control.Monad.Aff (Aff(), makeAff)
-import Control.Monad.Eff (Eff())
-import Control.Monad.Eff.Exception (Error())
-
-import Data.Function
-
-foreign import data ChildProcess :: !
-
-spawn :: forall eff. String -> Array String -> Aff (cp :: ChildProcess | eff) String
-spawn command args = makeAff $ runFn4 spawnFn command args
-
-foreign import spawnFn :: forall eff. Fn4 String
-                                          (Array String)
-                                          (Error -> Eff (cp :: ChildProcess | eff) Unit)
-                                          (String -> Eff (cp :: ChildProcess | eff) Unit)
-                                          (Eff (cp :: ChildProcess | eff) Unit)
diff --git a/src/PursLoader/FS.js b/src/PursLoader/FS.js
deleted file mode 100644
index 1a7f5b0..0000000
--- a/src/PursLoader/FS.js
+++ /dev/null
@@ -1,36 +0,0 @@
-'use strict';
-
-// module PursLoader.FS
-
-var fs = require('fs');
-
-var async = require('async');
-
-function writeFileUtf8Fn(filepath, contents, errback, callback) {
-  return function(){
-    fs.writeFile(filepath, contents, function(error){
-      if (error) errback(error)();
-      else callback()();
-    });
-  };
-}
-
-function findFileUtf8Fn(nothing, just, regex, filepaths, errback, callback) {
-  return function(){
-    function findFile(filepath, callback) {
-      fs.readFile(filepath, {encoding: 'utf-8'}, function(error, result){
-        if (error) callback(false);
-        else callback(regex.test(result));
-      });
-    }
-
-    async.detect(filepaths, findFile, function(result){
-      if (!result) callback(nothing)();
-      else callback(just(result))();
-    });
-  };
-}
-
-exports.writeFileUtf8Fn = writeFileUtf8Fn;
-
-exports.findFileUtf8Fn = findFileUtf8Fn;
diff --git a/src/PursLoader/FS.purs b/src/PursLoader/FS.purs
deleted file mode 100644
index 969e3d0..0000000
--- a/src/PursLoader/FS.purs
+++ /dev/null
@@ -1,38 +0,0 @@
-module PursLoader.FS
-  ( FS()
-  , writeFileUtf8
-  , findFileUtf8
-  ) where
-
-import Prelude (Unit(), ($))
-
-import Control.Monad.Aff (Aff(), makeAff)
-import Control.Monad.Eff (Eff())
-import Control.Monad.Eff.Exception (Error())
-
-import Data.Maybe (Maybe(..))
-import Data.String.Regex (Regex())
-
-import Data.Function
-
-foreign import data FS :: !
-
-writeFileUtf8 :: forall eff. String -> String -> Aff (fs :: FS | eff) Unit
-writeFileUtf8 filepath contents = makeAff $ runFn4 writeFileUtf8Fn filepath contents
-
-foreign import writeFileUtf8Fn :: forall eff. Fn4 String
-                                                  String
-                                                  (Error -> Eff (fs :: FS | eff) Unit)
-                                                  (Unit -> Eff (fs :: FS | eff) Unit)
-                                                  (Eff (fs :: FS | eff) Unit)
-
-findFileUtf8 :: forall eff. Regex -> Array String -> Aff (fs :: FS | eff) (Maybe String)
-findFileUtf8 regexp filepaths = makeAff $ runFn6 findFileUtf8Fn Nothing Just regexp filepaths
-
-foreign import findFileUtf8Fn :: forall eff. Fn6 (Maybe String)
-                                                 (String -> Maybe String)
-                                                 Regex
-                                                 (Array String)
-                                                 (Error -> Eff (fs :: FS | eff) Unit)
-                                                 (Maybe String -> Eff (fs :: FS | eff) Unit)
-                                                 (Eff (fs :: FS | eff) Unit)
diff --git a/src/PursLoader/Glob.js b/src/PursLoader/Glob.js
deleted file mode 100644
index 960ae9a..0000000
--- a/src/PursLoader/Glob.js
+++ /dev/null
@@ -1,18 +0,0 @@
-'use strict';
-
-// module PursLoader.Glob
-
-var glob = require('glob');
-
-var async = require('async');
-
-function globAllFn(patterns, errback, callback) {
-  return function(){
-    async.map(patterns, glob, function(error, result){
-      if (error) errback(new Error(error))();
-      else callback(result)();
-    });
-  };
-}
-
-exports.globAllFn = globAllFn;
diff --git a/src/PursLoader/Glob.purs b/src/PursLoader/Glob.purs
deleted file mode 100644
index 45eeb56..0000000
--- a/src/PursLoader/Glob.purs
+++ /dev/null
@@ -1,22 +0,0 @@
-module PursLoader.Glob
-  ( Glob()
-  , globAll
-  ) where
-
-import Prelude (Unit(), ($))
-
-import Control.Monad.Aff (Aff(), makeAff)
-import Control.Monad.Eff (Eff())
-import Control.Monad.Eff.Exception (Error())
-
-import Data.Function
-
-foreign import data Glob :: !
-
-globAll :: forall eff. Array String -> Aff (glob :: Glob | eff) (Array (Array String))
-globAll patterns = makeAff $ runFn3 globAllFn patterns
-
-foreign import globAllFn :: forall eff. Fn3 (Array String)
-                                            (Error -> Eff (glob :: Glob | eff) Unit)
-                                            ((Array (Array String)) -> Eff (glob :: Glob | eff) Unit)
-                                            (Eff (glob :: Glob | eff) Unit)
diff --git a/src/PursLoader/Loader.purs b/src/PursLoader/Loader.purs
index 205d3eb..affce53 100644
--- a/src/PursLoader/Loader.purs
+++ b/src/PursLoader/Loader.purs
@@ -4,116 +4,75 @@ module PursLoader.Loader
   , loaderFn
   ) where
 
-import Prelude (Unit(), ($), (<>), (>>=), (<$>), (++), bind, flip, id, pure, return, unit, show)
+import Prelude (Unit(), ($), (>>=), (<$>), (<*>), (<<<), (++), bind, const)
 
-import Control.Monad.Aff (Aff(), runAff)
+import Control.Bind (join)
 import Control.Monad.Eff (Eff())
-import Control.Monad.Eff.Class (liftEff)
-import Control.Monad.Eff.Exception (throwException, error, EXCEPTION())
+import Control.Monad.Eff.Exception (Error(), error)
 
-import Data.Array ((!!), concat)
+import Data.Array ((!!))
 import Data.Function (Fn2(), mkFn2)
-import Data.Maybe (Maybe(..), fromMaybe, maybe)
-import Data.Either (Either(..))
-import Data.String (joinWith)
-import Data.String.Regex (match, noFlags, regex, test)
-import Data.Traversable (sequence)
-import Data.Foreign (F())
+import Data.Maybe (Maybe(..), maybe)
+import Data.Either (either)
+import Data.Foreign (Foreign())
 import Data.Foreign.Class (read)
+import Data.Foreign.Null (runNull)
+import Data.String.Regex (Regex(), match, noFlags, regex)
+
+import Unsafe.Coerce (unsafeCoerce)
+
+import PursLoader.LoaderRef
+  ( LoaderRef()
+  , Loader()
+  , async
+  , cacheable
+  , query
+  , clearDependencies
+  , addDependency
+  , resourcePath
+  )
 
-import PursLoader.ChildProcess (ChildProcess(), spawn)
-import PursLoader.FS (FS(), writeFileUtf8, findFileUtf8)
-import PursLoader.Glob (Glob(), globAll)
-import PursLoader.LoaderRef (LoaderRef(), Loader(), async, cacheable, query, clearDependencies, addDependency, resourcePath)
 import PursLoader.LoaderUtil (parseQuery)
-import PursLoader.Options (loaderFFIOption, loaderSrcOption, pscOptions, Options(), output)
+import PursLoader.Options (runOptions)
+import PursLoader.Path (dirname, relative)
 
-type Effects eff = (cp :: ChildProcess, fs :: FS, glob :: Glob, loader :: Loader, err :: EXCEPTION | eff)
+type Effects eff = (loader :: Loader | eff)
 
-moduleRegex = regex "(?:^|\\n)module\\s+([\\w\\.]+)" noFlags { ignoreCase = true }
+type PurescriptWebpackPluginContext eff = { compile :: (Foreign -> Eff (Effects eff) Unit) -> Eff (Effects eff) Unit }
 
-foreignRegex = regex "(?:^|\\n)\\s*foreign import\\s+" noFlags { ignoreCase = true }
-
-pscCommand = "psc"
-
-psciCommand = "psci"
-
-psciFilename = ".psci"
-
-(!!!) = flip (!!)
-
-foreign import cwd :: String
-
-foreign import relative :: String -> String -> String
-
-foreign import resolve :: String -> String
-
-foreign import dirname :: String -> String
-
-foreign import joinPath :: String -> String -> String
-
-mkPsci :: Array (Array String) -> Array (Array String) -> String
-mkPsci srcs ffis = joinWith "\n" ((loadModule <$> concat srcs) <> (loadForeign <$> concat ffis))
-  where
-    loadModule :: String -> String
-    loadModule a = ":m " ++ relative cwd a
-
-    loadForeign :: String -> String
-    loadForeign a = ":f " ++ relative cwd a
-
-findFFI :: forall eff. Array (Array String) -> String -> Aff (fs :: FS | eff) (Maybe String)
-findFFI ffiss name = findFileUtf8 re (concat ffiss)
-  where
-    re = regex ("(?:^|\\n)//\\s*module\\s*" ++ name ++ "\\s*\\n") noFlags
+loader :: forall eff. LoaderRef -> String -> Eff (Effects eff) Unit
+loader ref source = do
+  callback <- async ref
 
-loader' :: forall eff. LoaderRef -> String -> Aff (Effects eff) (Maybe String)
-loader' ref source = do
-  liftEff $ cacheable ref
+  cacheable ref
 
   let parsed = parseQuery $ query ref
-      srcs = fromMaybe [] (loaderSrcOption parsed)
-      ffis = fromMaybe [] (loaderFFIOption parsed)
 
-  case read parsed :: F Options of
-    Left e -> liftEff (throwException (error (show e)))
-    Right opts -> do
-      let pscOpts = pscOptions opts
+      options = either (const Nothing) (Just <<< runOptions) (read parsed)
 
-      srcss <- globAll srcs
-      ffiss <- globAll ffis
+      moduleName = join $ match moduleRegex source >>= \as -> as !! 1
 
-      let psciFile = mkPsci srcss ffiss
+      resourceDir = dirname (resourcePath ref)
 
-      writeFileUtf8 psciFilename psciFile
+      modulePath = (\opts -> relative resourceDir opts.bundleOutput) <$> options
 
-      let moduleName = match moduleRegex source >>= (!!!) 1 >>= id
-          hasForeign = test foreignRegex source
-          outputDir = resolve (output opts)
-          resourceDir = dirname (resourcePath ref)
-          result = (\a -> "module.exports = require('" ++ relative resourceDir (joinPath outputDir a) ++ "');") <$> moduleName
+      result = (\path name -> "module.exports = require('" ++ path ++ "')['" ++ name ++ "'];") <$> modulePath <*> moduleName
 
-      liftEff do
-        clearDependencies ref
-        addDependency ref (resourcePath ref)
-        sequence $ (\src -> addDependency ref (resolve src)) <$> concat srcss
+  clearDependencies ref
 
-      foreignPath <- if hasForeign
-                        then fromMaybe (pure Nothing) (findFFI ffiss <$> moduleName)
-                        else pure Nothing
+  addDependency ref (resourcePath ref)
 
-      fromMaybe (pure unit) ((\path -> liftEff (addDependency ref path)) <$> foreignPath)
-
-      spawn pscCommand (srcs <> pscOpts)
+  pluginContext.compile (\err -> maybe (callback (Just $ error "Failed to run loader") "")
+                                       (callback (compileError err)) result)
+  where
+  moduleRegex :: Regex
+  moduleRegex = regex "(?:^|\\n)module\\s+([\\w\\.]+)" noFlags { ignoreCase = true }
 
-      return result
+  pluginContext :: PurescriptWebpackPluginContext eff
+  pluginContext = (unsafeCoerce ref).purescriptWebpackPluginContext
 
-loader :: forall eff. LoaderRef -> String -> Eff (Effects eff) Unit
-loader ref source = do
-  callback <- async ref
-  runAff (\e -> callback (Just e) "")
-         (maybe (callback (Just (error "Loader has failed to run")) "")
-                (callback Nothing))
-         (loader' ref source)
+  compileError :: Foreign -> Maybe Error
+  compileError value = either (const $ Just (error "Failed to compile")) ((<$>) error) (runNull <$> read value)
 
 loaderFn :: forall eff. Fn2 LoaderRef String (Eff (Effects eff) Unit)
 loaderFn = mkFn2 loader
diff --git a/src/PursLoader/LoaderRef.purs b/src/PursLoader/LoaderRef.purs
index 33c4f7e..87d6006 100644
--- a/src/PursLoader/LoaderRef.purs
+++ b/src/PursLoader/LoaderRef.purs
@@ -1,6 +1,7 @@
 module PursLoader.LoaderRef
   ( LoaderRef()
   , Loader()
+  , AsyncCallback()
   , async
   , cacheable
   , query
@@ -17,16 +18,18 @@ import Control.Monad.Eff.Exception (Error())
 import Data.Function (Fn3(), runFn3)
 import Data.Maybe (Maybe(), fromMaybe, isJust)
 
+type AsyncCallback eff = Maybe Error -> String -> Eff (loader :: Loader | eff) Unit
+
 data LoaderRef
 
 foreign import data Loader :: !
 
-foreign import asyncFn :: forall eff a. Fn3 (Maybe Error -> Boolean)
-                                            (Error -> Maybe Error -> Error)
-                                            LoaderRef
-                                            (Eff (loader :: Loader | eff) (Maybe Error -> a -> Eff (loader :: Loader | eff) Unit))
+foreign import asyncFn :: forall eff. Fn3 (Maybe Error -> Boolean)
+                                          (Error -> Maybe Error -> Error)
+                                          LoaderRef
+                                          (Eff (loader :: Loader | eff) (AsyncCallback eff))
 
-async :: forall eff a. LoaderRef -> Eff (loader :: Loader | eff) (Maybe Error -> a -> Eff (loader :: Loader | eff) Unit)
+async :: forall eff. LoaderRef -> Eff (loader :: Loader | eff) (Maybe Error -> String -> Eff (loader :: Loader | eff) Unit)
 async ref = runFn3 asyncFn isJust fromMaybe ref
 
 foreign import cacheable :: forall eff. LoaderRef -> Eff (loader :: Loader | eff) Unit
diff --git a/src/PursLoader/LoaderUtil.purs b/src/PursLoader/LoaderUtil.purs
index 3e5a7bc..45495c8 100644
--- a/src/PursLoader/LoaderUtil.purs
+++ b/src/PursLoader/LoaderUtil.purs
@@ -4,6 +4,4 @@ module PursLoader.LoaderUtil
 
 import Data.Foreign (Foreign())
 
-import PursLoader.LoaderRef (LoaderRef())
-
 foreign import parseQuery :: String -> Foreign
diff --git a/src/PursLoader/Options.purs b/src/PursLoader/Options.purs
index 1650652..706ddd2 100644
--- a/src/PursLoader/Options.purs
+++ b/src/PursLoader/Options.purs
@@ -1,111 +1,30 @@
 module PursLoader.Options
-  ( pscOptions
-  , loaderSrcOption
-  , loaderFFIOption
-  , Options()
-  , output
+  ( Options()
+  , runOptions
   ) where
 
-import Prelude (Unit(), (<>), (<$>), (<<<), (++), (<*>), ($), const, id)
+import Prelude ((<$>), (<<<), id)
 
-import Data.Array (concat)
-import Data.Either (either)
+import Data.Foreign.Class (IsForeign, readProp)
+import Data.Foreign.NullOrUndefined (runNullOrUndefined)
+import Data.Maybe (maybe)
 
-import Data.Foreign (Foreign(), F())
-import Data.Foreign.Class (IsForeign, read, readProp)
-import Data.Foreign.NullOrUndefined (NullOrUndefined(..), runNullOrUndefined)
+import PursLoader.Path (joinPath)
 
-import Data.Maybe (Maybe(..), maybe, fromMaybe)
+newtype Options = Options { bundleOutput :: String }
 
-noPreludeOpt = "no-prelude"
+type Options_ = { bundleOutput :: String }
 
-noOptsOpt = "no-opts"
-
-noMagicDoOpt = "no-magic-do"
-
-noTcoOpt = "no-tco"
-
-verboseErrorsOpt = "verbose-errors"
-
-outputOpt = "output"
-
-commentsOpt = "comments"
-
-noPrefixOpt = "no-prefix"
-
-requirePathOpt = "require-path"
-
-srcOpt = "src"
-
-ffiOpt = "ffi"
-
-newtype Options
-  = Options { noPrelude :: NullOrUndefined Boolean
-            , noOpts :: NullOrUndefined Boolean
-            , noMagicDo :: NullOrUndefined Boolean
-            , noTco :: NullOrUndefined Boolean
-            , verboseErrors :: NullOrUndefined Boolean
-            , comments :: NullOrUndefined Boolean
-            , output :: String
-            , noPrefix :: NullOrUndefined Boolean
-            , requirePath :: String
-            , src :: NullOrUndefined (Array String)
-            , ffi :: NullOrUndefined (Array String)
-            }
-
-output :: Options -> String
-output (Options o) = o.output
+runOptions :: Options -> Options_
+runOptions (Options options) = options
 
 instance isForeignOptions :: IsForeign Options where
-  read obj = Options <$> ({ noPrelude: _
-                          , noOpts: _
-                          , noMagicDo: _
-                          , noTco: _
-                          , verboseErrors: _
-                          , comments: _
-                          , output: _
-                          , noPrefix: _
-                          , requirePath: "../"
-                          , src: _
-                          , ffi: _
-                          } <$> readProp noPreludeOpt obj
-                            <*> readProp noOptsOpt obj
-                            <*> readProp noMagicDoOpt obj
-                            <*> readProp noTcoOpt obj
-                            <*> readProp verboseErrorsOpt obj
-                            <*> readProp commentsOpt obj
-                            <*> (maybe "output" id <<< runNullOrUndefined <$> readProp outputOpt obj)
-                            <*> readProp noPrefixOpt obj
-                            <*> readProp srcOpt obj
-                            <*> readProp ffiOpt obj)
-
-class LoaderOption a where
-  opt :: String -> NullOrUndefined a -> Array String
-
-instance booleanLoaderOption :: LoaderOption Boolean where
-  opt key val = maybe [] (\a -> if a then ["--" ++ key] else []) (runNullOrUndefined val)
-
-instance stringLoaderOption :: LoaderOption String where
-  opt key val = maybe [] (\a -> ["--" ++ key ++ "=" ++ a]) (runNullOrUndefined val)
-
-instance arrayLoaderOption :: (LoaderOption a) => LoaderOption (Array a) where
-  opt key val = concat (opt key <$> (NullOrUndefined <<< Just)
-                                <$> (fromMaybe [] (runNullOrUndefined val)))
-
-pscOptions :: Options -> Array String
-pscOptions (Options a) = opt noPreludeOpt a.noPrelude <>
-                         opt noOptsOpt a.noOpts <>
-                         opt noMagicDoOpt a.noMagicDo <>
-                         opt noTcoOpt a.noTco <>
-                         opt verboseErrorsOpt a.verboseErrors <>
-                         opt commentsOpt a.comments <>
-                         opt outputOpt (NullOrUndefined $ Just a.output) <>
-                         opt noPrefixOpt a.noPrefix <>
-                         opt requirePathOpt (NullOrUndefined $ Just a.requirePath) <>
-                         opt ffiOpt a.ffi
-
-loaderSrcOption :: Foreign -> Maybe (Array String)
-loaderSrcOption query = either (const Nothing) (\(Options a) -> runNullOrUndefined a.src) (read query)
-
-loaderFFIOption :: Foreign -> Maybe (Array String)
-loaderFFIOption query = either (const Nothing) (\(Options a) -> runNullOrUndefined a.ffi) (read query)
+  read obj =
+    Options <$> ({ bundleOutput: _ }
+            <$> (maybe bundleOutputDefault id <<< runNullOrUndefined <$> readProp bundleOutput obj))
+    where
+    bundleOutput :: String
+    bundleOutput = "bundleOutput"
+
+    bundleOutputDefault :: String
+    bundleOutputDefault = joinPath "output" "bundle.js"
diff --git a/src/PursLoader/Loader.js b/src/PursLoader/Path.js
index 45e9c2f..878f256 100644
--- a/src/PursLoader/Loader.js
+++ b/src/PursLoader/Path.js
@@ -1,27 +1,22 @@
 'use strict'
 
-// module PursLoader.Loader
+// module PursLoader.Path
 
 var path = require('path');
 
-var cwd = process.cwd();
-
 function relative(from) {
   return function(to){
     return path.relative(from, to);
   };
 }
+exports.relative = relative;
+
 
 function joinPath(a) {
   return function(b) {
     return path.join(a, b);
   };
 }
-
-exports.cwd = cwd;
-
-exports.relative = relative;
-
 exports.joinPath = joinPath;
 
 exports.resolve = path.resolve;
diff --git a/src/PursLoader/Path.purs b/src/PursLoader/Path.purs
new file mode 100644
index 0000000..98cad5a
--- /dev/null
+++ b/src/PursLoader/Path.purs
@@ -0,0 +1,14 @@
+module PursLoader.Path
+  ( relative
+  , resolve
+  , dirname
+  , joinPath
+  ) where
+
+foreign import relative :: String -> String -> String
+
+foreign import resolve :: String -> String
+
+foreign import dirname :: String -> String
+
+foreign import joinPath :: String -> String -> String