From c194f84cab66fa6e18b78c32f9cdf2bddf8d1e68 Mon Sep 17 00:00:00 2001 From: eric thul Date: Wed, 8 Apr 2015 19:49:24 -0400 Subject: Rewrite using purescript for the implementation --- src/ChildProcess.purs | 40 ++++++++++++++++++ src/FS.purs | 45 ++++++++++++++++++++ src/Glob.purs | 31 ++++++++++++++ src/Loader.purs | 114 ++++++++++++++++++++++++++++++++++++++++++++++++++ src/LoaderRef.purs | 75 +++++++++++++++++++++++++++++++++ src/LoaderUtil.purs | 20 +++++++++ src/OS.purs | 3 ++ src/Options.purs | 72 +++++++++++++++++++++++++++++++ src/Path.purs | 36 ++++++++++++++++ 9 files changed, 436 insertions(+) create mode 100644 src/ChildProcess.purs create mode 100644 src/FS.purs create mode 100644 src/Glob.purs create mode 100644 src/Loader.purs create mode 100644 src/LoaderRef.purs create mode 100644 src/LoaderUtil.purs create mode 100644 src/OS.purs create mode 100644 src/Options.purs create mode 100644 src/Path.purs (limited to 'src') diff --git a/src/ChildProcess.purs b/src/ChildProcess.purs new file mode 100644 index 0000000..c9ff23b --- /dev/null +++ b/src/ChildProcess.purs @@ -0,0 +1,40 @@ +module PursLoader.ChildProcess + ( ChildProcess() + , spawn + ) where + +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 -> [String] -> Aff (cp :: ChildProcess | eff) String +spawn command args = makeAff $ runFn4 spawnFn command args + +foreign import spawnFn """ +function spawnFn(command, args, errback, callback) { + return function(){ + var child_process = require('child_process'); + + var process = child_process.spawn(command, args); + + var stdout = new Buffer(0); + + process.stdout.on('data', function(data){ + stdout = Buffer.concat([stdout, new Buffer(data)]); + }); + + process.on('close', function(code){ + if (code !== 0) errback(new Error(stdout.toString()))(); + else callback(stdout.toString())(); + }); + }; +} +""" :: forall eff. Fn4 String + [String] + (Error -> Eff (cp :: ChildProcess | eff) Unit) + (String -> Eff (cp :: ChildProcess | eff) Unit) + (Eff (cp :: ChildProcess | eff) Unit) diff --git a/src/FS.purs b/src/FS.purs new file mode 100644 index 0000000..68fe2f9 --- /dev/null +++ b/src/FS.purs @@ -0,0 +1,45 @@ +module PursLoader.FS + ( FS() + , readFileUtf8 + , readFileUtf8Sync + ) where + +import Control.Monad.Aff (Aff(), makeAff) +import Control.Monad.Eff (Eff()) +import Control.Monad.Eff.Exception (Error()) + +import Data.Function + +foreign import data FS :: ! + +readFileUtf8 :: forall eff. String -> Aff (fs :: FS | eff) String +readFileUtf8 filepath = makeAff $ runFn3 readFileUtf8Fn filepath + +readFileUtf8Sync :: forall eff. String -> Eff (fs :: FS | eff) String +readFileUtf8Sync filepath = readFileUtf8SyncFn filepath + +foreign import readFileUtf8Fn """ +function readFileUtf8Fn(filepath, errback, callback) { + return function(){ + var fs = require('fs'); + + fs.readFile(filepath, 'utf-8', function(e, data){ + if (e) errback(e)(); + else callback(data)(); + }); + }; +} +""" :: forall eff. Fn3 String + (Error -> Eff (fs :: FS | eff) Unit) + (String -> Eff (fs :: FS | eff) Unit) + (Eff (fs :: FS | eff) Unit) + +foreign import readFileUtf8SyncFn """ +function readFileUtf8SyncFn(filepath) { + return function(){ + var fs = require('fs'); + + return fs.readFileSync(filepath, {encoding: 'utf-8'}); + }; +} +""" :: forall eff. String -> (Eff (fs :: FS | eff) String) diff --git a/src/Glob.purs b/src/Glob.purs new file mode 100644 index 0000000..7bc9212 --- /dev/null +++ b/src/Glob.purs @@ -0,0 +1,31 @@ +module PursLoader.Glob + ( Glob() + , glob + ) where + +import Control.Monad.Aff (Aff(), makeAff) +import Control.Monad.Eff (Eff()) +import Control.Monad.Eff.Exception (Error()) + +import Data.Function + +foreign import data Glob :: ! + +glob :: forall eff. String -> Aff (glob :: Glob | eff) [String] +glob pattern = makeAff $ runFn3 globFn pattern + +foreign import globFn """ +function globFn(pattern, errback, callback) { + return function(){ + var glob = require('glob'); + + glob(pattern, function(e, data){ + if (e) errback(e)(); + else callback(data)(); + }); + }; +} +""" :: forall eff. Fn3 String + (Error -> Eff (glob :: Glob | eff) Unit) + ([String] -> Eff (glob :: Glob | eff) Unit) + (Eff (glob :: Glob | eff) Unit) diff --git a/src/Loader.purs b/src/Loader.purs new file mode 100644 index 0000000..523aa7a --- /dev/null +++ b/src/Loader.purs @@ -0,0 +1,114 @@ +module PursLoader.Loader + ( LoaderEff() + , loader + , loaderFn + ) where + +import Control.Monad.Aff (Aff(), runAff) +import Control.Monad.Eff (Eff()) +import Control.Monad.Eff.Class (liftEff) +import Control.Monad.Eff.Exception (error) + +import Data.Array ((!!), catMaybes, concat, nub, null) +import Data.Function (Fn2(), mkFn2) +import Data.Maybe (Maybe(..), fromMaybe, maybe) +import Data.String (joinWith, split) +import Data.String.Regex (Regex(), match, noFlags, regex) +import Data.StrMap (StrMap(), fromList, lookup) +import Data.Traversable (sequence) +import Data.Tuple.Nested (tuple2) + +import PursLoader.ChildProcess (ChildProcess(), spawn) +import PursLoader.FS (FS(), readFileUtf8, readFileUtf8Sync) +import PursLoader.Glob (Glob(), glob) +import PursLoader.LoaderRef (LoaderRef(), Loader(), async, cacheable, clearDependencies, addDependency, query, resourcePath) +import PursLoader.LoaderUtil (getRemainingRequest, parseQuery) +import PursLoader.OS (eol) +import PursLoader.Options (pscMakeOptions, pscMakeDefaultOutput, pscMakeOutputOption) +import PursLoader.Path (dirname, join, relative, resolve) + +foreign import cwd "var cwd = process.cwd();" :: String + +moduleRegex = regex "(?:^|\\n)module\\s+([\\w\\.]+)" noFlags { ignoreCase = true } + +importRegex = regex "^\\s*import\\s+(?:qualified\\s+)?([\\w\\.]+)" noFlags { ignoreCase = true } + +bowerPattern = join [ "bower_components", "purescript-*", "src" ] + +pscMakeCommand = "psc-make" + +indexFilename = "index.js" + +(!!!) = flip (!!) + +pursPattern :: String -> String +pursPattern root = join [ "{" ++ joinWith "," [ bowerPattern, root ] ++ "}" + , "**" + , "*.purs" + ] + +type GraphModule = { file :: String, imports :: [String] } + +type Graph = StrMap GraphModule + +mkGraph :: forall eff. [String] -> Eff (fs :: FS | eff) Graph +mkGraph files = (fromList <<< catMaybes) <$> sequence (parse <$> files) + where parse file = do source <- readFileUtf8Sync file + let key = match moduleRegex source >>= (!!!) 1 + lines = split eol source + imports = catMaybes $ (\a -> match importRegex a >>= (!!!) 1) <$> lines + return $ (\a -> tuple2 a { file: file, imports: imports }) <$> key + +mkDeps :: forall eff. String -> Graph -> [String] +mkDeps key graph = nub $ go [] key + where go acc key = + maybe acc (\a -> if null a.imports + then acc + else concat $ go (acc <> a.imports) <$> a.imports) (lookup key graph) + +addDeps :: forall eff. LoaderRef -> Graph -> [String] -> Eff (loader :: Loader | eff) Unit +addDeps ref graph deps = const unit <$> (sequence $ add <$> deps) + where add dep = let res = lookup dep graph + path = (\a -> resolve a.file) <$> res + in maybe (pure unit) (addDependency ref) path + +type LoaderAff eff a = Aff (loader :: Loader, glob :: Glob, cp :: ChildProcess, fs :: FS | eff) a + +loader' :: forall eff. LoaderRef -> String -> LoaderAff eff (Maybe String) +loader' ref source = do + liftEff $ cacheable ref + + let request = getRemainingRequest ref + root = dirname $ relative cwd request + parsed = parseQuery $ query ref + opts = pscMakeOptions parsed + pattern = pursPattern root + key = match moduleRegex source >>= (!!!) 1 + + files <- glob pattern + graph <- liftEff $ mkGraph files + + let deps = fromMaybe [] $ flip mkDeps graph <$> key + outputPath = fromMaybe pscMakeDefaultOutput $ pscMakeOutputOption parsed + indexPath = (\a -> join [ outputPath, a, indexFilename ]) <$> key + + liftEff $ clearDependencies ref + liftEff $ addDependency ref (resourcePath ref) + liftEff $ addDeps ref graph deps + + spawn pscMakeCommand (opts <> files) + indexFile <- sequence $ readFileUtf8 <$> indexPath + return indexFile + +type LoaderEff eff a = Eff (loader :: Loader, glob :: Glob, cp :: ChildProcess, fs :: FS | eff) a + +loader :: forall eff. LoaderRef -> String -> LoaderEff 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) + +loaderFn :: forall eff. Fn2 LoaderRef String (LoaderEff eff Unit) +loaderFn = mkFn2 loader diff --git a/src/LoaderRef.purs b/src/LoaderRef.purs new file mode 100644 index 0000000..2d62754 --- /dev/null +++ b/src/LoaderRef.purs @@ -0,0 +1,75 @@ +module PursLoader.LoaderRef + ( LoaderRef() + , Loader() + , async + , cacheable + , clearDependencies + , resourcePath + , addDependency + , query + ) where + +import Control.Monad.Eff (Eff()) +import Control.Monad.Eff.Exception (Error()) + +import Data.Foreign (Foreign()) +import Data.Function (Fn3(), runFn3) +import Data.Maybe (Maybe(), fromMaybe, isJust) + +data LoaderRef + +foreign import data Loader :: ! + +foreign import asyncFn """ +function asyncFn(isJust, fromMaybe, ref){ + return function(){ + var callback = ref.async(); + return function(error){ + return function(value){ + return function(){ + return isJust(error) ? callback(fromMaybe(new Error())(error)) + : callback(null, value); + }; + }; + }; + }; +}""" :: forall eff a. Fn3 (Maybe Error -> Boolean) + (Error -> Maybe Error -> Error) + LoaderRef + (Eff (loader :: Loader | eff) (Maybe Error -> a -> Eff (loader :: Loader | eff) Unit)) + +async :: forall eff a. LoaderRef -> Eff (loader :: Loader | eff) (Maybe Error -> a -> Eff (loader :: Loader | eff) Unit) +async ref = runFn3 asyncFn isJust fromMaybe ref + +foreign import cacheable """ +function cacheable(ref){ + return function(){ + return ref.cacheable && ref.cacheable(); + }; +}""" :: forall eff. LoaderRef -> Eff (loader :: Loader | eff) Unit + +foreign import clearDependencies """ +function clearDependencies(ref){ + return function(){ + return ref.clearDependencies(); + }; +}""" :: forall eff. LoaderRef -> Eff (loader :: Loader | eff) Unit + +foreign import resourcePath """ +function resourcePath(ref){ + return ref.resourcePath; +}""" :: LoaderRef -> String + +foreign import addDependency """ +function addDependency(ref){ + return function(dep){ + return function(){ + return ref.addDependency(dep); + }; + }; +}""" :: forall eff. LoaderRef -> String -> Eff (loader :: Loader | eff) Unit + +foreign import query """ +function query(ref){ + return ref.query; +}""" :: LoaderRef -> String diff --git a/src/LoaderUtil.purs b/src/LoaderUtil.purs new file mode 100644 index 0000000..f22be44 --- /dev/null +++ b/src/LoaderUtil.purs @@ -0,0 +1,20 @@ +module PursLoader.LoaderUtil + ( getRemainingRequest + , parseQuery + ) where + +import Data.Foreign (Foreign()) + +import PursLoader.LoaderRef (LoaderRef()) + +foreign import getRemainingRequest """ +function getRemainingRequest(ref){ + var loaderUtils = require('loader-utils'); + return loaderUtils.getRemainingRequest(ref); +}""" :: LoaderRef -> String + +foreign import parseQuery """ +function parseQuery(query){ + var loaderUtils = require('loader-utils'); + return loaderUtils.parseQuery(query); +}""" :: String -> Foreign diff --git a/src/OS.purs b/src/OS.purs new file mode 100644 index 0000000..590c3d6 --- /dev/null +++ b/src/OS.purs @@ -0,0 +1,3 @@ +module PursLoader.OS (eol) where + +foreign import eol "var eol = require('os').EOL;" :: String diff --git a/src/Options.purs b/src/Options.purs new file mode 100644 index 0000000..b96cddc --- /dev/null +++ b/src/Options.purs @@ -0,0 +1,72 @@ +module PursLoader.Options + ( pscMakeOptions + , pscMakeDefaultOutput + , pscMakeOutputOption + ) where + +import Data.Either (either) + +import Data.Foreign (Foreign(), F()) +import Data.Foreign.Class (IsForeign, read, readProp) +import Data.Foreign.NullOrUndefined (NullOrUndefined(), runNullOrUndefined) + +import Data.Maybe (Maybe(..), maybe) + +noPreludeOpt = "no-prelude" + +noOptsOpt = "no-opts" + +noMagicDoOpt = "no-magic-do" + +noTcoOpt = "no-tco" + +verboseErrorsOpt = "verbose-errors" + +outputOpt = "output" + +pscMakeDefaultOutput = "output" + +newtype Options + = Options { noPrelude :: NullOrUndefined Boolean + , noOpts :: NullOrUndefined Boolean + , noMagicDo :: NullOrUndefined Boolean + , noTco :: NullOrUndefined Boolean + , verboseErrors :: NullOrUndefined Boolean + , output :: NullOrUndefined String + } + +instance isForeignOptions :: IsForeign Options where + read obj = (\a b c d e f -> + Options { noPrelude: a + , noOpts: b + , noMagicDo: c + , noTco: d + , verboseErrors: e + , output: f + }) <$> readProp noPreludeOpt obj + <*> readProp noOptsOpt obj + <*> readProp noMagicDoOpt obj + <*> readProp noTcoOpt obj + <*> readProp verboseErrorsOpt obj + <*> readProp outputOpt obj + +booleanOpt :: String -> NullOrUndefined Boolean -> [String] +booleanOpt key opt = maybe [] (\a -> if a then ["--" ++ key] else []) (runNullOrUndefined opt) + +stringOpt :: String -> NullOrUndefined String -> [String] +stringOpt key opt = maybe [] (\a -> ["--" ++ key ++ "=" ++ a]) (runNullOrUndefined opt) + +pscMakeOutputOption :: Foreign -> Maybe String +pscMakeOutputOption query = either (const Nothing) + (\(Options a) -> runNullOrUndefined a.output) + (read query) + +pscMakeOptions :: Foreign -> [String] +pscMakeOptions query = either (const []) fold parsed + where parsed = read query :: F Options + fold (Options a) = booleanOpt noPreludeOpt a.noPrelude <> + booleanOpt noOptsOpt a.noOpts <> + booleanOpt noMagicDoOpt a.noMagicDo <> + booleanOpt noTcoOpt a.noTco <> + booleanOpt verboseErrorsOpt a.verboseErrors <> + stringOpt outputOpt a.output diff --git a/src/Path.purs b/src/Path.purs new file mode 100644 index 0000000..e071e35 --- /dev/null +++ b/src/Path.purs @@ -0,0 +1,36 @@ +module PursLoader.Path + ( dirname + , join + , relative + , resolve + ) where + +foreign import dirname """ +function dirname(filepath) { + var path = require('path'); + return path.dirname(filepath); +} +""" :: String -> String + +foreign import join """ +function join(parts) { + var path = require('path'); + return path.join.apply(path, parts); +} +""" :: [String] -> String + +foreign import relative """ +function relative(from) { + return function(to){ + var path = require('path'); + return path.relative(from, to); + }; +} +""" :: String -> String -> String + +foreign import resolve """ +function resolve(filepath) { + var path = require('path'); + return path.resolve(filepath); +} +""" :: String -> String -- cgit v1.2.3