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