Merge pull request #38 from ethul/topic/dependency-graph

Topic/dependency graph

4 files changed, 128 insertions, 35 deletions

diff --git a/src/PursLoader/Loader.purs b/src/PursLoader/Loader.purs
index affce53..f78153f 100644
--- a/src/PursLoader/Loader.purs
+++ b/src/PursLoader/Loader.purs
@@ -4,25 +4,27 @@ module PursLoader.Loader
   , loaderFn
   ) where
 
-import Prelude (Unit(), ($), (>>=), (<$>), (<*>), (<<<), (++), bind, const)
+import Prelude (Unit(), ($), (>>=), (<$>), (<*>), (++), bind, const, id, pure, unit)
 
+import Control.Apply ((*>))
 import Control.Bind (join)
-import Control.Monad.Eff (Eff())
+import Control.Monad.Eff (Eff(), foreachE)
 import Control.Monad.Eff.Exception (Error(), error)
 
 import Data.Array ((!!))
+import Data.Bifunctor (lmap)
+import Data.Either (Either(..), either)
+import Data.Foreign.Class (read)
 import Data.Function (Fn2(), mkFn2)
 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.Nullable (toMaybe)
 import Data.String.Regex (Regex(), match, noFlags, regex)
 
 import Unsafe.Coerce (unsafeCoerce)
 
 import PursLoader.LoaderRef
-  ( LoaderRef()
+  ( AsyncCallback()
+  , LoaderRef()
   , Loader()
   , async
   , cacheable
@@ -33,46 +35,68 @@ import PursLoader.LoaderRef
   )
 
 import PursLoader.LoaderUtil (parseQuery)
-import PursLoader.Options (runOptions)
+import PursLoader.Options (Options(..))
 import PursLoader.Path (dirname, relative)
+import PursLoader.Plugin as Plugin
 
 type Effects eff = (loader :: Loader | eff)
 
-type PurescriptWebpackPluginContext eff = { compile :: (Foreign -> Eff (Effects eff) Unit) -> Eff (Effects eff) Unit }
-
 loader :: forall eff. LoaderRef -> String -> Eff (Effects eff) Unit
 loader ref source = do
   callback <- async ref
 
   cacheable ref
 
-  let parsed = parseQuery $ query ref
-
-      options = either (const Nothing) (Just <<< runOptions) (read parsed)
-
-      moduleName = join $ match moduleRegex source >>= \as -> as !! 1
-
-      resourceDir = dirname (resourcePath ref)
-
-      modulePath = (\opts -> relative resourceDir opts.bundleOutput) <$> options
-
-      result = (\path name -> "module.exports = require('" ++ path ++ "')['" ++ name ++ "'];") <$> modulePath <*> moduleName
-
-  clearDependencies ref
-
-  addDependency ref (resourcePath ref)
-
-  pluginContext.compile (\err -> maybe (callback (Just $ error "Failed to run loader") "")
-                                       (callback (compileError err)) result)
+  pluginContext.compile (compile callback)
   where
-  moduleRegex :: Regex
-  moduleRegex = regex "(?:^|\\n)module\\s+([\\w\\.]+)" noFlags { ignoreCase = true }
-
-  pluginContext :: PurescriptWebpackPluginContext eff
+  pluginContext :: Plugin.Context (Effects eff)
   pluginContext = (unsafeCoerce ref).purescriptWebpackPluginContext
 
-  compileError :: Foreign -> Maybe Error
-  compileError value = either (const $ Just (error "Failed to compile")) ((<$>) error) (runNull <$> read value)
+  compile :: AsyncCallback eff -> Plugin.Compile (Effects eff)
+  compile callback error' { srcMap, ffiMap, graph } = do
+    clearDependencies ref
+
+    addDependency ref (resourcePath ref)
+
+    either (\err -> callback (Just err) "") id
+           (handle <$> name <*> dependencies <*> exports)
+    where
+    handle :: String -> Array String -> String -> Eff (Effects eff) Unit
+    handle name' deps res = do
+      addTransitive name'
+      foreachE deps addTransitive
+      callback (toMaybe error') res
+
+    exports :: Either Error String
+    exports = (\a b -> "module.exports = require('" ++ a ++ "')['" ++ b ++ "'];") <$> path <*> name
+
+    dependencies :: Either Error (Array String)
+    dependencies = name >>= Plugin.dependenciesOf graph
+
+    addTransitive :: String -> Eff (Effects eff) Unit
+    addTransitive dep = addDep (Plugin.get srcMap dep) *> addDep (Plugin.get ffiMap dep)
+      where
+      addDep :: Maybe String -> Eff (Effects eff) Unit
+      addDep = maybe (pure unit) (addDependency ref)
+
+    name :: Either Error String
+    name =
+      maybe (Left $ error "Failed to parse module name") Right
+            (join $ match re source >>= \as -> as !! 1)
+      where
+      re :: Regex
+      re = regex "(?:^|\\n)module\\s+([\\w\\.]+)" noFlags { ignoreCase = true }
+
+    path :: Either Error String
+    path = (\(Options opts) -> relative resourceDir opts.bundleOutput) <$> options
+      where
+      options :: Either Error Options
+      options =
+        lmap (const $ error "Failed to parse loader query")
+             (read $ parseQuery (query ref))
+
+      resourceDir :: String
+      resourceDir = dirname (resourcePath ref)
 
 loaderFn :: forall eff. Fn2 LoaderRef String (Eff (Effects eff) Unit)
 loaderFn = mkFn2 loader
diff --git a/src/PursLoader/Options.purs b/src/PursLoader/Options.purs
index 706ddd2..0c1453e 100644
--- a/src/PursLoader/Options.purs
+++ b/src/PursLoader/Options.purs
@@ -1,5 +1,5 @@
 module PursLoader.Options
-  ( Options()
+  ( Options(..)
   , runOptions
   ) where
 
diff --git a/src/PursLoader/Plugin.js b/src/PursLoader/Plugin.js
new file mode 100644
index 0000000..90feb33
--- /dev/null
+++ b/src/PursLoader/Plugin.js
@@ -0,0 +1,20 @@
+'use strict';
+
+// module PursLoader.Plugin
+
+function getFn(nothing, just, map, key) {
+  var value = map.get(key);
+  return value === undefined ? nothing : just(value);
+}
+exports.getFn = getFn;
+
+function dependenciesOfFn(left, right, graph, node) {
+  try {
+    var dependencies = graph.dependenciesOf(node);
+    return right(dependencies);
+  }
+  catch (error) {
+    return left(error);
+  }
+}
+exports.dependenciesOfFn = dependenciesOfFn;
diff --git a/src/PursLoader/Plugin.purs b/src/PursLoader/Plugin.purs
new file mode 100644
index 0000000..23f8600
--- /dev/null
+++ b/src/PursLoader/Plugin.purs
@@ -0,0 +1,49 @@
+module PursLoader.Plugin
+  ( Result()
+  , Compile()
+  , Context()
+  , ImmutableMap()
+  , DependencyGraph()
+  , get
+  , dependenciesOf
+  ) where
+
+import Prelude (Unit())
+
+import Control.Monad.Eff (Eff())
+import Control.Monad.Eff.Exception (Error())
+
+import Data.Either (Either(..))
+import Data.Function (Fn4(), runFn4)
+import Data.Maybe (Maybe(..))
+import Data.Nullable (Nullable())
+
+type Result = { srcMap :: ImmutableMap String String, ffiMap :: ImmutableMap String String, graph :: DependencyGraph }
+
+type Compile eff = Nullable Error -> Result -> Eff eff Unit
+
+type Context eff = { compile :: Compile eff -> Eff eff Unit }
+
+get :: forall key value. ImmutableMap key value -> key -> Maybe value
+get = runFn4 getFn Nothing Just
+
+dependenciesOf :: DependencyGraph -> String -> Either Error (Array String)
+dependenciesOf = runFn4 dependenciesOfFn Left Right
+
+foreign import data ImmutableMap :: * -> * -> *
+
+foreign import data DependencyGraph :: *
+
+foreign import getFn
+  :: forall key value. Fn4 (Maybe value)
+                           (value -> Maybe value)
+                           (ImmutableMap key value)
+                           key
+                           (Maybe value)
+
+foreign import dependenciesOfFn
+  :: Fn4 (Error -> Either Error (Array String))
+         (Array String -> Either Error (Array String))
+         DependencyGraph
+         String
+         (Either Error (Array String))