diff options
Diffstat (limited to 'src/PursLoader/Loader.purs')
-rw-r--r-- | src/PursLoader/Loader.purs | 106 |
1 files changed, 106 insertions, 0 deletions
diff --git a/src/PursLoader/Loader.purs b/src/PursLoader/Loader.purs new file mode 100644 index 0000000..e9e03c4 --- /dev/null +++ b/src/PursLoader/Loader.purs | |||
@@ -0,0 +1,106 @@ | |||
1 | module PursLoader.Loader | ||
2 | ( Effects() | ||
3 | , loader | ||
4 | , loaderFn | ||
5 | ) where | ||
6 | |||
7 | import Control.Monad.Aff (Aff(), runAff) | ||
8 | import Control.Monad.Eff (Eff()) | ||
9 | import Control.Monad.Eff.Class (liftEff) | ||
10 | import Control.Monad.Eff.Exception (error) | ||
11 | |||
12 | import Data.Array ((!!), concat) | ||
13 | import Data.Function (Fn2(), mkFn2) | ||
14 | import Data.Maybe (Maybe(..), fromMaybe, maybe) | ||
15 | import Data.String (joinWith) | ||
16 | import Data.String.Regex (match, noFlags, regex, test) | ||
17 | |||
18 | import PursLoader.ChildProcess (ChildProcess(), spawn) | ||
19 | import PursLoader.FS (FS(), writeFileUtf8, findFileUtf8) | ||
20 | import PursLoader.Glob (Glob(), globAll) | ||
21 | import PursLoader.LoaderRef (LoaderRef(), Loader(), async, cacheable, query, clearDependencies, addDependency, resourcePath) | ||
22 | import PursLoader.LoaderUtil (parseQuery) | ||
23 | import PursLoader.Options (loaderFFIOption, loaderSrcOption, pscOptions) | ||
24 | |||
25 | type Effects eff = (cp :: ChildProcess, fs :: FS, glob :: Glob, loader :: Loader | eff) | ||
26 | |||
27 | moduleRegex = regex "(?:^|\\n)module\\s+([\\w\\.]+)" noFlags { ignoreCase = true } | ||
28 | |||
29 | foreignRegex = regex "(?:^|\\n)\\s*foreign import\\s+" noFlags { ignoreCase = true } | ||
30 | |||
31 | pscCommand = "psc" | ||
32 | |||
33 | psciCommand = "psci" | ||
34 | |||
35 | psciFilename = ".psci" | ||
36 | |||
37 | (!!!) = flip (!!) | ||
38 | |||
39 | foreign import cwd "var cwd = process.cwd();" :: String | ||
40 | |||
41 | foreign import relative """ | ||
42 | function relative(from) { | ||
43 | return function(to){ | ||
44 | var path = require('path'); | ||
45 | return path.relative(from, to); | ||
46 | }; | ||
47 | } | ||
48 | """ :: String -> String -> String | ||
49 | |||
50 | mkPsci :: [[String]] -> [[String]] -> String | ||
51 | mkPsci srcs ffis = joinWith "\n" ((loadModule <$> concat srcs) <> (loadForeign <$> concat ffis)) | ||
52 | where | ||
53 | loadModule :: String -> String | ||
54 | loadModule a = ":m " ++ relative cwd a | ||
55 | |||
56 | loadForeign :: String -> String | ||
57 | loadForeign a = ":f " ++ relative cwd a | ||
58 | |||
59 | findFFI :: forall eff. [[String]] -> String -> Aff (fs :: FS | eff) (Maybe String) | ||
60 | findFFI ffiss name = findFileUtf8 re (concat ffiss) | ||
61 | where | ||
62 | re = regex ("(?:^|\\n)//\\s*module\\s*" ++ name ++ "\\s*\\n") noFlags | ||
63 | |||
64 | loader' :: forall eff. LoaderRef -> String -> Aff (Effects eff) (Maybe String) | ||
65 | loader' ref source = do | ||
66 | liftEff $ cacheable ref | ||
67 | |||
68 | let parsed = parseQuery $ query ref | ||
69 | srcs = fromMaybe [] (loaderSrcOption parsed) | ||
70 | ffis = fromMaybe [] (loaderFFIOption parsed) | ||
71 | opts = pscOptions parsed | ||
72 | |||
73 | spawn pscCommand (srcs <> opts) | ||
74 | |||
75 | srcss <- globAll srcs | ||
76 | ffiss <- globAll ffis | ||
77 | |||
78 | let psciFile = mkPsci srcss ffiss | ||
79 | |||
80 | writeFileUtf8 psciFilename psciFile | ||
81 | |||
82 | let moduleName = match moduleRegex source >>= (!!!) 1 | ||
83 | hasForeign = test foreignRegex source | ||
84 | result = (\a -> "module.exports = require('" ++ a ++ "');") <$> moduleName | ||
85 | |||
86 | liftEff (clearDependencies ref) | ||
87 | liftEff (addDependency ref (resourcePath ref)) | ||
88 | |||
89 | foreignPath <- if hasForeign | ||
90 | then fromMaybe (pure Nothing) (findFFI ffiss <$> moduleName) | ||
91 | else pure Nothing | ||
92 | |||
93 | fromMaybe (pure unit) ((\path -> liftEff (addDependency ref path)) <$> foreignPath) | ||
94 | |||
95 | return result | ||
96 | |||
97 | loader :: forall eff. LoaderRef -> String -> Eff (Effects eff) Unit | ||
98 | loader ref source = do | ||
99 | callback <- async ref | ||
100 | runAff (\e -> callback (Just e) "") | ||
101 | (maybe (callback (Just (error "Loader has failed to run")) "") | ||
102 | (callback Nothing)) | ||
103 | (loader' ref source) | ||
104 | |||
105 | loaderFn :: forall eff. Fn2 LoaderRef String (Eff (Effects eff) Unit) | ||
106 | loaderFn = mkFn2 loader | ||