1 module PursLoader.Loader
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)
12 import Data.Array ((!!), catMaybes, concat, nub, null)
13 import Data.Function (Fn2(), mkFn2)
14 import Data.Maybe (Maybe(..), fromMaybe, maybe)
15 import Data.String (joinWith, split)
16 import Data.String.Regex (Regex(), match, noFlags, regex)
17 import Data.StrMap (StrMap(), fromList, lookup)
18 import Data.Traversable (sequence)
19 import Data.Tuple.Nested (tuple2)
21 import PursLoader.ChildProcess (ChildProcess(), spawn)
22 import PursLoader.FS (FS(), readFileUtf8, readFileUtf8Sync)
23 import PursLoader.Glob (Glob(), glob)
24 import PursLoader.LoaderRef (LoaderRef(), Loader(), async, cacheable, clearDependencies, addDependency, query, resourcePath)
25 import PursLoader.LoaderUtil (getRemainingRequest, parseQuery)
26 import PursLoader.OS (eol)
27 import PursLoader.Options (pscMakeOptions, pscMakeDefaultOutput, pscMakeOutputOption)
28 import PursLoader.Path (dirname, join, relative, resolve)
30 foreign import cwd "var cwd = process.cwd();" :: String
32 moduleRegex = regex "(?:^|\\n)module\\s+([\\w\\.]+)" noFlags { ignoreCase = true }
34 importRegex = regex "^\\s*import\\s+(?:qualified\\s+)?([\\w\\.]+)" noFlags { ignoreCase = true }
36 bowerPattern = join [ "bower_components", "purescript-*", "src" ]
38 pscMakeCommand = "psc-make"
40 indexFilename = "index.js"
44 pursPattern :: String -> String
45 pursPattern root = join [ "{" ++ joinWith "," [ bowerPattern, root ] ++ "}"
50 type GraphModule = { file :: String, imports :: [String] }
52 type Graph = StrMap GraphModule
54 mkGraph :: forall eff. [String] -> Eff (fs :: FS | eff) Graph
55 mkGraph files = (fromList <<< catMaybes) <$> sequence (parse <$> files)
56 where parse file = do source <- readFileUtf8Sync file
57 let key = match moduleRegex source >>= (!!!) 1
58 lines = split eol source
59 imports = catMaybes $ (\a -> match importRegex a >>= (!!!) 1) <$> lines
60 return $ (\a -> tuple2 a { file: file, imports: imports }) <$> key
62 mkDeps :: forall eff. String -> Graph -> [String]
63 mkDeps key graph = nub $ go [] key
65 maybe acc (\a -> if null a.imports
67 else concat $ go (acc <> a.imports) <$> a.imports) (lookup key graph)
69 addDeps :: forall eff. LoaderRef -> Graph -> [String] -> Eff (loader :: Loader | eff) Unit
70 addDeps ref graph deps = const unit <$> (sequence $ add <$> deps)
71 where add dep = let res = lookup dep graph
72 path = (\a -> resolve a.file) <$> res
73 in maybe (pure unit) (addDependency ref) path
75 type LoaderAff eff a = Aff (loader :: Loader, glob :: Glob, cp :: ChildProcess, fs :: FS | eff) a
77 loader' :: forall eff. LoaderRef -> String -> LoaderAff eff (Maybe String)
78 loader' ref source = do
79 liftEff $ cacheable ref
81 let request = getRemainingRequest ref
82 root = dirname $ relative cwd request
83 parsed = parseQuery $ query ref
84 opts = pscMakeOptions parsed
85 pattern = pursPattern root
86 key = match moduleRegex source >>= (!!!) 1
89 graph <- liftEff $ mkGraph files
91 let deps = fromMaybe [] $ flip mkDeps graph <$> key
92 outputPath = fromMaybe pscMakeDefaultOutput $ pscMakeOutputOption parsed
93 indexPath = (\a -> join [ outputPath, a, indexFilename ]) <$> key
95 liftEff $ clearDependencies ref
96 liftEff $ addDependency ref (resourcePath ref)
97 liftEff $ addDeps ref graph deps
99 spawn pscMakeCommand (opts <> files)
100 indexFile <- sequence $ readFileUtf8 <$> indexPath
103 type LoaderEff eff a = Eff (loader :: Loader, glob :: Glob, cp :: ChildProcess, fs :: FS | eff) a
105 loader :: forall eff. LoaderRef -> String -> LoaderEff eff Unit
106 loader ref source = do
107 callback <- async ref
108 runAff (\e -> callback (Just e) "")
109 (maybe (callback (Just $ error "Loader has failed to run") "")
113 loaderFn :: forall eff. Fn2 LoaderRef String (LoaderEff eff Unit)
114 loaderFn = mkFn2 loader