@@ -27,6 +27,7 @@ module Language.PureScript.Bundle (
2727 , ModuleType(..)
2828 , ErrorMessage(..)
2929 , printErrorMessage
30+ , getExportedIdentifiers
3031) where
3132
3233import Prelude ()
@@ -229,53 +230,20 @@ toModule requirePath mids mid top
229230 err = throwError . ErrorInModule mid
230231
231232 toModuleElement :: JSStatement -> m ModuleElement
232− -- var ModuleName = require("file");
233233 toModuleElement stmt
234− | JSVariable _ jsInit _ <- stmt
235− , [JSVarInitExpression var varInit] <- commaList jsInit
236− , JSIdentifier _ importName <- var
237− , JSVarInit _ jsInitEx <- varInit
238− , JSMemberExpression req _ argsE _ <- jsInitEx
239− , JSIdentifier _ "require" <- req
240− , [ Just importPath ] <- map fromStringLiteral (commaList argsE)
241− , importPath' <- checkImportPath requirePath importPath mid mids
242− = pure (Require stmt importName importPath')
243− -- var foo = expr;
244− toModuleElement stmt
245− | JSVariable _ jsInit _ <- stmt
246− , [JSVarInitExpression var varInit] <- commaList jsInit
247− , JSIdentifier _ name <- var
248− , JSVarInit _ decl <- varInit
249− = pure (Member stmt False name decl [])
250− -- exports.foo = expr; exports["foo"] = expr;
234+ | Just (importName, importPath) <- matchRequire requirePath mids mid stmt
235+ = pure (Require stmt importName importPath)
251236 toModuleElement stmt
252− | JSAssignStatement e (JSAssign _) decl _ <- stmt
253− , Just name <- accessor e
254− = pure (Member stmt True name decl [])
255− where
256− accessor :: JSExpression -> Maybe String
257− accessor (JSMemberDot exports _ nm)
258− | JSIdentifier _ "exports" <- exports
259− , JSIdentifier _ name <- nm
260− = Just name
261− accessor (JSMemberSquare exports _ nm _)
262− | JSIdentifier _ "exports" <- exports
263− , Just name <- fromStringLiteral nm
264− = Just name
265− accessor _ = Nothing
266− -- module.exports = { ... }
237+ | Just (exported, name, decl) <- matchMember stmt
238+ = pure (Member stmt exported name decl [])
267239 toModuleElement stmt
268− | JSAssignStatement e (JSAssign _) decl _ <- stmt
269− , JSMemberDot module' _ exports <- e
270− , JSIdentifier _ "module" <- module'
271− , JSIdentifier _ "exports" <- exports
272− , JSObjectLiteral _ props _ <- decl
240+ | Just props <- matchExportsAssignment stmt
273241 = (ExportsList <$> traverse toExport (trailingCommaList props))
274242 where
275243 toExport :: JSObjectProperty -> m (ExportType, String, JSExpression, [Key])
276244 toExport (JSPropertyNameandValue name _ [val]) =
277245 (,,val,[]) <$> exportType val
278− <*> extractLabel name
246+ <*> extractLabel' name
279247 toExport _ = err UnsupportedExport
280248
281249 exportType :: JSExpression -> m ExportType
@@ -287,14 +255,105 @@ toModule requirePath mids mid top
287255 = pure ForeignReexport
288256 exportType (JSIdentifier _ s) = pure (RegularExport s)
289257 exportType _ = err UnsupportedExport
290−--
291− extractLabel :: JSPropertyName -> m String
292− extractLabel (JSPropertyString _ nm) = pure (trimStringQuotes nm)
293− extractLabel (JSPropertyIdent _ nm) = pure nm
294− extractLabel _ = err UnsupportedExport
258+
259+ extractLabel' = maybe (err UnsupportedExport) pure . extractLabel
295260
296261 toModuleElement other = pure (Other other)
297262
263+-- Get a list of all the exported identifiers from a foreign module.
264+--
265+-- TODO: what if we assign to exports.foo and then later assign to
266+-- module.exports (presumably overwriting exports.foo)?
267+getExportedIdentifiers :: (MonadError ErrorMessage m)
268+ => String
269+ -> JSAST
270+ -> m [String]
271+getExportedIdentifiers mname top
272+ | JSAstProgram stmts _ <- top = concat <$> traverse go stmts
273+ | otherwise = err InvalidTopLevel
274+ where
275+ err = throwError . ErrorInModule (ModuleIdentifier mname Foreign)
276+
277+ go stmt
278+ | Just props <- matchExportsAssignment stmt
279+ = traverse toIdent (trailingCommaList props)
280+ | Just (True, name, _) <- matchMember stmt
281+ = pure [name]
282+ | otherwise
283+ = pure []
284+
285+ toIdent (JSPropertyNameandValue name _ [_]) =
286+ extractLabel' name
287+ toIdent _ =
288+ err UnsupportedExport
289+
290+ extractLabel' = maybe (err UnsupportedExport) pure . extractLabel
291+
292+-- Matches JS statements like this:
293+-- var ModuleName = require("file");
294+matchRequire :: Maybe FilePath
295+ -> S.Set String
296+ -> ModuleIdentifier
297+ -> JSStatement
298+ -> Maybe (String, Either String ModuleIdentifier)
299+matchRequire requirePath mids mid stmt
300+ | JSVariable _ jsInit _ <- stmt
301+ , [JSVarInitExpression var varInit] <- commaList jsInit
302+ , JSIdentifier _ importName <- var
303+ , JSVarInit _ jsInitEx <- varInit
304+ , JSMemberExpression req _ argsE _ <- jsInitEx
305+ , JSIdentifier _ "require" <- req
306+ , [ Just importPath ] <- map fromStringLiteral (commaList argsE)
307+ , importPath' <- checkImportPath requirePath importPath mid mids
308+ = Just (importName, importPath')
309+ | otherwise
310+ = Nothing
311+
312+-- Matches JS member declarations.
313+matchMember :: JSStatement -> Maybe (Bool, String, JSExpression)
314+matchMember stmt
315+ -- var foo = expr;
316+ | JSVariable _ jsInit _ <- stmt
317+ , [JSVarInitExpression var varInit] <- commaList jsInit
318+ , JSIdentifier _ name <- var
319+ , JSVarInit _ decl <- varInit
320+ = Just (False, name, decl)
321+ -- exports.foo = expr; exports["foo"] = expr;
322+ | JSAssignStatement e (JSAssign _) decl _ <- stmt
323+ , Just name <- accessor e
324+ = Just (True, name, decl)
325+ | otherwise
326+ = Nothing
327+ where
328+ accessor :: JSExpression -> Maybe String
329+ accessor (JSMemberDot exports _ nm)
330+ | JSIdentifier _ "exports" <- exports
331+ , JSIdentifier _ name <- nm
332+ = Just name
333+ accessor (JSMemberSquare exports _ nm _)
334+ | JSIdentifier _ "exports" <- exports
335+ , Just name <- fromStringLiteral nm
336+ = Just name
337+ accessor _ = Nothing
338+
339+-- Matches assignments to module.exports, like this:
340+-- module.exports = { ... }
341+matchExportsAssignment :: JSStatement -> Maybe JSObjectPropertyList
342+matchExportsAssignment stmt
343+ | JSAssignStatement e (JSAssign _) decl _ <- stmt
344+ , JSMemberDot module' _ exports <- e
345+ , JSIdentifier _ "module" <- module'
346+ , JSIdentifier _ "exports" <- exports
347+ , JSObjectLiteral _ props _ <- decl
348+ = Just props
349+ | otherwise
350+ = Nothing
351+
352+extractLabel :: JSPropertyName -> Maybe String
353+extractLabel (JSPropertyString _ nm) = Just (trimStringQuotes nm)
354+extractLabel (JSPropertyIdent _ nm) = Just nm
355+extractLabel _ = Nothing
356+
298357-- | Eliminate unused code based on the specified entry point set.
299358compile :: [Module] -> [ModuleIdentifier] -> [Module]
300359compile modules [] = modules