src/Loader.purs

   1 module PursLoader.Loader
   2   ( LoaderEff()
   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 ((!!), 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)
  20
  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)
  29
  30 foreign import cwd "var cwd = process.cwd();" :: String
  31
  32 moduleRegex = regex "(?:^|\\n)module\\s+([\\w\\.]+)" noFlags { ignoreCase = true }
  33
  34 importRegex = regex "^\\s*import\\s+(?:qualified\\s+)?([\\w\\.]+)" noFlags { ignoreCase = true }
  35
  36 bowerPattern = join [ "bower_components", "purescript-*", "src" ]
  37
  38 pscMakeCommand = "psc-make"
  39
  40 indexFilename = "index.js"
  41
  42 (!!!) = flip (!!)
  43
  44 pursPattern :: String -> String
  45 pursPattern root = join [ "{" ++ joinWith "," [ bowerPattern, root ] ++ "}"
  46                         , "**"
  47                         , "*.purs"
  48                         ]
  49
  50 type GraphModule = { file :: String, imports :: [String] }
  51
  52 type Graph = StrMap GraphModule
  53
  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
  61
  62 mkDeps :: forall eff. String -> Graph -> [String]
  63 mkDeps key graph = nub $ go [] key
  64   where go acc key =
  65     maybe acc (\a -> if null a.imports
  66                        then acc
  67                        else concat $ go (acc <> a.imports) <$> a.imports) (lookup key graph)
  68
  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
  74
  75 type LoaderAff eff a = Aff (loader :: Loader, glob :: Glob, cp :: ChildProcess, fs :: FS | eff) a
  76
  77 loader' :: forall eff. LoaderRef -> String -> LoaderAff eff (Maybe String)
  78 loader' ref source = do
  79   liftEff $ cacheable ref
  80
  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
  87
  88   files <- glob pattern
  89   graph <- liftEff $ mkGraph files
  90
  91   let deps = fromMaybe [] $ flip mkDeps graph <$> key
  92       outputPath = fromMaybe pscMakeDefaultOutput $ pscMakeOutputOption parsed
  93       indexPath = (\a -> join [ outputPath, a, indexFilename ]) <$> key
  94
  95   liftEff $ clearDependencies ref
  96   liftEff $ addDependency ref (resourcePath ref)
  97   liftEff $ addDeps ref graph deps
  98
  99   spawn pscMakeCommand (opts <> files)
 100   indexFile <- sequence $ readFileUtf8 <$> indexPath
 101   return indexFile
 102
 103 type LoaderEff eff a = Eff (loader :: Loader, glob :: Glob, cp :: ChildProcess, fs :: FS | eff) a
 104
 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") "")
 110                 (callback Nothing))
 111          (loader' ref source)
 112
 113 loaderFn :: forall eff. Fn2 LoaderRef String (LoaderEff eff Unit)
 114 loaderFn = mkFn2 loader