diff options
author | eric thul <thul.eric@gmail.com> | 2015-07-05 10:13:47 -0400 |
---|---|---|
committer | eric thul <thul.eric@gmail.com> | 2015-07-06 23:53:01 -0400 |
commit | 1983893bf09a5c2ea1946e156be5da170075af7e (patch) | |
tree | f99bda0c0ff3c50356d8ab152336ba461c292494 /src/Loader.purs | |
parent | 4558c6cf7879207166b1cc013e2e8112f558bb1d (diff) | |
download | purs-loader-1983893bf09a5c2ea1946e156be5da170075af7e.tar.gz purs-loader-1983893bf09a5c2ea1946e156be5da170075af7e.tar.zst purs-loader-1983893bf09a5c2ea1946e156be5da170075af7e.zip |
Updating for PureScript 0.7
Resolves #14
Diffstat (limited to 'src/Loader.purs')
-rw-r--r-- | src/Loader.purs | 102 |
1 files changed, 17 insertions, 85 deletions
diff --git a/src/Loader.purs b/src/Loader.purs index fedc424..0235da9 100644 --- a/src/Loader.purs +++ b/src/Loader.purs | |||
@@ -1,5 +1,5 @@ | |||
1 | module PursLoader.Loader | 1 | module PursLoader.Loader |
2 | ( LoaderEff() | 2 | ( Effects() |
3 | , loader | 3 | , loader |
4 | , loaderFn | 4 | , loaderFn |
5 | ) where | 5 | ) where |
@@ -9,113 +9,45 @@ import Control.Monad.Eff (Eff()) | |||
9 | import Control.Monad.Eff.Class (liftEff) | 9 | import Control.Monad.Eff.Class (liftEff) |
10 | import Control.Monad.Eff.Exception (error) | 10 | import Control.Monad.Eff.Exception (error) |
11 | 11 | ||
12 | import Data.Array ((!!), catMaybes, concat, filter, null) | 12 | import Data.Array ((!!)) |
13 | import Data.Foldable (foldl) | ||
14 | import Data.Function (Fn2(), mkFn2) | 13 | import Data.Function (Fn2(), mkFn2) |
15 | import Data.Maybe (Maybe(..), fromMaybe, maybe) | 14 | import Data.Maybe (Maybe(..), fromMaybe, maybe) |
16 | import Data.Set (Set(), empty, insert, member, toList, unions) | 15 | import Data.String.Regex (match, noFlags, regex) |
17 | import Data.String (joinWith, split) | ||
18 | import Data.String.Regex (Regex(), match, noFlags, regex) | ||
19 | import Data.StrMap (StrMap(), fromList, lookup) | ||
20 | import Data.Traversable (sequence) | ||
21 | import Data.Tuple.Nested (tuple2) | ||
22 | 16 | ||
23 | import PursLoader.ChildProcess (ChildProcess(), spawn) | 17 | import PursLoader.ChildProcess (ChildProcess(), spawn) |
24 | import PursLoader.FS (FS(), readFileUtf8, readFileUtf8Sync) | 18 | import PursLoader.LoaderRef (LoaderRef(), Loader(), async, cacheable, query) |
25 | import PursLoader.Glob (Glob(), glob) | ||
26 | import PursLoader.LoaderRef (LoaderRef(), Loader(), async, cacheable, clearDependencies, addDependency, query, resourcePath) | ||
27 | import PursLoader.LoaderUtil (getRemainingRequest, parseQuery) | 19 | import PursLoader.LoaderUtil (getRemainingRequest, parseQuery) |
28 | import PursLoader.OS (eol) | 20 | import PursLoader.Options (loaderSrcOption, pscOptions) |
29 | import PursLoader.Options (loaderSrcOption, pscMakeOptions, pscMakeDefaultOutput, pscMakeOutputOption) | ||
30 | import PursLoader.Path (dirname, join, relative, resolve) | ||
31 | 21 | ||
32 | foreign import cwd "var cwd = process.cwd();" :: String | 22 | type Effects eff = (loader :: Loader, cp :: ChildProcess | eff) |
33 | 23 | ||
34 | moduleRegex = regex "(?:^|\\n)module\\s+([\\w\\.]+)" noFlags { ignoreCase = true } | 24 | moduleRegex = regex "(?:^|\\n)module\\s+([\\w\\.]+)" noFlags { ignoreCase = true } |
35 | 25 | ||
36 | importRegex = regex "^\\s*import\\s+(?:qualified\\s+)?([\\w\\.]+)" noFlags { ignoreCase = true } | 26 | pscCommand = "psc" |
37 | |||
38 | bowerPattern = join [ "bower_components", "purescript-*", "src" ] | ||
39 | |||
40 | pscMakeCommand = "psc-make" | ||
41 | |||
42 | indexFilename = "index.js" | ||
43 | 27 | ||
44 | (!!!) = flip (!!) | 28 | (!!!) = flip (!!) |
45 | 29 | ||
46 | pursPattern :: [String] -> String | 30 | loader' :: forall eff. LoaderRef -> String -> Aff (Effects eff) (Maybe String) |
47 | pursPattern srcs = join [ "{" ++ joinWith "," ([ bowerPattern ] <> srcs) ++ "}" | ||
48 | , "**" | ||
49 | , "*.purs" | ||
50 | ] | ||
51 | |||
52 | type GraphModule = { file :: String, imports :: [String] } | ||
53 | |||
54 | type Graph = StrMap GraphModule | ||
55 | |||
56 | mkGraph :: forall eff. [String] -> Eff (fs :: FS | eff) Graph | ||
57 | mkGraph files = (fromList <<< catMaybes) <$> sequence (parse <$> files) | ||
58 | where parse file = do source <- readFileUtf8Sync file | ||
59 | let key = match moduleRegex source >>= (!!!) 1 | ||
60 | lines = split eol source | ||
61 | imports = catMaybes $ (\a -> match importRegex a >>= (!!!) 1) <$> lines | ||
62 | return $ (\a -> tuple2 a { file: file, imports: imports }) <$> key | ||
63 | |||
64 | mkDeps :: forall eff. String -> Graph -> [String] | ||
65 | mkDeps key graph = toList $ go empty key | ||
66 | where | ||
67 | go :: Set String -> String -> Set String | ||
68 | go acc key = | ||
69 | let node = fromMaybe {file: "", imports: []} (lookup key graph) | ||
70 | uniq = filter (not <<< flip member acc) node.imports | ||
71 | acc' = foldl (flip insert) acc node.imports | ||
72 | in if null uniq | ||
73 | then acc' | ||
74 | else unions $ go acc' <$> uniq | ||
75 | |||
76 | addDeps :: forall eff. LoaderRef -> Graph -> [String] -> Eff (loader :: Loader | eff) Unit | ||
77 | addDeps ref graph deps = const unit <$> (sequence $ add <$> deps) | ||
78 | where add dep = let res = lookup dep graph | ||
79 | path = (\a -> resolve a.file) <$> res | ||
80 | in maybe (pure unit) (addDependency ref) path | ||
81 | |||
82 | type LoaderAff eff a = Aff (loader :: Loader, glob :: Glob, cp :: ChildProcess, fs :: FS | eff) a | ||
83 | |||
84 | loader' :: forall eff. LoaderRef -> String -> LoaderAff eff (Maybe String) | ||
85 | loader' ref source = do | 31 | loader' ref source = do |
86 | liftEff $ cacheable ref | 32 | liftEff $ cacheable ref |
87 | 33 | ||
88 | let request = getRemainingRequest ref | 34 | let request = getRemainingRequest ref |
89 | parsed = parseQuery $ query ref | 35 | parsed = parseQuery $ query ref |
90 | srcs = loaderSrcOption parsed | 36 | srcs = fromMaybe [] (loaderSrcOption parsed) |
91 | opts = pscMakeOptions parsed | 37 | opts = pscOptions parsed |
92 | pattern = pursPattern $ fromMaybe [] srcs | 38 | moduleName = match moduleRegex source >>= (!!!) 1 |
93 | key = match moduleRegex source >>= (!!!) 1 | 39 | result = (\a -> "module.exports = require('" ++ a ++ "');") <$> moduleName |
94 | |||
95 | files <- glob pattern | ||
96 | graph <- liftEff $ mkGraph files | ||
97 | |||
98 | let deps = fromMaybe [] $ flip mkDeps graph <$> key | ||
99 | outputPath = fromMaybe pscMakeDefaultOutput $ pscMakeOutputOption parsed | ||
100 | indexPath = (\a -> join [ outputPath, a, indexFilename ]) <$> key | ||
101 | |||
102 | liftEff $ clearDependencies ref | ||
103 | liftEff $ addDependency ref (resourcePath ref) | ||
104 | liftEff $ addDeps ref graph deps | ||
105 | |||
106 | spawn pscMakeCommand (opts <> files) | ||
107 | indexFile <- sequence $ readFileUtf8 <$> indexPath | ||
108 | return indexFile | ||
109 | 40 | ||
110 | type LoaderEff eff a = Eff (loader :: Loader, glob :: Glob, cp :: ChildProcess, fs :: FS | eff) a | 41 | spawn pscCommand (srcs <> opts) |
42 | return result | ||
111 | 43 | ||
112 | loader :: forall eff. LoaderRef -> String -> LoaderEff eff Unit | 44 | loader :: forall eff. LoaderRef -> String -> Eff (Effects eff) Unit |
113 | loader ref source = do | 45 | loader ref source = do |
114 | callback <- async ref | 46 | callback <- async ref |
115 | runAff (\e -> callback (Just e) "") | 47 | runAff (\e -> callback (Just e) "") |
116 | (maybe (callback (Just $ error "Loader has failed to run") "") | 48 | (maybe (callback (Just (error "Loader has failed to run")) "") |
117 | (callback Nothing)) | 49 | (callback Nothing)) |
118 | (loader' ref source) | 50 | (loader' ref source) |
119 | 51 | ||
120 | loaderFn :: forall eff. Fn2 LoaderRef String (LoaderEff eff Unit) | 52 | loaderFn :: forall eff. Fn2 LoaderRef String (Eff (Effects eff) Unit) |
121 | loaderFn = mkFn2 loader | 53 | loaderFn = mkFn2 loader |