aboutsummaryrefslogtreecommitdiffhomepage
path: root/src/PursLoader
diff options
context:
space:
mode:
Diffstat (limited to 'src/PursLoader')
-rw-r--r--src/PursLoader/ChildProcess.js40
-rw-r--r--src/PursLoader/ChildProcess.purs23
-rw-r--r--src/PursLoader/FS.js36
-rw-r--r--src/PursLoader/FS.purs38
-rw-r--r--src/PursLoader/Glob.js18
-rw-r--r--src/PursLoader/Glob.purs22
-rw-r--r--src/PursLoader/Loader.js19
-rw-r--r--src/PursLoader/Loader.purs105
-rw-r--r--src/PursLoader/LoaderRef.js56
-rw-r--r--src/PursLoader/LoaderRef.purs40
-rw-r--r--src/PursLoader/LoaderUtil.js7
-rw-r--r--src/PursLoader/LoaderUtil.purs9
-rw-r--r--src/PursLoader/Options.purs109
13 files changed, 522 insertions, 0 deletions
diff --git a/src/PursLoader/ChildProcess.js b/src/PursLoader/ChildProcess.js
new file mode 100644
index 0000000..d62aef6
--- /dev/null
+++ b/src/PursLoader/ChildProcess.js
@@ -0,0 +1,40 @@
1'use strict';
2
3// module PursLoader.ChildProcess
4
5var child_process = require('child_process');
6
7var chalk = require('chalk');
8
9function spawnFn(command, args, errback, callback) {
10 return function(){
11 var process = child_process.spawn(command, args);
12
13 var stdout = new Buffer(0);
14
15 var stderr = new Buffer(0);
16
17 process.stdout.on('data', function(data){
18 stdout = Buffer.concat([stdout, new Buffer(data)]);
19 });
20
21 process.stderr.on('data', function(data){
22 stderr = Buffer.concat([stderr, new Buffer(data)]);
23 });
24
25 process.on('close', function(code){
26 var output = stdout.toString('utf-8');
27
28 var error = stderr.toString('utf-8');
29
30 if (error.length > 0) {
31 console.error('\n' + chalk.red('*') + ' ' + error);
32 }
33
34 if (code !== 0) errback(new Error('Process terminated with code ' + code))();
35 else callback(output)();
36 });
37 };
38}
39
40exports.spawnFn = spawnFn;
diff --git a/src/PursLoader/ChildProcess.purs b/src/PursLoader/ChildProcess.purs
new file mode 100644
index 0000000..3bd960b
--- /dev/null
+++ b/src/PursLoader/ChildProcess.purs
@@ -0,0 +1,23 @@
1module PursLoader.ChildProcess
2 ( ChildProcess()
3 , spawn
4 ) where
5
6import Prelude (Unit(), ($))
7
8import Control.Monad.Aff (Aff(), makeAff)
9import Control.Monad.Eff (Eff())
10import Control.Monad.Eff.Exception (Error())
11
12import Data.Function
13
14foreign import data ChildProcess :: !
15
16spawn :: forall eff. String -> Array String -> Aff (cp :: ChildProcess | eff) String
17spawn command args = makeAff $ runFn4 spawnFn command args
18
19foreign import spawnFn :: forall eff. Fn4 String
20 (Array String)
21 (Error -> Eff (cp :: ChildProcess | eff) Unit)
22 (String -> Eff (cp :: ChildProcess | eff) Unit)
23 (Eff (cp :: ChildProcess | eff) Unit)
diff --git a/src/PursLoader/FS.js b/src/PursLoader/FS.js
new file mode 100644
index 0000000..1a7f5b0
--- /dev/null
+++ b/src/PursLoader/FS.js
@@ -0,0 +1,36 @@
1'use strict';
2
3// module PursLoader.FS
4
5var fs = require('fs');
6
7var async = require('async');
8
9function writeFileUtf8Fn(filepath, contents, errback, callback) {
10 return function(){
11 fs.writeFile(filepath, contents, function(error){
12 if (error) errback(error)();
13 else callback()();
14 });
15 };
16}
17
18function findFileUtf8Fn(nothing, just, regex, filepaths, errback, callback) {
19 return function(){
20 function findFile(filepath, callback) {
21 fs.readFile(filepath, {encoding: 'utf-8'}, function(error, result){
22 if (error) callback(false);
23 else callback(regex.test(result));
24 });
25 }
26
27 async.detect(filepaths, findFile, function(result){
28 if (!result) callback(nothing)();
29 else callback(just(result))();
30 });
31 };
32}
33
34exports.writeFileUtf8Fn = writeFileUtf8Fn;
35
36exports.findFileUtf8Fn = findFileUtf8Fn;
diff --git a/src/PursLoader/FS.purs b/src/PursLoader/FS.purs
new file mode 100644
index 0000000..969e3d0
--- /dev/null
+++ b/src/PursLoader/FS.purs
@@ -0,0 +1,38 @@
1module PursLoader.FS
2 ( FS()
3 , writeFileUtf8
4 , findFileUtf8
5 ) where
6
7import Prelude (Unit(), ($))
8
9import Control.Monad.Aff (Aff(), makeAff)
10import Control.Monad.Eff (Eff())
11import Control.Monad.Eff.Exception (Error())
12
13import Data.Maybe (Maybe(..))
14import Data.String.Regex (Regex())
15
16import Data.Function
17
18foreign import data FS :: !
19
20writeFileUtf8 :: forall eff. String -> String -> Aff (fs :: FS | eff) Unit
21writeFileUtf8 filepath contents = makeAff $ runFn4 writeFileUtf8Fn filepath contents
22
23foreign import writeFileUtf8Fn :: forall eff. Fn4 String
24 String
25 (Error -> Eff (fs :: FS | eff) Unit)
26 (Unit -> Eff (fs :: FS | eff) Unit)
27 (Eff (fs :: FS | eff) Unit)
28
29findFileUtf8 :: forall eff. Regex -> Array String -> Aff (fs :: FS | eff) (Maybe String)
30findFileUtf8 regexp filepaths = makeAff $ runFn6 findFileUtf8Fn Nothing Just regexp filepaths
31
32foreign import findFileUtf8Fn :: forall eff. Fn6 (Maybe String)
33 (String -> Maybe String)
34 Regex
35 (Array String)
36 (Error -> Eff (fs :: FS | eff) Unit)
37 (Maybe String -> Eff (fs :: FS | eff) Unit)
38 (Eff (fs :: FS | eff) Unit)
diff --git a/src/PursLoader/Glob.js b/src/PursLoader/Glob.js
new file mode 100644
index 0000000..960ae9a
--- /dev/null
+++ b/src/PursLoader/Glob.js
@@ -0,0 +1,18 @@
1'use strict';
2
3// module PursLoader.Glob
4
5var glob = require('glob');
6
7var async = require('async');
8
9function globAllFn(patterns, errback, callback) {
10 return function(){
11 async.map(patterns, glob, function(error, result){
12 if (error) errback(new Error(error))();
13 else callback(result)();
14 });
15 };
16}
17
18exports.globAllFn = globAllFn;
diff --git a/src/PursLoader/Glob.purs b/src/PursLoader/Glob.purs
new file mode 100644
index 0000000..45eeb56
--- /dev/null
+++ b/src/PursLoader/Glob.purs
@@ -0,0 +1,22 @@
1module PursLoader.Glob
2 ( Glob()
3 , globAll
4 ) where
5
6import Prelude (Unit(), ($))
7
8import Control.Monad.Aff (Aff(), makeAff)
9import Control.Monad.Eff (Eff())
10import Control.Monad.Eff.Exception (Error())
11
12import Data.Function
13
14foreign import data Glob :: !
15
16globAll :: forall eff. Array String -> Aff (glob :: Glob | eff) (Array (Array String))
17globAll patterns = makeAff $ runFn3 globAllFn patterns
18
19foreign import globAllFn :: forall eff. Fn3 (Array String)
20 (Error -> Eff (glob :: Glob | eff) Unit)
21 ((Array (Array String)) -> Eff (glob :: Glob | eff) Unit)
22 (Eff (glob :: Glob | eff) Unit)
diff --git a/src/PursLoader/Loader.js b/src/PursLoader/Loader.js
new file mode 100644
index 0000000..98459b6
--- /dev/null
+++ b/src/PursLoader/Loader.js
@@ -0,0 +1,19 @@
1'use strict'
2
3// module PursLoader.Loader
4
5var path = require('path');
6
7var cwd = process.cwd();
8
9function relative(from) {
10 return function(to){
11 return path.relative(from, to);
12 };
13}
14
15exports.cwd = cwd;
16
17exports.relative = relative;
18
19exports.resolve = path.resolve;
diff --git a/src/PursLoader/Loader.purs b/src/PursLoader/Loader.purs
new file mode 100644
index 0000000..3cb99cd
--- /dev/null
+++ b/src/PursLoader/Loader.purs
@@ -0,0 +1,105 @@
1module PursLoader.Loader
2 ( Effects()
3 , loader
4 , loaderFn
5 ) where
6
7import Prelude (Unit(), ($), (<>), (>>=), (<$>), (++), bind, flip, id, pure, return, unit)
8
9import Control.Monad.Aff (Aff(), runAff)
10import Control.Monad.Eff (Eff())
11import Control.Monad.Eff.Class (liftEff)
12import Control.Monad.Eff.Exception (error)
13
14import Data.Array ((!!), concat)
15import Data.Function (Fn2(), mkFn2)
16import Data.Maybe (Maybe(..), fromMaybe, maybe)
17import Data.String (joinWith)
18import Data.String.Regex (match, noFlags, regex, test)
19import Data.Traversable (sequence)
20
21import PursLoader.ChildProcess (ChildProcess(), spawn)
22import PursLoader.FS (FS(), writeFileUtf8, findFileUtf8)
23import PursLoader.Glob (Glob(), globAll)
24import PursLoader.LoaderRef (LoaderRef(), Loader(), async, cacheable, query, clearDependencies, addDependency, resourcePath)
25import PursLoader.LoaderUtil (parseQuery)
26import PursLoader.Options (loaderFFIOption, loaderSrcOption, pscOptions)
27
28type Effects eff = (cp :: ChildProcess, fs :: FS, glob :: Glob, loader :: Loader | eff)
29
30moduleRegex = regex "(?:^|\\n)module\\s+([\\w\\.]+)" noFlags { ignoreCase = true }
31
32foreignRegex = regex "(?:^|\\n)\\s*foreign import\\s+" noFlags { ignoreCase = true }
33
34pscCommand = "psc"
35
36psciCommand = "psci"
37
38psciFilename = ".psci"
39
40(!!!) = flip (!!)
41
42foreign import cwd :: String
43
44foreign import relative :: String -> String -> String
45
46foreign import resolve :: String -> String
47
48mkPsci :: Array (Array String) -> Array (Array String) -> String
49mkPsci srcs ffis = joinWith "\n" ((loadModule <$> concat srcs) <> (loadForeign <$> concat ffis))
50 where
51 loadModule :: String -> String
52 loadModule a = ":m " ++ relative cwd a
53
54 loadForeign :: String -> String
55 loadForeign a = ":f " ++ relative cwd a
56
57findFFI :: forall eff. Array (Array String) -> String -> Aff (fs :: FS | eff) (Maybe String)
58findFFI ffiss name = findFileUtf8 re (concat ffiss)
59 where
60 re = regex ("(?:^|\\n)//\\s*module\\s*" ++ name ++ "\\s*\\n") noFlags
61
62loader' :: forall eff. LoaderRef -> String -> Aff (Effects eff) (Maybe String)
63loader' ref source = do
64 liftEff $ cacheable ref
65
66 let parsed = parseQuery $ query ref
67 srcs = fromMaybe [] (loaderSrcOption parsed)
68 ffis = fromMaybe [] (loaderFFIOption parsed)
69 opts = pscOptions parsed
70
71 spawn pscCommand (srcs <> opts)
72
73 srcss <- globAll srcs
74 ffiss <- globAll ffis
75
76 let psciFile = mkPsci srcss ffiss
77
78 writeFileUtf8 psciFilename psciFile
79
80 let moduleName = match moduleRegex source >>= (!!!) 1 >>= id
81 hasForeign = test foreignRegex source
82 result = (\a -> "module.exports = require('" ++ a ++ "');") <$> moduleName
83
84 liftEff (clearDependencies ref)
85 liftEff (addDependency ref (resourcePath ref))
86 liftEff (sequence $ (\src -> addDependency ref (resolve src)) <$> concat srcss)
87
88 foreignPath <- if hasForeign
89 then fromMaybe (pure Nothing) (findFFI ffiss <$> moduleName)
90 else pure Nothing
91
92 fromMaybe (pure unit) ((\path -> liftEff (addDependency ref path)) <$> foreignPath)
93
94 return result
95
96loader :: forall eff. LoaderRef -> String -> Eff (Effects eff) Unit
97loader ref source = do
98 callback <- async ref
99 runAff (\e -> callback (Just e) "")
100 (maybe (callback (Just (error "Loader has failed to run")) "")
101 (callback Nothing))
102 (loader' ref source)
103
104loaderFn :: forall eff. Fn2 LoaderRef String (Eff (Effects eff) Unit)
105loaderFn = mkFn2 loader
diff --git a/src/PursLoader/LoaderRef.js b/src/PursLoader/LoaderRef.js
new file mode 100644
index 0000000..3ce0970
--- /dev/null
+++ b/src/PursLoader/LoaderRef.js
@@ -0,0 +1,56 @@
1'use strict';
2
3// module PursLoader.LoaderRef
4
5function asyncFn(isJust, fromMaybe, ref){
6 return function(){
7 var callback = ref.async();
8 return function(error){
9 return function(value){
10 return function(){
11 return isJust(error) ? callback(fromMaybe(new Error())(error))
12 : callback(null, value);
13 };
14 };
15 };
16 };
17}
18function cacheable(ref){
19 return function(){
20 return ref.cacheable && ref.cacheable();
21 };
22}
23
24function query(ref){
25 return ref.query;
26}
27
28function clearDependencies(ref){
29 return function(){
30 return ref.clearDependencies();
31 };
32}
33
34function resourcePath(ref){
35 return ref.resourcePath;
36}
37
38function addDependency(ref){
39 return function(dep){
40 return function(){
41 return ref.addDependency(dep);
42 };
43 };
44}
45
46exports.asyncFn = asyncFn;
47
48exports.cacheable = cacheable;
49
50exports.query = query;
51
52exports.clearDependencies = clearDependencies;
53
54exports.resourcePath = resourcePath;
55
56exports.addDependency = addDependency;
diff --git a/src/PursLoader/LoaderRef.purs b/src/PursLoader/LoaderRef.purs
new file mode 100644
index 0000000..33c4f7e
--- /dev/null
+++ b/src/PursLoader/LoaderRef.purs
@@ -0,0 +1,40 @@
1module PursLoader.LoaderRef
2 ( LoaderRef()
3 , Loader()
4 , async
5 , cacheable
6 , query
7 , clearDependencies
8 , addDependency
9 , resourcePath
10 ) where
11
12import Prelude (Unit())
13
14import Control.Monad.Eff (Eff())
15import Control.Monad.Eff.Exception (Error())
16
17import Data.Function (Fn3(), runFn3)
18import Data.Maybe (Maybe(), fromMaybe, isJust)
19
20data LoaderRef
21
22foreign import data Loader :: !
23
24foreign import asyncFn :: forall eff a. Fn3 (Maybe Error -> Boolean)
25 (Error -> Maybe Error -> Error)
26 LoaderRef
27 (Eff (loader :: Loader | eff) (Maybe Error -> a -> Eff (loader :: Loader | eff) Unit))
28
29async :: forall eff a. LoaderRef -> Eff (loader :: Loader | eff) (Maybe Error -> a -> Eff (loader :: Loader | eff) Unit)
30async ref = runFn3 asyncFn isJust fromMaybe ref
31
32foreign import cacheable :: forall eff. LoaderRef -> Eff (loader :: Loader | eff) Unit
33
34foreign import query :: LoaderRef -> String
35
36foreign import clearDependencies :: forall eff. LoaderRef -> Eff (loader :: Loader | eff) Unit
37
38foreign import resourcePath :: LoaderRef -> String
39
40foreign import addDependency :: forall eff. LoaderRef -> String -> Eff (loader :: Loader | eff) Unit
diff --git a/src/PursLoader/LoaderUtil.js b/src/PursLoader/LoaderUtil.js
new file mode 100644
index 0000000..45f2703
--- /dev/null
+++ b/src/PursLoader/LoaderUtil.js
@@ -0,0 +1,7 @@
1'use strict';
2
3// module PursLoader.LoaderUtil
4
5var loaderUtils = require('loader-utils');
6
7exports.parseQuery = loaderUtils.parseQuery;
diff --git a/src/PursLoader/LoaderUtil.purs b/src/PursLoader/LoaderUtil.purs
new file mode 100644
index 0000000..3e5a7bc
--- /dev/null
+++ b/src/PursLoader/LoaderUtil.purs
@@ -0,0 +1,9 @@
1module PursLoader.LoaderUtil
2 ( parseQuery
3 ) where
4
5import Data.Foreign (Foreign())
6
7import PursLoader.LoaderRef (LoaderRef())
8
9foreign import parseQuery :: String -> Foreign
diff --git a/src/PursLoader/Options.purs b/src/PursLoader/Options.purs
new file mode 100644
index 0000000..e3957eb
--- /dev/null
+++ b/src/PursLoader/Options.purs
@@ -0,0 +1,109 @@
1module PursLoader.Options
2 ( pscOptions
3 , loaderSrcOption
4 , loaderFFIOption
5 ) where
6
7import Prelude (Unit(), (<>), (<$>), (<<<), (++), (<*>), const)
8
9import Data.Array (concat)
10import Data.Either (either)
11
12import Data.Foreign (Foreign(), F())
13import Data.Foreign.Class (IsForeign, read, readProp)
14import Data.Foreign.NullOrUndefined (NullOrUndefined(..), runNullOrUndefined)
15
16import Data.Maybe (Maybe(..), maybe, fromMaybe)
17
18noPreludeOpt = "no-prelude"
19
20noOptsOpt = "no-opts"
21
22noMagicDoOpt = "no-magic-do"
23
24noTcoOpt = "no-tco"
25
26verboseErrorsOpt = "verbose-errors"
27
28outputOpt = "output"
29
30commentsOpt = "comments"
31
32noPrefixOpt = "no-prefix"
33
34requirePathOpt = "require-path"
35
36srcOpt = "src"
37
38ffiOpt = "ffi"
39
40newtype Options
41 = Options { noPrelude :: NullOrUndefined Boolean
42 , noOpts :: NullOrUndefined Boolean
43 , noMagicDo :: NullOrUndefined Boolean
44 , noTco :: NullOrUndefined Boolean
45 , verboseErrors :: NullOrUndefined Boolean
46 , comments :: NullOrUndefined Boolean
47 , output :: NullOrUndefined String
48 , noPrefix :: NullOrUndefined Boolean
49 , requirePath :: NullOrUndefined String
50 , src :: NullOrUndefined (Array String)
51 , ffi :: NullOrUndefined (Array String)
52 }
53
54instance isForeignOptions :: IsForeign Options where
55 read obj = Options <$> ({ noPrelude: _
56 , noOpts: _
57 , noMagicDo: _
58 , noTco: _
59 , verboseErrors: _
60 , comments: _
61 , output: _
62 , noPrefix: _
63 , requirePath: _
64 , src: _
65 , ffi: _
66 } <$> readProp noPreludeOpt obj
67 <*> readProp noOptsOpt obj
68 <*> readProp noMagicDoOpt obj
69 <*> readProp noTcoOpt obj
70 <*> readProp verboseErrorsOpt obj
71 <*> readProp commentsOpt obj
72 <*> readProp outputOpt obj
73 <*> readProp noPrefixOpt obj
74 <*> readProp requirePathOpt obj
75 <*> readProp srcOpt obj
76 <*> readProp ffiOpt obj)
77
78class LoaderOption a where
79 opt :: String -> NullOrUndefined a -> Array String
80
81instance booleanLoaderOption :: LoaderOption Boolean where
82 opt key val = maybe [] (\a -> if a then ["--" ++ key] else []) (runNullOrUndefined val)
83
84instance stringLoaderOption :: LoaderOption String where
85 opt key val = maybe [] (\a -> ["--" ++ key ++ "=" ++ a]) (runNullOrUndefined val)
86
87instance arrayLoaderOption :: (LoaderOption a) => LoaderOption (Array a) where
88 opt key val = concat (opt key <$> (NullOrUndefined <<< Just)
89 <$> (fromMaybe [] (runNullOrUndefined val)))
90
91pscOptions :: Foreign -> Array String
92pscOptions query = either (const []) fold parsed
93 where parsed = read query :: F Options
94 fold (Options a) = opt noPreludeOpt a.noPrelude <>
95 opt noOptsOpt a.noOpts <>
96 opt noMagicDoOpt a.noMagicDo <>
97 opt noTcoOpt a.noTco <>
98 opt verboseErrorsOpt a.verboseErrors <>
99 opt commentsOpt a.comments <>
100 opt outputOpt a.output <>
101 opt noPrefixOpt a.noPrefix <>
102 opt requirePathOpt a.requirePath <>
103 opt ffiOpt a.ffi
104
105loaderSrcOption :: Foreign -> Maybe (Array String)
106loaderSrcOption query = either (const Nothing) (\(Options a) -> runNullOrUndefined a.src) (read query)
107
108loaderFFIOption :: Foreign -> Maybe (Array String)
109loaderFFIOption query = either (const Nothing) (\(Options a) -> runNullOrUndefined a.ffi) (read query)