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