-- |
-- Bundles compiled PureScript modules for the browser.
--
-- This module takes as input the individual generated modules from 'Language.PureScript.Make' and
-- performs dead code elimination, filters empty modules,
-- and generates the final JavaScript bundle.
module Language.PureScript.Bundle
  ( ModuleIdentifier(..)
  , ModuleType(..)
  , ErrorMessage(..)
  , printErrorMessage
  , ForeignModuleExports(..)
  , getExportedIdentifiers
  , ForeignModuleImports(..)
  , getImportedModules
  , Module
  ) where

import Prelude

import Control.Monad.Error.Class

import Data.Aeson ((.=))
import Data.Char (chr, digitToInt)
import Data.Foldable (fold)
import Data.Maybe (mapMaybe, maybeToList)
import qualified Data.Aeson as A
import qualified Data.Text.Lazy as LT

import Language.JavaScript.Parser
import Language.JavaScript.Parser.AST
import Language.JavaScript.Process.Minify

-- | The type of error messages. We separate generation and rendering of errors using a data
-- type, in case we need to match on error types later.
data ErrorMessage
  = UnsupportedModulePath String
  | InvalidTopLevel
  | UnableToParseModule String
  | UnsupportedImport
  | UnsupportedExport
  | ErrorInModule ModuleIdentifier ErrorMessage
  | MissingEntryPoint String
  | MissingMainModule String
  deriving (Int -> ErrorMessage -> ShowS
[ErrorMessage] -> ShowS
ErrorMessage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorMessage] -> ShowS
$cshowList :: [ErrorMessage] -> ShowS
show :: ErrorMessage -> String
$cshow :: ErrorMessage -> String
showsPrec :: Int -> ErrorMessage -> ShowS
$cshowsPrec :: Int -> ErrorMessage -> ShowS
Show)

-- | Modules are either "regular modules" (i.e. those generated by the PureScript compiler) or
-- foreign modules.
data ModuleType
  = Regular
  | Foreign
  deriving (Int -> ModuleType -> ShowS
[ModuleType] -> ShowS
ModuleType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModuleType] -> ShowS
$cshowList :: [ModuleType] -> ShowS
show :: ModuleType -> String
$cshow :: ModuleType -> String
showsPrec :: Int -> ModuleType -> ShowS
$cshowsPrec :: Int -> ModuleType -> ShowS
Show, ModuleType -> ModuleType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleType -> ModuleType -> Bool
$c/= :: ModuleType -> ModuleType -> Bool
== :: ModuleType -> ModuleType -> Bool
$c== :: ModuleType -> ModuleType -> Bool
Eq, Eq ModuleType
ModuleType -> ModuleType -> Bool
ModuleType -> ModuleType -> Ordering
ModuleType -> ModuleType -> ModuleType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ModuleType -> ModuleType -> ModuleType
$cmin :: ModuleType -> ModuleType -> ModuleType
max :: ModuleType -> ModuleType -> ModuleType
$cmax :: ModuleType -> ModuleType -> ModuleType
>= :: ModuleType -> ModuleType -> Bool
$c>= :: ModuleType -> ModuleType -> Bool
> :: ModuleType -> ModuleType -> Bool
$c> :: ModuleType -> ModuleType -> Bool
<= :: ModuleType -> ModuleType -> Bool
$c<= :: ModuleType -> ModuleType -> Bool
< :: ModuleType -> ModuleType -> Bool
$c< :: ModuleType -> ModuleType -> Bool
compare :: ModuleType -> ModuleType -> Ordering
$ccompare :: ModuleType -> ModuleType -> Ordering
Ord)

showModuleType :: ModuleType -> String
showModuleType :: ModuleType -> String
showModuleType ModuleType
Regular = String
"Regular"
showModuleType ModuleType
Foreign = String
"Foreign"

-- | A module is identified by its module name and its type.
data ModuleIdentifier = ModuleIdentifier String ModuleType deriving (Int -> ModuleIdentifier -> ShowS
[ModuleIdentifier] -> ShowS
ModuleIdentifier -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModuleIdentifier] -> ShowS
$cshowList :: [ModuleIdentifier] -> ShowS
show :: ModuleIdentifier -> String
$cshow :: ModuleIdentifier -> String
showsPrec :: Int -> ModuleIdentifier -> ShowS
$cshowsPrec :: Int -> ModuleIdentifier -> ShowS
Show, ModuleIdentifier -> ModuleIdentifier -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleIdentifier -> ModuleIdentifier -> Bool
$c/= :: ModuleIdentifier -> ModuleIdentifier -> Bool
== :: ModuleIdentifier -> ModuleIdentifier -> Bool
$c== :: ModuleIdentifier -> ModuleIdentifier -> Bool
Eq, Eq ModuleIdentifier
ModuleIdentifier -> ModuleIdentifier -> Bool
ModuleIdentifier -> ModuleIdentifier -> Ordering
ModuleIdentifier -> ModuleIdentifier -> ModuleIdentifier
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ModuleIdentifier -> ModuleIdentifier -> ModuleIdentifier
$cmin :: ModuleIdentifier -> ModuleIdentifier -> ModuleIdentifier
max :: ModuleIdentifier -> ModuleIdentifier -> ModuleIdentifier
$cmax :: ModuleIdentifier -> ModuleIdentifier -> ModuleIdentifier
>= :: ModuleIdentifier -> ModuleIdentifier -> Bool
$c>= :: ModuleIdentifier -> ModuleIdentifier -> Bool
> :: ModuleIdentifier -> ModuleIdentifier -> Bool
$c> :: ModuleIdentifier -> ModuleIdentifier -> Bool
<= :: ModuleIdentifier -> ModuleIdentifier -> Bool
$c<= :: ModuleIdentifier -> ModuleIdentifier -> Bool
< :: ModuleIdentifier -> ModuleIdentifier -> Bool
$c< :: ModuleIdentifier -> ModuleIdentifier -> Bool
compare :: ModuleIdentifier -> ModuleIdentifier -> Ordering
$ccompare :: ModuleIdentifier -> ModuleIdentifier -> Ordering
Ord)

instance A.ToJSON ModuleIdentifier where
  toJSON :: ModuleIdentifier -> Value
toJSON (ModuleIdentifier String
name ModuleType
mt) =
    [Pair] -> Value
A.object [ Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
name
             , Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. Show a => a -> String
show ModuleType
mt
             ]

data Visibility
  = Public
  | Internal
  deriving (Int -> Visibility -> ShowS
[Visibility] -> ShowS
Visibility -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Visibility] -> ShowS
$cshowList :: [Visibility] -> ShowS
show :: Visibility -> String
$cshow :: Visibility -> String
showsPrec :: Int -> Visibility -> ShowS
$cshowsPrec :: Int -> Visibility -> ShowS
Show, Visibility -> Visibility -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Visibility -> Visibility -> Bool
$c/= :: Visibility -> Visibility -> Bool
== :: Visibility -> Visibility -> Bool
$c== :: Visibility -> Visibility -> Bool
Eq, Eq Visibility
Visibility -> Visibility -> Bool
Visibility -> Visibility -> Ordering
Visibility -> Visibility -> Visibility
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Visibility -> Visibility -> Visibility
$cmin :: Visibility -> Visibility -> Visibility
max :: Visibility -> Visibility -> Visibility
$cmax :: Visibility -> Visibility -> Visibility
>= :: Visibility -> Visibility -> Bool
$c>= :: Visibility -> Visibility -> Bool
> :: Visibility -> Visibility -> Bool
$c> :: Visibility -> Visibility -> Bool
<= :: Visibility -> Visibility -> Bool
$c<= :: Visibility -> Visibility -> Bool
< :: Visibility -> Visibility -> Bool
$c< :: Visibility -> Visibility -> Bool
compare :: Visibility -> Visibility -> Ordering
$ccompare :: Visibility -> Visibility -> Ordering
Ord)

-- | A piece of code is identified by its module, its name, and whether it is an internal variable
-- or a public member. These keys are used to label vertices in the dependency graph.
type Key = (ModuleIdentifier, String, Visibility)

-- | An export is either a "regular export", which exports a name from the regular module we are in,
-- or a reexport of a declaration in the corresponding foreign module.
--
-- Regular exports are labelled, since they might re-export an operator with another name.
data ExportType
  = RegularExport String
  | ForeignReexport
  deriving (Int -> ExportType -> ShowS
[ExportType] -> ShowS
ExportType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportType] -> ShowS
$cshowList :: [ExportType] -> ShowS
show :: ExportType -> String
$cshow :: ExportType -> String
showsPrec :: Int -> ExportType -> ShowS
$cshowsPrec :: Int -> ExportType -> ShowS
Show, ExportType -> ExportType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportType -> ExportType -> Bool
$c/= :: ExportType -> ExportType -> Bool
== :: ExportType -> ExportType -> Bool
$c== :: ExportType -> ExportType -> Bool
Eq, Eq ExportType
ExportType -> ExportType -> Bool
ExportType -> ExportType -> Ordering
ExportType -> ExportType -> ExportType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ExportType -> ExportType -> ExportType
$cmin :: ExportType -> ExportType -> ExportType
max :: ExportType -> ExportType -> ExportType
$cmax :: ExportType -> ExportType -> ExportType
>= :: ExportType -> ExportType -> Bool
$c>= :: ExportType -> ExportType -> Bool
> :: ExportType -> ExportType -> Bool
$c> :: ExportType -> ExportType -> Bool
<= :: ExportType -> ExportType -> Bool
$c<= :: ExportType -> ExportType -> Bool
< :: ExportType -> ExportType -> Bool
$c< :: ExportType -> ExportType -> Bool
compare :: ExportType -> ExportType -> Ordering
$ccompare :: ExportType -> ExportType -> Ordering
Ord)

-- | There are four types of module element we are interested in:
--
-- 1) Import declarations and require statements
-- 2) Member declarations
-- 3) Export lists
-- 4) Everything else
--
-- Each is labelled with the original AST node which generated it, so that we can dump it back
-- into the output during codegen.
data ModuleElement
  = Import JSModuleItem String (Either String ModuleIdentifier)
  | Member JSStatement Visibility String JSExpression [Key]
  | ExportsList [(ExportType, String, JSExpression, [Key])]
  | Other JSStatement
  | Skip JSModuleItem
  deriving (Int -> ModuleElement -> ShowS
[ModuleElement] -> ShowS
ModuleElement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModuleElement] -> ShowS
$cshowList :: [ModuleElement] -> ShowS
show :: ModuleElement -> String
$cshow :: ModuleElement -> String
showsPrec :: Int -> ModuleElement -> ShowS
$cshowsPrec :: Int -> ModuleElement -> ShowS
Show)

instance A.ToJSON ModuleElement where
  toJSON :: ModuleElement -> Value
toJSON = \case
    (Import JSModuleItem
_ String
name (Right ModuleIdentifier
target)) ->
      [Pair] -> Value
A.object [ Key
"type"   forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
A.String Text
"Import"
               , Key
"name"   forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
name
               , Key
"target" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ModuleIdentifier
target
               ]
    (Import JSModuleItem
_ String
name (Left String
targetPath)) ->
      [Pair] -> Value
A.object [ Key
"type"       forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
A.String Text
"Import"
               , Key
"name"       forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
name
               , Key
"targetPath" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
targetPath
               ]
    (Member JSStatement
_ Visibility
visibility String
name JSExpression
_ [Key]
dependsOn) ->
      [Pair] -> Value
A.object [ Key
"type"       forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
A.String Text
"Member"
               , Key
"name"       forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
name
               , Key
"visibility" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. Show a => a -> String
show Visibility
visibility
               , Key
"dependsOn"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. (a -> b) -> [a] -> [b]
map forall {v} {v} {a}.
(ToJSON v, ToJSON v, Show a) =>
(v, v, a) -> Value
keyToJSON [Key]
dependsOn
               ]
    (ExportsList [(ExportType, String, JSExpression, [Key])]
exports) ->
      [Pair] -> Value
A.object [ Key
"type"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
A.String Text
"ExportsList"
               , Key
"exports" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. (a -> b) -> [a] -> [b]
map forall {v} {v} {v} {a} {c}.
(ToJSON v, ToJSON v, ToJSON v, Show a) =>
(ExportType, v, c, [(v, v, a)]) -> Value
exportToJSON [(ExportType, String, JSExpression, [Key])]
exports
               ]
    (Other JSStatement
stmt) ->
      [Pair] -> Value
A.object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
A.String Text
"Other"
               , Key
"js"   forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= JSAST -> Text
getFragment (JSStatement -> JSAnnot -> JSAST
JSAstStatement JSStatement
stmt JSAnnot
JSNoAnnot)
               ]
    (Skip JSModuleItem
item) ->
      [Pair] -> Value
A.object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
A.String Text
"Skip"
               , Key
"js"   forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= JSAST -> Text
getFragment ([JSModuleItem] -> JSAnnot -> JSAST
JSAstModule [JSModuleItem
item] JSAnnot
JSNoAnnot)
               ]

    where

    keyToJSON :: (v, v, a) -> Value
keyToJSON (v
mid, v
member, a
visibility) =
      [Pair] -> Value
A.object [ Key
"module"     forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
mid
               , Key
"member"     forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
member
               , Key
"visibility" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. Show a => a -> String
show a
visibility
               ]

    exportToJSON :: (ExportType, v, c, [(v, v, a)]) -> Value
exportToJSON (RegularExport String
sourceName, v
name, c
_, [(v, v, a)]
dependsOn) =
      [Pair] -> Value
A.object [ Key
"type"       forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
A.String Text
"RegularExport"
               , Key
"name"       forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
name
               , Key
"sourceName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
sourceName
               , Key
"dependsOn"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. (a -> b) -> [a] -> [b]
map forall {v} {v} {a}.
(ToJSON v, ToJSON v, Show a) =>
(v, v, a) -> Value
keyToJSON [(v, v, a)]
dependsOn
               ]
    exportToJSON (ExportType
ForeignReexport, v
name, c
_, [(v, v, a)]
dependsOn) =
      [Pair] -> Value
A.object [ Key
"type"      forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
A.String Text
"ForeignReexport"
               , Key
"name"      forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
name
               , Key
"dependsOn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. (a -> b) -> [a] -> [b]
map forall {v} {v} {a}.
(ToJSON v, ToJSON v, Show a) =>
(v, v, a) -> Value
keyToJSON [(v, v, a)]
dependsOn
               ]

    getFragment :: JSAST -> Text
getFragment = Text -> Text
ellipsize forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSAST -> Text
renderToText forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSAST -> JSAST
minifyJS
      where
      ellipsize :: Text -> Text
ellipsize Text
text = if Text -> Int64 -> Ordering
LT.compareLength Text
text Int64
20 forall a. Eq a => a -> a -> Bool
== Ordering
GT then Int64 -> Text -> Text
LT.take Int64
19 Text
text Text -> Char -> Text
`LT.snoc` Char
ellipsis else Text
text
      ellipsis :: Char
ellipsis = Char
'\x2026'

-- | A module is just a list of elements of the types listed above.
data Module = Module ModuleIdentifier (Maybe FilePath) [ModuleElement] deriving (Int -> Module -> ShowS
[Module] -> ShowS
Module -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Module] -> ShowS
$cshowList :: [Module] -> ShowS
show :: Module -> String
$cshow :: Module -> String
showsPrec :: Int -> Module -> ShowS
$cshowsPrec :: Int -> Module -> ShowS
Show)

instance A.ToJSON Module where
  toJSON :: Module -> Value
toJSON (Module ModuleIdentifier
moduleId Maybe String
filePath [ModuleElement]
elements) =
    [Pair] -> Value
A.object [ Key
"moduleId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ModuleIdentifier
moduleId
             , Key
"filePath" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
filePath
             , Key
"elements" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [ModuleElement]
elements
             ]

-- | Prepare an error message for consumption by humans.
printErrorMessage :: ErrorMessage -> [String]
printErrorMessage :: ErrorMessage -> [String]
printErrorMessage (UnsupportedModulePath String
s) =
  [ String
"An ES or CommonJS module has an unsupported name (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
s forall a. [a] -> [a] -> [a]
++ String
")."
  , String
"The following file names are supported:"
  , String
"  1) index.js (PureScript native modules)"
  , String
"  2) foreign.js (PureScript ES foreign modules)"
  , String
"  3) foreign.cjs (PureScript CommonJS foreign modules)"
  ]
printErrorMessage ErrorMessage
InvalidTopLevel =
  [ String
"Expected a list of source elements at the top level." ]
printErrorMessage (UnableToParseModule String
err) =
  [ String
"The module could not be parsed:"
  , String
err
  ]
printErrorMessage ErrorMessage
UnsupportedImport =
  [ String
"An import was unsupported."
  , String
"Modules can be imported with ES namespace imports declarations:"
  , String
"  import * as module from \"Module.Name\""
  , String
"Alternatively, they can be also be imported with the CommonJS require function:"
  , String
"  var module = require(\"Module.Name\")"
  ]
printErrorMessage ErrorMessage
UnsupportedExport =
  [ String
"An export was unsupported."
  , String
"Declarations can be exported as ES named exports:"
  , String
"  export var decl"
  , String
"Existing identifiers can be exported as well:"
  , String
"  export { name }"
  , String
"They can also be renamed on export:"
  , String
"  export { name as alias }"
  , String
"Alternatively, CommonJS exports can be defined in one of two ways:"
  , String
"  1) exports.name = value"
  , String
"  2) exports = { name: value }"
  ]
printErrorMessage (ErrorInModule ModuleIdentifier
mid ErrorMessage
e) =
  (String
"Error in module " forall a. [a] -> [a] -> [a]
++ ModuleIdentifier -> String
displayIdentifier ModuleIdentifier
mid forall a. [a] -> [a] -> [a]
++ String
":")
  forall a. a -> [a] -> [a]
: String
""
  forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (String
"  " forall a. [a] -> [a] -> [a]
++) (ErrorMessage -> [String]
printErrorMessage ErrorMessage
e)
  where
    displayIdentifier :: ModuleIdentifier -> String
displayIdentifier (ModuleIdentifier String
name ModuleType
ty) =
      String
name forall a. [a] -> [a] -> [a]
++ String
" (" forall a. [a] -> [a] -> [a]
++ ModuleType -> String
showModuleType ModuleType
ty forall a. [a] -> [a] -> [a]
++ String
")"
printErrorMessage (MissingEntryPoint String
mName) =
  [ String
"Could not find an ES module or CommonJS module for the specified entry point: " forall a. [a] -> [a] -> [a]
++ String
mName
  ]
printErrorMessage (MissingMainModule String
mName) =
  [ String
"Could not find an ES module or CommonJS module for the specified main module: " forall a. [a] -> [a] -> [a]
++ String
mName
  ]

-- String literals include the quote chars
fromStringLiteral :: JSExpression -> Maybe String
fromStringLiteral :: JSExpression -> Maybe String
fromStringLiteral (JSStringLiteral JSAnnot
_ String
str) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ShowS
strValue String
str
fromStringLiteral JSExpression
_ = forall a. Maybe a
Nothing

strValue :: String -> String
strValue :: ShowS
strValue String
str = ShowS
go forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1 String
str
  where
  go :: ShowS
go (Char
'\\' : Char
'b' : String
xs) = Char
'\b' forall a. a -> [a] -> [a]
: ShowS
go String
xs
  go (Char
'\\' : Char
'f' : String
xs) = Char
'\f' forall a. a -> [a] -> [a]
: ShowS
go String
xs
  go (Char
'\\' : Char
'n' : String
xs) = Char
'\n' forall a. a -> [a] -> [a]
: ShowS
go String
xs
  go (Char
'\\' : Char
'r' : String
xs) = Char
'\r' forall a. a -> [a] -> [a]
: ShowS
go String
xs
  go (Char
'\\' : Char
't' : String
xs) = Char
'\t' forall a. a -> [a] -> [a]
: ShowS
go String
xs
  go (Char
'\\' : Char
'v' : String
xs) = Char
'\v' forall a. a -> [a] -> [a]
: ShowS
go String
xs
  go (Char
'\\' : Char
'0' : String
xs) = Char
'\0' forall a. a -> [a] -> [a]
: ShowS
go String
xs
  go (Char
'\\' : Char
'x' : Char
a : Char
b : String
xs) = Int -> Char
chr (Int
a' forall a. Num a => a -> a -> a
+ Int
b') forall a. a -> [a] -> [a]
: ShowS
go String
xs
    where
    a' :: Int
a' = Int
16 forall a. Num a => a -> a -> a
* Char -> Int
digitToInt Char
a
    b' :: Int
b' = Char -> Int
digitToInt Char
b
  go (Char
'\\' : Char
'u' : Char
a : Char
b : Char
c : Char
d : String
xs) = Int -> Char
chr (Int
a' forall a. Num a => a -> a -> a
+ Int
b' forall a. Num a => a -> a -> a
+ Int
c' forall a. Num a => a -> a -> a
+ Int
d') forall a. a -> [a] -> [a]
: ShowS
go String
xs
    where
    a' :: Int
a' = Int
16 forall a. Num a => a -> a -> a
* Int
16 forall a. Num a => a -> a -> a
* Int
16 forall a. Num a => a -> a -> a
* Char -> Int
digitToInt Char
a
    b' :: Int
b' = Int
16 forall a. Num a => a -> a -> a
* Int
16 forall a. Num a => a -> a -> a
* Char -> Int
digitToInt Char
b
    c' :: Int
c' = Int
16 forall a. Num a => a -> a -> a
* Char -> Int
digitToInt Char
c
    d' :: Int
d' = Char -> Int
digitToInt Char
d
  go (Char
'\\' : Char
x : String
xs) = Char
x forall a. a -> [a] -> [a]
: ShowS
go String
xs
  go String
"\"" = String
""
  go String
"'" = String
""
  go (Char
x : String
xs) = Char
x forall a. a -> [a] -> [a]
: ShowS
go String
xs
  go String
"" = String
""

commaList :: JSCommaList a -> [a]
commaList :: forall a. JSCommaList a -> [a]
commaList JSCommaList a
JSLNil = []
commaList (JSLOne a
x) = [a
x]
commaList (JSLCons JSCommaList a
l JSAnnot
_ a
x) = forall a. JSCommaList a -> [a]
commaList JSCommaList a
l forall a. [a] -> [a] -> [a]
++ [a
x]

trailingCommaList :: JSCommaTrailingList a -> [a]
trailingCommaList :: forall a. JSCommaTrailingList a -> [a]
trailingCommaList (JSCTLComma JSCommaList a
l JSAnnot
_) = forall a. JSCommaList a -> [a]
commaList JSCommaList a
l
trailingCommaList (JSCTLNone JSCommaList a
l) = forall a. JSCommaList a -> [a]
commaList JSCommaList a
l

identName :: JSIdent -> Maybe String
identName :: JSIdent -> Maybe String
identName (JSIdentName JSAnnot
_ String
ident) = forall a. a -> Maybe a
Just String
ident
identName JSIdent
_ = forall a. Maybe a
Nothing

exportStatementIdentifiers :: JSStatement -> [String]
exportStatementIdentifiers :: JSStatement -> [String]
exportStatementIdentifiers (JSVariable JSAnnot
_ JSCommaList JSExpression
jsExpressions JSSemi
_) =
  JSCommaList JSExpression -> [String]
varNames JSCommaList JSExpression
jsExpressions
exportStatementIdentifiers (JSConstant JSAnnot
_ JSCommaList JSExpression
jsExpressions JSSemi
_) =
  JSCommaList JSExpression -> [String]
varNames JSCommaList JSExpression
jsExpressions
exportStatementIdentifiers (JSLet JSAnnot
_ JSCommaList JSExpression
jsExpressions JSSemi
_) =
  JSCommaList JSExpression -> [String]
varNames JSCommaList JSExpression
jsExpressions
exportStatementIdentifiers (JSClass JSAnnot
_ JSIdent
jsIdent JSClassHeritage
_ JSAnnot
_ [JSClassElement]
_ JSAnnot
_ JSSemi
_) =
  forall a. Maybe a -> [a]
maybeToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSIdent -> Maybe String
identName forall a b. (a -> b) -> a -> b
$ JSIdent
jsIdent
exportStatementIdentifiers (JSFunction JSAnnot
_ JSIdent
jsIdent JSAnnot
_ JSCommaList JSExpression
_ JSAnnot
_ JSBlock
_ JSSemi
_) =
  forall a. Maybe a -> [a]
maybeToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSIdent -> Maybe String
identName forall a b. (a -> b) -> a -> b
$ JSIdent
jsIdent
exportStatementIdentifiers (JSGenerator JSAnnot
_ JSAnnot
_ JSIdent
jsIdent JSAnnot
_ JSCommaList JSExpression
_ JSAnnot
_ JSBlock
_ JSSemi
_) =
  forall a. Maybe a -> [a]
maybeToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSIdent -> Maybe String
identName forall a b. (a -> b) -> a -> b
$ JSIdent
jsIdent
exportStatementIdentifiers JSStatement
_ = []

varNames :: JSCommaList JSExpression -> [String]
varNames :: JSCommaList JSExpression -> [String]
varNames = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe JSExpression -> Maybe String
varName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. JSCommaList a -> [a]
commaList
  where
  varName :: JSExpression -> Maybe String
varName (JSVarInitExpression (JSIdentifier JSAnnot
_ String
ident) JSVarInitializer
_) = forall a. a -> Maybe a
Just String
ident
  varName JSExpression
_ = forall a. Maybe a
Nothing

data ForeignModuleExports =
  ForeignModuleExports
    { ForeignModuleExports -> [String]
cjsExports :: [String]
    , ForeignModuleExports -> [String]
esExports :: [String]
    } deriving (Int -> ForeignModuleExports -> ShowS
[ForeignModuleExports] -> ShowS
ForeignModuleExports -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ForeignModuleExports] -> ShowS
$cshowList :: [ForeignModuleExports] -> ShowS
show :: ForeignModuleExports -> String
$cshow :: ForeignModuleExports -> String
showsPrec :: Int -> ForeignModuleExports -> ShowS
$cshowsPrec :: Int -> ForeignModuleExports -> ShowS
Show)

instance Semigroup ForeignModuleExports where
  (ForeignModuleExports [String]
cjsExports [String]
esExports) <> :: ForeignModuleExports
-> ForeignModuleExports -> ForeignModuleExports
<> (ForeignModuleExports [String]
cjsExports' [String]
esExports') =
    [String] -> [String] -> ForeignModuleExports
ForeignModuleExports ([String]
cjsExports forall a. Semigroup a => a -> a -> a
<> [String]
cjsExports') ([String]
esExports forall a. Semigroup a => a -> a -> a
<> [String]
esExports')
instance Monoid ForeignModuleExports where
  mempty :: ForeignModuleExports
mempty = [String] -> [String] -> ForeignModuleExports
ForeignModuleExports [] []

-- Get a list of all the exported identifiers from a foreign module.
--
-- TODO: what if we assign to exports.foo and then later assign to
-- module.exports (presumably overwriting exports.foo)?
getExportedIdentifiers :: forall m. (MonadError ErrorMessage m)
                          => String
                          -> JSAST
                          -> m ForeignModuleExports
getExportedIdentifiers :: forall (m :: * -> *).
MonadError ErrorMessage m =>
String -> JSAST -> m ForeignModuleExports
getExportedIdentifiers String
mname JSAST
top
  | JSAstModule [JSModuleItem]
jsModuleItems JSAnnot
_ <- JSAST
top = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse JSModuleItem -> m ForeignModuleExports
go [JSModuleItem]
jsModuleItems
  | Bool
otherwise = forall a. ErrorMessage -> m a
err ErrorMessage
InvalidTopLevel
  where
  err :: ErrorMessage -> m a
  err :: forall a. ErrorMessage -> m a
err = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleIdentifier -> ErrorMessage -> ErrorMessage
ErrorInModule (String -> ModuleType -> ModuleIdentifier
ModuleIdentifier String
mname ModuleType
Foreign)

  go :: JSModuleItem -> m ForeignModuleExports
go (JSModuleStatementListItem JSStatement
jsStatement)
    | Just JSObjectPropertyList
props <- JSStatement -> Maybe JSObjectPropertyList
matchExportsAssignment JSStatement
jsStatement
    = do [String]
cjsExports <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse JSObjectProperty -> m String
toIdent (forall a. JSCommaTrailingList a -> [a]
trailingCommaList JSObjectPropertyList
props)
         forall (f :: * -> *) a. Applicative f => a -> f a
pure ForeignModuleExports{ [String]
cjsExports :: [String]
cjsExports :: [String]
cjsExports, esExports :: [String]
esExports = [] }
    | Just (Visibility
Public, String
name, JSExpression
_) <- JSStatement -> Maybe (Visibility, String, JSExpression)
matchMember JSStatement
jsStatement
    = forall (f :: * -> *) a. Applicative f => a -> f a
pure ForeignModuleExports{ cjsExports :: [String]
cjsExports = [String
name], esExports :: [String]
esExports = [] }
    | Bool
otherwise
    = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
  go (JSModuleExportDeclaration JSAnnot
_ JSExportDeclaration
jsExportDeclaration) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ForeignModuleExports{ cjsExports :: [String]
cjsExports = [], esExports :: [String]
esExports = JSExportDeclaration -> [String]
exportDeclarationIdentifiers JSExportDeclaration
jsExportDeclaration }
  go JSModuleItem
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty

  toIdent :: JSObjectProperty -> m String
toIdent (JSPropertyNameandValue JSPropertyName
name JSAnnot
_ [JSExpression
_]) =
    JSPropertyName -> m String
extractLabel' JSPropertyName
name
  toIdent JSObjectProperty
_ =
    forall a. ErrorMessage -> m a
err ErrorMessage
UnsupportedExport

  extractLabel' :: JSPropertyName -> m String
extractLabel' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. ErrorMessage -> m a
err ErrorMessage
UnsupportedExport) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSPropertyName -> Maybe String
extractLabel

  exportDeclarationIdentifiers :: JSExportDeclaration -> [String]
exportDeclarationIdentifiers (JSExportFrom JSExportClause
jsExportClause JSFromClause
_ JSSemi
_) =
    JSExportClause -> [String]
exportClauseIdentifiers JSExportClause
jsExportClause
  exportDeclarationIdentifiers (JSExportLocals JSExportClause
jsExportClause JSSemi
_) =
    JSExportClause -> [String]
exportClauseIdentifiers JSExportClause
jsExportClause
  exportDeclarationIdentifiers (JSExport JSStatement
jsStatement JSSemi
_) =
    JSStatement -> [String]
exportStatementIdentifiers JSStatement
jsStatement

  exportClauseIdentifiers :: JSExportClause -> [String]
exportClauseIdentifiers (JSExportClause JSAnnot
_ JSCommaList JSExportSpecifier
jsExportsSpecifiers JSAnnot
_) =
    forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe JSExportSpecifier -> Maybe String
exportSpecifierName forall a b. (a -> b) -> a -> b
$ forall a. JSCommaList a -> [a]
commaList JSCommaList JSExportSpecifier
jsExportsSpecifiers

  exportSpecifierName :: JSExportSpecifier -> Maybe String
exportSpecifierName (JSExportSpecifier JSIdent
jsIdent) = JSIdent -> Maybe String
identName JSIdent
jsIdent
  exportSpecifierName (JSExportSpecifierAs JSIdent
_ JSAnnot
_ JSIdent
jsIdentAs) = JSIdent -> Maybe String
identName JSIdent
jsIdentAs

data ForeignModuleImports =
  ForeignModuleImports
    { ForeignModuleImports -> [String]
cjsImports :: [String]
    , ForeignModuleImports -> [String]
esImports :: [String]
    } deriving (Int -> ForeignModuleImports -> ShowS
[ForeignModuleImports] -> ShowS
ForeignModuleImports -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ForeignModuleImports] -> ShowS
$cshowList :: [ForeignModuleImports] -> ShowS
show :: ForeignModuleImports -> String
$cshow :: ForeignModuleImports -> String
showsPrec :: Int -> ForeignModuleImports -> ShowS
$cshowsPrec :: Int -> ForeignModuleImports -> ShowS
Show)

instance Semigroup ForeignModuleImports where
  (ForeignModuleImports [String]
cjsImports [String]
esImports) <> :: ForeignModuleImports
-> ForeignModuleImports -> ForeignModuleImports
<> (ForeignModuleImports [String]
cjsImports' [String]
esImports') =
    [String] -> [String] -> ForeignModuleImports
ForeignModuleImports ([String]
cjsImports forall a. Semigroup a => a -> a -> a
<> [String]
cjsImports') ([String]
esImports forall a. Semigroup a => a -> a -> a
<> [String]
esImports')
instance Monoid ForeignModuleImports where
  mempty :: ForeignModuleImports
mempty = [String] -> [String] -> ForeignModuleImports
ForeignModuleImports [] []

-- Get a list of all the imported module identifiers from a foreign module.
getImportedModules :: forall m. (MonadError ErrorMessage m)
                          => String
                          -> JSAST
                          -> m ForeignModuleImports
getImportedModules :: forall (m :: * -> *).
MonadError ErrorMessage m =>
String -> JSAST -> m ForeignModuleImports
getImportedModules String
mname JSAST
top
  | JSAstModule [JSModuleItem]
jsModuleItems JSAnnot
_ <- JSAST
top = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap JSModuleItem -> ForeignModuleImports
go [JSModuleItem]
jsModuleItems
  | Bool
otherwise = forall a. ErrorMessage -> m a
err ErrorMessage
InvalidTopLevel
  where
  err :: ErrorMessage -> m a
  err :: forall a. ErrorMessage -> m a
err = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleIdentifier -> ErrorMessage -> ErrorMessage
ErrorInModule (String -> ModuleType -> ModuleIdentifier
ModuleIdentifier String
mname ModuleType
Foreign)

  go :: JSModuleItem -> ForeignModuleImports
go (JSModuleStatementListItem JSStatement
jsStatement)
    | Just (String
_, String
mid) <- JSStatement -> Maybe (String, String)
matchRequire JSStatement
jsStatement
    = ForeignModuleImports{ cjsImports :: [String]
cjsImports = [String
mid], esImports :: [String]
esImports = [] }
  go (JSModuleImportDeclaration JSAnnot
_ JSImportDeclaration
jsImportDeclaration) =
    ForeignModuleImports{ cjsImports :: [String]
cjsImports = [], esImports :: [String]
esImports = [JSImportDeclaration -> String
importDeclarationModuleId JSImportDeclaration
jsImportDeclaration] }
  go JSModuleItem
_ = forall a. Monoid a => a
mempty

  importDeclarationModuleId :: JSImportDeclaration -> String
importDeclarationModuleId (JSImportDeclaration JSImportClause
_ (JSFromClause JSAnnot
_ JSAnnot
_ String
mid) JSSemi
_) = String
mid
  importDeclarationModuleId (JSImportDeclarationBare JSAnnot
_ String
mid JSSemi
_) = String
mid

-- Matches JS statements like this:
-- var ModuleName = require("file");
matchRequire :: JSStatement -> Maybe (String, String)
matchRequire :: JSStatement -> Maybe (String, String)
matchRequire JSStatement
stmt
  | JSVariable JSAnnot
_ JSCommaList JSExpression
jsInit JSSemi
_ <- JSStatement
stmt
  , [JSVarInitExpression JSExpression
var JSVarInitializer
varInit] <- forall a. JSCommaList a -> [a]
commaList JSCommaList JSExpression
jsInit
  , JSIdentifier JSAnnot
_ String
importName <- JSExpression
var
  , JSVarInit JSAnnot
_ JSExpression
jsInitEx <- JSVarInitializer
varInit
  , JSMemberExpression JSExpression
req JSAnnot
_ JSCommaList JSExpression
argsE JSAnnot
_ <- JSExpression
jsInitEx
  , JSIdentifier JSAnnot
_ String
"require" <- JSExpression
req
  , [ Just String
importPath ] <- forall a b. (a -> b) -> [a] -> [b]
map JSExpression -> Maybe String
fromStringLiteral (forall a. JSCommaList a -> [a]
commaList JSCommaList JSExpression
argsE)
  = forall a. a -> Maybe a
Just (String
importName, String
importPath)
  | Bool
otherwise
  = forall a. Maybe a
Nothing

-- Matches JS member declarations.
matchMember :: JSStatement -> Maybe (Visibility, String, JSExpression)
matchMember :: JSStatement -> Maybe (Visibility, String, JSExpression)
matchMember JSStatement
stmt
  | Just (String
name, JSExpression
decl) <- JSStatement -> Maybe (String, JSExpression)
matchInternalMember JSStatement
stmt
  = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Visibility
Internal, String
name, JSExpression
decl)
  -- exports.foo = expr; exports["foo"] = expr;
  | JSAssignStatement JSExpression
e (JSAssign JSAnnot
_) JSExpression
decl JSSemi
_ <- JSStatement
stmt
  , Just String
name <- JSExpression -> Maybe String
exportsAccessor JSExpression
e
  = forall a. a -> Maybe a
Just (Visibility
Public, String
name, JSExpression
decl)
  | Bool
otherwise
  = forall a. Maybe a
Nothing

matchInternalMember :: JSStatement -> Maybe (String, JSExpression)
matchInternalMember :: JSStatement -> Maybe (String, JSExpression)
matchInternalMember JSStatement
stmt
  -- var foo = expr;
  | JSVariable JSAnnot
_ JSCommaList JSExpression
jsInit JSSemi
_ <- JSStatement
stmt
  , [JSVarInitExpression JSExpression
var JSVarInitializer
varInit] <- forall a. JSCommaList a -> [a]
commaList JSCommaList JSExpression
jsInit
  , JSIdentifier JSAnnot
_ String
name <- JSExpression
var
  , JSVarInit JSAnnot
_ JSExpression
decl <- JSVarInitializer
varInit
  = forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
name, JSExpression
decl)
  -- function foo(...args) { body }
  | JSFunction JSAnnot
a0 JSIdent
jsIdent JSAnnot
a1 JSCommaList JSExpression
args JSAnnot
a2 JSBlock
body JSSemi
_ <- JSStatement
stmt
  , JSIdentName JSAnnot
_ String
name <- JSIdent
jsIdent
  = forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
name, JSAnnot
-> JSIdent
-> JSAnnot
-> JSCommaList JSExpression
-> JSAnnot
-> JSBlock
-> JSExpression
JSFunctionExpression JSAnnot
a0 JSIdent
jsIdent JSAnnot
a1 JSCommaList JSExpression
args JSAnnot
a2 JSBlock
body)
  | Bool
otherwise
  = forall a. Maybe a
Nothing

-- Matches exports.* or exports["*"] expressions and returns the property name.
exportsAccessor :: JSExpression -> Maybe String
exportsAccessor :: JSExpression -> Maybe String
exportsAccessor (JSMemberDot JSExpression
exports JSAnnot
_ JSExpression
nm)
  | JSIdentifier JSAnnot
_ String
"exports" <- JSExpression
exports
  , JSIdentifier JSAnnot
_ String
name <- JSExpression
nm
  = forall a. a -> Maybe a
Just String
name
exportsAccessor (JSMemberSquare JSExpression
exports JSAnnot
_ JSExpression
nm JSAnnot
_)
  | JSIdentifier JSAnnot
_ String
"exports" <- JSExpression
exports
  , Just String
name <- JSExpression -> Maybe String
fromStringLiteral JSExpression
nm
  = forall a. a -> Maybe a
Just String
name
exportsAccessor JSExpression
_ = forall a. Maybe a
Nothing

-- Matches assignments to module.exports, like this:
-- module.exports = { ... }
matchExportsAssignment :: JSStatement -> Maybe JSObjectPropertyList
matchExportsAssignment :: JSStatement -> Maybe JSObjectPropertyList
matchExportsAssignment JSStatement
stmt
  | JSAssignStatement JSExpression
e (JSAssign JSAnnot
_) JSExpression
decl JSSemi
_ <- JSStatement
stmt
  , JSMemberDot JSExpression
module' JSAnnot
_ JSExpression
exports <- JSExpression
e
  , JSIdentifier JSAnnot
_ String
"module" <- JSExpression
module'
  , JSIdentifier JSAnnot
_ String
"exports" <- JSExpression
exports
  , JSObjectLiteral JSAnnot
_ JSObjectPropertyList
props JSAnnot
_ <- JSExpression
decl
  = forall a. a -> Maybe a
Just JSObjectPropertyList
props
  | Bool
otherwise
  = forall a. Maybe a
Nothing

extractLabel :: JSPropertyName -> Maybe String
extractLabel :: JSPropertyName -> Maybe String
extractLabel (JSPropertyString JSAnnot
_ String
nm) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ShowS
strValue String
nm
extractLabel (JSPropertyIdent JSAnnot
_ String
nm) = forall a. a -> Maybe a
Just String
nm
extractLabel JSPropertyName
_ = forall a. Maybe a
Nothing