src/PursLoader/Loader.purs

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