diff options
Diffstat (limited to 'src/Loader.purs')
-rw-r--r-- | src/Loader.purs | 126 |
1 files changed, 47 insertions, 79 deletions
diff --git a/src/Loader.purs b/src/Loader.purs index fedc424..872a51c 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,81 @@ 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 ((!!), concat) |
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 (joinWith) |
17 | import Data.String (joinWith, split) | 16 | import Data.String.Regex (match, noFlags, regex) |
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 | 17 | ||
23 | import PursLoader.ChildProcess (ChildProcess(), spawn) | 18 | import PursLoader.ChildProcess (ChildProcess(), spawn) |
24 | import PursLoader.FS (FS(), readFileUtf8, readFileUtf8Sync) | 19 | import PursLoader.FS (FS(), writeFileUtf8) |
25 | import PursLoader.Glob (Glob(), glob) | 20 | import PursLoader.Glob (Glob(), globAll) |
26 | import PursLoader.LoaderRef (LoaderRef(), Loader(), async, cacheable, clearDependencies, addDependency, query, resourcePath) | 21 | import PursLoader.LoaderRef (LoaderRef(), Loader(), async, cacheable, query) |
27 | import PursLoader.LoaderUtil (getRemainingRequest, parseQuery) | 22 | import PursLoader.LoaderUtil (parseQuery) |
28 | import PursLoader.OS (eol) | 23 | import PursLoader.Options (loaderFFIOption, loaderSrcOption, pscOptions) |
29 | import PursLoader.Options (loaderSrcOption, pscMakeOptions, pscMakeDefaultOutput, pscMakeOutputOption) | ||
30 | import PursLoader.Path (dirname, join, relative, resolve) | ||
31 | 24 | ||
32 | foreign import cwd "var cwd = process.cwd();" :: String | 25 | type Effects eff = (cp :: ChildProcess, fs :: FS, glob :: Glob, loader :: Loader | eff) |
33 | 26 | ||
34 | moduleRegex = regex "(?:^|\\n)module\\s+([\\w\\.]+)" noFlags { ignoreCase = true } | 27 | moduleRegex = regex "(?:^|\\n)module\\s+([\\w\\.]+)" noFlags { ignoreCase = true } |
35 | 28 | ||
36 | importRegex = regex "^\\s*import\\s+(?:qualified\\s+)?([\\w\\.]+)" noFlags { ignoreCase = true } | 29 | pscCommand = "psc" |
37 | |||
38 | bowerPattern = join [ "bower_components", "purescript-*", "src" ] | ||
39 | 30 | ||
40 | pscMakeCommand = "psc-make" | 31 | psciCommand = "psci" |
41 | 32 | ||
42 | indexFilename = "index.js" | 33 | psciFilename = ".psci" |
43 | 34 | ||
44 | (!!!) = flip (!!) | 35 | (!!!) = flip (!!) |
45 | 36 | ||
46 | pursPattern :: [String] -> String | 37 | foreign import cwd "var cwd = process.cwd();" :: String |
47 | pursPattern srcs = join [ "{" ++ joinWith "," ([ bowerPattern ] <> srcs) ++ "}" | ||
48 | , "**" | ||
49 | , "*.purs" | ||
50 | ] | ||
51 | |||
52 | type GraphModule = { file :: String, imports :: [String] } | ||
53 | 38 | ||
54 | type Graph = StrMap GraphModule | 39 | foreign import relative """ |
40 | function relative(from) { | ||
41 | return function(to){ | ||
42 | var path = require('path'); | ||
43 | return path.relative(from, to); | ||
44 | }; | ||
45 | } | ||
46 | """ :: String -> String -> String | ||
47 | |||
48 | mkPsci :: [[String]] -> [[String]] -> String | ||
49 | mkPsci srcs ffis = joinWith "\n" ((loadModule <$> concat srcs) <> (loadForeign <$> concat ffis)) | ||
50 | where | ||
51 | loadModule :: String -> String | ||
52 | loadModule a = ":m " ++ relative cwd a | ||
55 | 53 | ||
56 | mkGraph :: forall eff. [String] -> Eff (fs :: FS | eff) Graph | 54 | loadForeign :: String -> String |
57 | mkGraph files = (fromList <<< catMaybes) <$> sequence (parse <$> files) | 55 | loadForeign a = ":f " ++ relative cwd a |
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 | 56 | ||
64 | mkDeps :: forall eff. String -> Graph -> [String] | 57 | loader' :: forall eff. LoaderRef -> String -> Aff (Effects eff) (Maybe 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 | 58 | loader' ref source = do |
86 | liftEff $ cacheable ref | 59 | liftEff $ cacheable ref |
87 | 60 | ||
88 | let request = getRemainingRequest ref | 61 | let parsed = parseQuery $ query ref |
89 | parsed = parseQuery $ query ref | 62 | srcs = fromMaybe [] (loaderSrcOption parsed) |
90 | srcs = loaderSrcOption parsed | 63 | ffis = fromMaybe [] (loaderFFIOption parsed) |
91 | opts = pscMakeOptions parsed | 64 | opts = pscOptions parsed |
92 | pattern = pursPattern $ fromMaybe [] srcs | 65 | |
93 | key = match moduleRegex source >>= (!!!) 1 | 66 | spawn pscCommand (srcs <> opts) |
94 | 67 | ||
95 | files <- glob pattern | 68 | srcss <- globAll srcs |
96 | graph <- liftEff $ mkGraph files | 69 | ffiss <- globAll ffis |
97 | 70 | ||
98 | let deps = fromMaybe [] $ flip mkDeps graph <$> key | 71 | let psciFile = mkPsci srcss ffiss |
99 | outputPath = fromMaybe pscMakeDefaultOutput $ pscMakeOutputOption parsed | ||
100 | indexPath = (\a -> join [ outputPath, a, indexFilename ]) <$> key | ||
101 | 72 | ||
102 | liftEff $ clearDependencies ref | 73 | writeFileUtf8 psciFilename psciFile |
103 | liftEff $ addDependency ref (resourcePath ref) | ||
104 | liftEff $ addDeps ref graph deps | ||
105 | 74 | ||
106 | spawn pscMakeCommand (opts <> files) | 75 | let moduleName = match moduleRegex source >>= (!!!) 1 |
107 | indexFile <- sequence $ readFileUtf8 <$> indexPath | 76 | result = (\a -> "module.exports = require('" ++ a ++ "');") <$> moduleName |
108 | return indexFile | ||
109 | 77 | ||
110 | type LoaderEff eff a = Eff (loader :: Loader, glob :: Glob, cp :: ChildProcess, fs :: FS | eff) a | 78 | return result |
111 | 79 | ||
112 | loader :: forall eff. LoaderRef -> String -> LoaderEff eff Unit | 80 | loader :: forall eff. LoaderRef -> String -> Eff (Effects eff) Unit |
113 | loader ref source = do | 81 | loader ref source = do |
114 | callback <- async ref | 82 | callback <- async ref |
115 | runAff (\e -> callback (Just e) "") | 83 | runAff (\e -> callback (Just e) "") |
116 | (maybe (callback (Just $ error "Loader has failed to run") "") | 84 | (maybe (callback (Just (error "Loader has failed to run")) "") |
117 | (callback Nothing)) | 85 | (callback Nothing)) |
118 | (loader' ref source) | 86 | (loader' ref source) |
119 | 87 | ||
120 | loaderFn :: forall eff. Fn2 LoaderRef String (LoaderEff eff Unit) | 88 | loaderFn :: forall eff. Fn2 LoaderRef String (Eff (Effects eff) Unit) |
121 | loaderFn = mkFn2 loader | 89 | loaderFn = mkFn2 loader |