module Language.PureScript.Bundle
( ModuleIdentifier(..)
, ModuleType(..)
, ErrorMessage(..)
, printErrorMessage
, ForeignModuleExports(..)
, getExportedIdentifiers
, ForeignModuleImports(..)
, getImportedModules
, Module
) where
import Prelude
import Control.Monad.Error.Class (MonadError(..))
import Data.Aeson ((.=))
import Data.Char (chr, digitToInt)
import Data.Foldable (fold)
import Data.Maybe (mapMaybe, maybeToList)
import Data.Aeson qualified as A
import Data.Text.Lazy qualified as LT
import Language.JavaScript.Parser (JSAST(..), JSAnnot(..), JSAssignOp(..), JSExpression(..), JSStatement(..), renderToText)
import Language.JavaScript.Parser.AST (JSCommaList(..), JSCommaTrailingList(..), JSExportClause(..), JSExportDeclaration(..), JSExportSpecifier(..), JSFromClause(..), JSIdent(..), JSImportDeclaration(..), JSModuleItem(..), JSObjectProperty(..), JSObjectPropertyList, JSPropertyName(..), JSVarInitializer(..))
import Language.JavaScript.Process.Minify (minifyJS)
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