src/PursLoader/Loader.purs

   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