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
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)
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"
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)
type Key = (ModuleIdentifier, String, Visibility)
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)
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'
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
]
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
]
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 [] []
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 [] []
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
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
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)
| 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
| 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)
| 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
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
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
(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