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, filter, null)
  13 import Data.Foldable (foldl)
  14 import Data.Function (Fn2(), mkFn2)
  15 import Data.Maybe (Maybe(..), fromMaybe, maybe)
  16 import Data.Set (Set(), empty, insert, member, toList, unions)
  17 import Data.String (joinWith, split)
  18 import Data.String.Regex (Regex(), match, noFlags, regex)
  19 import Data.StrMap (StrMap(), fromList, lookup)
  20 import Data.Traversable (sequence)
  21 import Data.Tuple.Nested (tuple2)
  22
  23 import PursLoader.ChildProcess (ChildProcess(), spawn)
  24 import PursLoader.FS (FS(), readFileUtf8, readFileUtf8Sync)
  25 import PursLoader.Glob (Glob(), glob)
  26 import PursLoader.LoaderRef (LoaderRef(), Loader(), async, cacheable, clearDependencies, addDependency, query, resourcePath)
  27 import PursLoader.LoaderUtil (getRemainingRequest, parseQuery)
  28 import PursLoader.OS (eol)
  29 import PursLoader.Options (loaderSrcOption, pscMakeOptions, pscMakeDefaultOutput, pscMakeOutputOption)
  30 import PursLoader.Path (dirname, join, relative, resolve)
  31
  32 foreign import cwd "var cwd = process.cwd();" :: String
  33
  34 moduleRegex = regex "(?:^|\\n)module\\s+([\\w\\.]+)" noFlags { ignoreCase = true }
  35
  36 importRegex = regex "^\\s*import\\s+(?:qualified\\s+)?([\\w\\.]+)" noFlags { ignoreCase = true }
  37
  38 bowerPattern = join [ "bower_components", "purescript-*", "src" ]
  39
  40 pscMakeCommand = "psc-make"
  41
  42 indexFilename = "index.js"
  43
  44 (!!!) = flip (!!)
  45
  46 pursPattern :: [String] -> String
  47 pursPattern srcs = join [ "{" ++ joinWith "," ([ bowerPattern ] <> srcs) ++ "}"
  48                         , "**"
  49                         , "*.purs"
  50                         ]
  51
  52 type GraphModule = { file :: String, imports :: [String] }
  53
  54 type Graph = StrMap GraphModule
  55
  56 mkGraph :: forall eff. [String] -> Eff (fs :: FS | eff) Graph
  57 mkGraph files = (fromList <<< catMaybes) <$> sequence (parse <$> files)
  58   where parse file = do source <- readFileUtf8Sync file
  59                         let key = match moduleRegex source >>= (!!!) 1
  60                             lines = split eol source
  61                             imports = catMaybes $ (\a -> match importRegex a >>= (!!!) 1) <$> lines
  62                         return $ (\a -> tuple2 a { file: file, imports: imports }) <$> key
  63
  64 mkDeps :: forall eff. String -> Graph -> [String]
  65 mkDeps key graph = toList $ go empty key
  66   where
  67     go :: Set String -> String -> Set String
  68     go acc key =
  69       let node = fromMaybe {file: "", imports: []} (lookup key graph)
  70           uniq = filter (not <<< flip member acc) node.imports
  71           acc' = foldl (flip insert) acc node.imports
  72        in if null uniq
  73              then acc'
  74              else unions $ go acc' <$> uniq
  75
  76 addDeps :: forall eff. LoaderRef -> Graph -> [String] -> Eff (loader :: Loader | eff) Unit
  77 addDeps ref graph deps = const unit <$> (sequence $ add <$> deps)
  78   where add dep = let res = lookup dep graph
  79                       path = (\a -> resolve a.file) <$> res
  80                    in maybe (pure unit) (addDependency ref) path
  81
  82 type LoaderAff eff a = Aff (loader :: Loader, glob :: Glob, cp :: ChildProcess, fs :: FS | eff) a
  83
  84 loader' :: forall eff. LoaderRef -> String -> LoaderAff eff (Maybe String)
  85 loader' ref source = do
  86   liftEff $ cacheable ref
  87
  88   let request = getRemainingRequest ref
  89       parsed = parseQuery $ query ref
  90       srcs = loaderSrcOption parsed
  91       opts = pscMakeOptions parsed
  92       pattern = pursPattern $ fromMaybe [] srcs
  93       key = match moduleRegex source >>= (!!!) 1
  94
  95   files <- glob pattern
  96   graph <- liftEff $ mkGraph files
  97
  98   let deps = fromMaybe [] $ flip mkDeps graph <$> key
  99       outputPath = fromMaybe pscMakeDefaultOutput $ pscMakeOutputOption parsed
 100       indexPath = (\a -> join [ outputPath, a, indexFilename ]) <$> key
 101
 102   liftEff $ clearDependencies ref
 103   liftEff $ addDependency ref (resourcePath ref)
 104   liftEff $ addDeps ref graph deps
 105
 106   spawn pscMakeCommand (opts <> files)
 107   indexFile <- sequence $ readFileUtf8 <$> indexPath
 108   return indexFile
 109
 110 type LoaderEff eff a = Eff (loader :: Loader, glob :: Glob, cp :: ChildProcess, fs :: FS | eff) a
 111
 112 loader :: forall eff. LoaderRef -> String -> LoaderEff eff Unit
 113 loader ref source = do
 114   callback <- async ref
 115   runAff (\e -> callback (Just e) "")
 116          (maybe (callback (Just $ error "Loader has failed to run") "")
 117                 (callback Nothing))
 118          (loader' ref source)
 119
 120 loaderFn :: forall eff. Fn2 LoaderRef String (LoaderEff eff Unit)
 121 loaderFn = mkFn2 loader