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

Topic/psc webpack plugin

1 files changed, 46 insertions, 87 deletions

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