{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, PatternGuards #-}
module IRTS.JavaScript.AST
( JsExpr(..)
, JsStmt(..)
, jsAst2Text
, jsStmt2Text
, jsLazy
, jsCurryLam
, jsCurryApp
, jsAppN
, jsExpr2Stmt
, jsStmt2Expr
, jsSetVar
) where
import Data.Char
import Data.Data
import Data.Text (Text)
import qualified Data.Text as T
import Numeric
data JsStmt
= JsEmpty
| Text
| JsExprStmt JsExpr
| JsFun Text
[Text]
JsStmt
| JsSeq JsStmt
JsStmt
| JsReturn JsExpr
| JsDecVar Text
JsExpr
| JsDecConst Text
JsExpr
| JsDecLet Text
JsExpr
| JsSet JsExpr
JsExpr
| JsIf JsExpr
JsStmt
(Maybe JsStmt)
| JsSwitchCase JsExpr
[(JsExpr, JsStmt)]
(Maybe JsStmt)
| JsError JsExpr
| JsForever JsStmt
| JsContinue
| JsBreak
deriving (Int -> JsStmt -> ShowS
[JsStmt] -> ShowS
JsStmt -> [Char]
(Int -> JsStmt -> ShowS)
-> (JsStmt -> [Char]) -> ([JsStmt] -> ShowS) -> Show JsStmt
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JsStmt -> ShowS
showsPrec :: Int -> JsStmt -> ShowS
$cshow :: JsStmt -> [Char]
show :: JsStmt -> [Char]
$cshowList :: [JsStmt] -> ShowS
showList :: [JsStmt] -> ShowS
Show, JsStmt -> JsStmt -> Bool
(JsStmt -> JsStmt -> Bool)
-> (JsStmt -> JsStmt -> Bool) -> Eq JsStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JsStmt -> JsStmt -> Bool
== :: JsStmt -> JsStmt -> Bool
$c/= :: JsStmt -> JsStmt -> Bool
/= :: JsStmt -> JsStmt -> Bool
Eq, Typeable JsStmt
Typeable JsStmt =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsStmt -> c JsStmt)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsStmt)
-> (JsStmt -> Constr)
-> (JsStmt -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JsStmt))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JsStmt))
-> ((forall b. Data b => b -> b) -> JsStmt -> JsStmt)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JsStmt -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JsStmt -> r)
-> (forall u. (forall d. Data d => d -> u) -> JsStmt -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> JsStmt -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JsStmt -> m JsStmt)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsStmt -> m JsStmt)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsStmt -> m JsStmt)
-> Data JsStmt
JsStmt -> Constr
JsStmt -> DataType
(forall b. Data b => b -> b) -> JsStmt -> JsStmt
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> JsStmt -> u
forall u. (forall d. Data d => d -> u) -> JsStmt -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JsStmt -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JsStmt -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JsStmt -> m JsStmt
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsStmt -> m JsStmt
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsStmt
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsStmt -> c JsStmt
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JsStmt)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JsStmt)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsStmt -> c JsStmt
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsStmt -> c JsStmt
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsStmt
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsStmt
$ctoConstr :: JsStmt -> Constr
toConstr :: JsStmt -> Constr
$cdataTypeOf :: JsStmt -> DataType
dataTypeOf :: JsStmt -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JsStmt)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JsStmt)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JsStmt)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JsStmt)
$cgmapT :: (forall b. Data b => b -> b) -> JsStmt -> JsStmt
gmapT :: (forall b. Data b => b -> b) -> JsStmt -> JsStmt
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JsStmt -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JsStmt -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JsStmt -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JsStmt -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JsStmt -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> JsStmt -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JsStmt -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JsStmt -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JsStmt -> m JsStmt
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JsStmt -> m JsStmt
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsStmt -> m JsStmt
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsStmt -> m JsStmt
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsStmt -> m JsStmt
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsStmt -> m JsStmt
Data, Typeable)
data JsExpr
= JsNull
| JsUndefined
| JsThis
| JsLambda [Text]
JsStmt
| JsApp JsExpr
[JsExpr]
| JsNew JsExpr
[JsExpr]
| JsPart JsExpr
Text
| JsMethod JsExpr
Text
[JsExpr]
| JsVar Text
| JsArrayProj JsExpr
JsExpr
| JsObj [(Text, JsExpr)]
| JsProp JsExpr
Text
| JsInt Int
| JsBool Bool
| JsInteger Integer
| JsDouble Double
| JsStr String
| JsArray [JsExpr]
| JsErrorExp JsExpr
| JsUniOp Text
JsExpr
| JsBinOp Text
JsExpr
JsExpr
| JsForeign Text
[JsExpr]
| JsB2I JsExpr
| JsForce JsExpr
deriving (Int -> JsExpr -> ShowS
[JsExpr] -> ShowS
JsExpr -> [Char]
(Int -> JsExpr -> ShowS)
-> (JsExpr -> [Char]) -> ([JsExpr] -> ShowS) -> Show JsExpr
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JsExpr -> ShowS
showsPrec :: Int -> JsExpr -> ShowS
$cshow :: JsExpr -> [Char]
show :: JsExpr -> [Char]
$cshowList :: [JsExpr] -> ShowS
showList :: [JsExpr] -> ShowS
Show, JsExpr -> JsExpr -> Bool
(JsExpr -> JsExpr -> Bool)
-> (JsExpr -> JsExpr -> Bool) -> Eq JsExpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JsExpr -> JsExpr -> Bool
== :: JsExpr -> JsExpr -> Bool
$c/= :: JsExpr -> JsExpr -> Bool
/= :: JsExpr -> JsExpr -> Bool
Eq, Typeable JsExpr
Typeable JsExpr =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsExpr -> c JsExpr)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsExpr)
-> (JsExpr -> Constr)
-> (JsExpr -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JsExpr))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JsExpr))
-> ((forall b. Data b => b -> b) -> JsExpr -> JsExpr)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JsExpr -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JsExpr -> r)
-> (forall u. (forall d. Data d => d -> u) -> JsExpr -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> JsExpr -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JsExpr -> m JsExpr)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsExpr -> m JsExpr)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsExpr -> m JsExpr)
-> Data JsExpr
JsExpr -> Constr
JsExpr -> DataType
(forall b. Data b => b -> b) -> JsExpr -> JsExpr
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> JsExpr -> u
forall u. (forall d. Data d => d -> u) -> JsExpr -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JsExpr -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JsExpr -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JsExpr -> m JsExpr
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsExpr -> m JsExpr
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsExpr
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsExpr -> c JsExpr
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JsExpr)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JsExpr)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsExpr -> c JsExpr
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsExpr -> c JsExpr
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsExpr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsExpr
$ctoConstr :: JsExpr -> Constr
toConstr :: JsExpr -> Constr
$cdataTypeOf :: JsExpr -> DataType
dataTypeOf :: JsExpr -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JsExpr)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JsExpr)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JsExpr)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JsExpr)
$cgmapT :: (forall b. Data b => b -> b) -> JsExpr -> JsExpr
gmapT :: (forall b. Data b => b -> b) -> JsExpr -> JsExpr
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JsExpr -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JsExpr -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JsExpr -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JsExpr -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JsExpr -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> JsExpr -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JsExpr -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JsExpr -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JsExpr -> m JsExpr
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JsExpr -> m JsExpr
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsExpr -> m JsExpr
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsExpr -> m JsExpr
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsExpr -> m JsExpr
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsExpr -> m JsExpr
Data, Typeable)
translateChar :: Char -> String
translateChar :: Char -> [Char]
translateChar Char
ch
| Char
'\b' <- Char
ch = [Char]
"\\b"
| Char
'\f' <- Char
ch = [Char]
"\\f"
| Char
'\n' <- Char
ch = [Char]
"\\n"
| Char
'\r' <- Char
ch = [Char]
"\\r"
| Char
'\t' <- Char
ch = [Char]
"\\t"
| Char
'\v' <- Char
ch = [Char]
"\\v"
| Char
'\\' <- Char
ch = [Char]
"\\\\"
| Char
'\"' <- Char
ch = [Char]
"\\\""
| Char
'\'' <- Char
ch = [Char]
"\\\'"
| Char -> Int
ord Char
ch Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x20 = [Char]
"\\x" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
pad Int
2 (Int -> ShowS
forall a. Integral a => a -> ShowS
showHex (Char -> Int
ord Char
ch) [Char]
"")
| Char -> Int
ord Char
ch Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x7f = [Char
ch]
| Char -> Int
ord Char
ch Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xff = [Char]
"\\x" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
pad Int
2 (Int -> ShowS
forall a. Integral a => a -> ShowS
showHex (Char -> Int
ord Char
ch) [Char]
"")
| Char -> Int
ord Char
ch Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xffff = [Char]
"\\u" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
pad Int
4 (Int -> ShowS
forall a. Integral a => a -> ShowS
showHex (Char -> Int
ord Char
ch) [Char]
"")
| Char -> Int
ord Char
ch Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x10ffff = [Char]
"\\u{" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
forall a. Integral a => a -> ShowS
showHex (Char -> Int
ord Char
ch) [Char]
"}"
| Bool
otherwise = ShowS
forall a. HasCallStack => [Char] -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid Unicode code point U+" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
forall a. Integral a => a -> ShowS
showHex (Char -> Int
ord Char
ch) [Char]
""
where
pad :: Int -> String -> String
pad :: Int -> ShowS
pad Int
n [Char]
s = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s) Char
'0' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s
indent :: Text -> Text
indent :: Text -> Text
indent Text
x =
let l :: [Text]
l = Text -> [Text]
T.lines Text
x
il :: [Text]
il = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
y -> Int -> Text -> Text
T.replicate Int
4 Text
" " Text -> Text -> Text
`T.append` Text
y) [Text]
l
in [Text] -> Text
T.unlines [Text]
il
jsCurryLam :: [Text] -> JsExpr -> JsExpr
jsCurryLam :: [Text] -> JsExpr -> JsExpr
jsCurryLam [] JsExpr
body = JsExpr
body
jsCurryLam (Text
x:[Text]
xs) JsExpr
body = [Text] -> JsStmt -> JsExpr
JsLambda [Text
x] (JsStmt -> JsExpr) -> JsStmt -> JsExpr
forall a b. (a -> b) -> a -> b
$ JsExpr -> JsStmt
JsReturn (JsExpr -> JsStmt) -> JsExpr -> JsStmt
forall a b. (a -> b) -> a -> b
$ [Text] -> JsExpr -> JsExpr
jsCurryLam [Text]
xs JsExpr
body
jsCurryApp :: JsExpr -> [JsExpr] -> JsExpr
jsCurryApp :: JsExpr -> [JsExpr] -> JsExpr
jsCurryApp JsExpr
fn [] = JsExpr
fn
jsCurryApp JsExpr
fn [JsExpr]
args = (JsExpr -> JsExpr -> JsExpr) -> JsExpr -> [JsExpr] -> JsExpr
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\JsExpr
ff JsExpr
aa -> JsExpr -> [JsExpr] -> JsExpr
JsApp JsExpr
ff [JsExpr
aa]) JsExpr
fn [JsExpr]
args
jsAppN :: Text -> [JsExpr] -> JsExpr
jsAppN :: Text -> [JsExpr] -> JsExpr
jsAppN Text
fn [JsExpr]
args = JsExpr -> [JsExpr] -> JsExpr
JsApp (Text -> JsExpr
JsVar Text
fn) [JsExpr]
args
jsSetVar :: Text -> JsExpr -> JsStmt
jsSetVar :: Text -> JsExpr -> JsStmt
jsSetVar Text
n JsExpr
x = JsExpr -> JsExpr -> JsStmt
JsSet (Text -> JsExpr
JsVar Text
n) JsExpr
x
jsStmt2Text :: JsStmt -> Text
jsStmt2Text :: JsStmt -> Text
jsStmt2Text JsStmt
JsEmpty = Text
""
jsStmt2Text (JsComment Text
c) = [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
"// " Text -> Text -> Text
`T.append`) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
c
jsStmt2Text (JsExprStmt JsExpr
e) = [Text] -> Text
T.concat [JsExpr -> Text
jsAst2Text JsExpr
e, Text
";"]
jsStmt2Text (JsReturn JsExpr
x) = [Text] -> Text
T.concat [Text
"return ", JsExpr -> Text
jsAst2Text JsExpr
x, Text
";"]
jsStmt2Text (JsDecVar Text
name JsExpr
exp) =
[Text] -> Text
T.concat [Text
"var ", Text
name, Text
" = ", JsExpr -> Text
jsAst2Text JsExpr
exp, Text
";"]
jsStmt2Text (JsDecConst Text
name JsExpr
exp) =
[Text] -> Text
T.concat [Text
"const ", Text
name, Text
" = ", JsExpr -> Text
jsAst2Text JsExpr
exp, Text
";"]
jsStmt2Text (JsDecLet Text
name JsExpr
exp) =
[Text] -> Text
T.concat [Text
"let ", Text
name, Text
" = ", JsExpr -> Text
jsAst2Text JsExpr
exp, Text
";"]
jsStmt2Text (JsFun Text
name [Text]
args JsStmt
body) =
[Text] -> Text
T.concat
[ Text
"function "
, Text
name
, Text
"("
, Text -> [Text] -> Text
T.intercalate Text
", " [Text]
args
, Text
"){\n"
, Text -> Text
indent (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ JsStmt -> Text
jsStmt2Text JsStmt
body
, Text
"}\n"
]
jsStmt2Text (JsIf JsExpr
cond JsStmt
conseq (Just next :: JsStmt
next@(JsIf JsExpr
_ JsStmt
_ Maybe JsStmt
_))) =
[Text] -> Text
T.concat
[ Text
"if("
, JsExpr -> Text
jsAst2Text JsExpr
cond
, Text
") {\n"
, Text -> Text
indent (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ JsStmt -> Text
jsStmt2Text JsStmt
conseq
, Text
"} else "
, JsStmt -> Text
jsStmt2Text JsStmt
next
]
jsStmt2Text (JsIf JsExpr
cond JsStmt
conseq (Just JsStmt
alt)) =
[Text] -> Text
T.concat
[ Text
"if("
, JsExpr -> Text
jsAst2Text JsExpr
cond
, Text
") {\n"
, Text -> Text
indent (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ JsStmt -> Text
jsStmt2Text JsStmt
conseq
, Text
"} else {\n"
, Text -> Text
indent (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ JsStmt -> Text
jsStmt2Text JsStmt
alt
, Text
"}\n"
]
jsStmt2Text (JsIf JsExpr
cond JsStmt
conseq Maybe JsStmt
Nothing) =
[Text] -> Text
T.concat [Text
"if(", JsExpr -> Text
jsAst2Text JsExpr
cond, Text
") {\n", Text -> Text
indent (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ JsStmt -> Text
jsStmt2Text JsStmt
conseq, Text
"}\n"]
jsStmt2Text (JsSwitchCase JsExpr
exp [(JsExpr, JsStmt)]
l Maybe JsStmt
d) =
[Text] -> Text
T.concat
[ Text
"switch("
, JsExpr -> Text
jsAst2Text JsExpr
exp
, Text
"){\n"
, Text -> Text
indent (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((JsExpr, JsStmt) -> Text) -> [(JsExpr, JsStmt)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (JsExpr, JsStmt) -> Text
case2Text [(JsExpr, JsStmt)]
l
, Text -> Text
indent (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Maybe JsStmt -> Text
default2Text Maybe JsStmt
d
, Text
"}\n"
]
where
case2Text :: (JsExpr, JsStmt) -> Text
case2Text :: (JsExpr, JsStmt) -> Text
case2Text (JsExpr
x, JsStmt
y) =
[Text] -> Text
T.concat
[ Text
"case "
, JsExpr -> Text
jsAst2Text JsExpr
x
, Text
":\n"
, Text -> Text
indent (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [JsStmt -> Text
jsStmt2Text JsStmt
y, Text
";\nbreak;\n"]
]
default2Text :: Maybe JsStmt -> Text
default2Text :: Maybe JsStmt -> Text
default2Text Maybe JsStmt
Nothing = Text
""
default2Text (Just JsStmt
z) =
[Text] -> Text
T.concat [Text
"default:\n", Text -> Text
indent (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [JsStmt -> Text
jsStmt2Text JsStmt
z, Text
";\nbreak;\n"]]
jsStmt2Text (JsError JsExpr
t) = [Text] -> Text
T.concat [Text
"$JSRTS.die(", JsExpr -> Text
jsAst2Text JsExpr
t, Text
");\n"]
jsStmt2Text (JsForever JsStmt
x) =
[Text] -> Text
T.concat [Text
"for(;;) {\n", Text -> Text
indent (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ JsStmt -> Text
jsStmt2Text JsStmt
x, Text
"}\n"]
jsStmt2Text JsStmt
JsContinue = Text
"continue;"
jsStmt2Text JsStmt
JsBreak = Text
"break;"
jsStmt2Text (JsSeq JsStmt
JsEmpty JsStmt
y) = JsStmt -> Text
jsStmt2Text JsStmt
y
jsStmt2Text (JsSeq JsStmt
x JsStmt
JsEmpty) = JsStmt -> Text
jsStmt2Text JsStmt
x
jsStmt2Text (JsSeq JsStmt
x JsStmt
y) = [Text] -> Text
T.concat [JsStmt -> Text
jsStmt2Text JsStmt
x, Text
"\n", JsStmt -> Text
jsStmt2Text JsStmt
y]
jsStmt2Text (JsSet JsExpr
term JsExpr
exp) =
[Text] -> Text
T.concat [JsExpr -> Text
jsAst2Text JsExpr
term, Text
" = ", JsExpr -> Text
jsAst2Text JsExpr
exp, Text
";"]
jsAst2Text :: JsExpr -> Text
jsAst2Text :: JsExpr -> Text
jsAst2Text JsExpr
JsNull = Text
"null"
jsAst2Text JsExpr
JsUndefined = Text
"(void 0)"
jsAst2Text JsExpr
JsThis = Text
"this"
jsAst2Text (JsLambda [Text]
args JsStmt
body) =
[Text] -> Text
T.concat
[ Text
"(function"
, Text
"("
, Text -> [Text] -> Text
T.intercalate Text
", " [Text]
args
, Text
"){\n"
, Text -> Text
indent (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ JsStmt -> Text
jsStmt2Text JsStmt
body
, Text
"})"
]
jsAst2Text (JsApp JsExpr
fn [JsExpr]
args) =
[Text] -> Text
T.concat [JsExpr -> Text
jsAst2Text JsExpr
fn, Text
"(", Text -> [Text] -> Text
T.intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (JsExpr -> Text) -> [JsExpr] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map JsExpr -> Text
jsAst2Text [JsExpr]
args, Text
")"]
jsAst2Text (JsNew JsExpr
fn [JsExpr]
args) =
[Text] -> Text
T.concat [Text
"new ", JsExpr -> Text
jsAst2Text JsExpr
fn, Text
"(", Text -> [Text] -> Text
T.intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (JsExpr -> Text) -> [JsExpr] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map JsExpr -> Text
jsAst2Text [JsExpr]
args, Text
")"]
jsAst2Text (JsMethod JsExpr
obj Text
name [JsExpr]
args) =
[Text] -> Text
T.concat
[ JsExpr -> Text
jsAst2Text JsExpr
obj
, Text
"."
, Text
name
, Text
"("
, Text -> [Text] -> Text
T.intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (JsExpr -> Text) -> [JsExpr] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map JsExpr -> Text
jsAst2Text [JsExpr]
args
, Text
")"
]
jsAst2Text (JsPart JsExpr
obj Text
name) =
[Text] -> Text
T.concat [JsExpr -> Text
jsAst2Text JsExpr
obj, Text
"[", [Char] -> Text
T.pack (Text -> [Char]
forall a. Show a => a -> [Char]
show Text
name), Text
"]"]
jsAst2Text (JsVar Text
x) = Text
x
jsAst2Text (JsObj [(Text, JsExpr)]
props) =
[Text] -> Text
T.concat
[ Text
"({"
, Text -> [Text] -> Text
T.intercalate
Text
", "
(((Text, JsExpr) -> Text) -> [(Text, JsExpr)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
name, JsExpr
val) -> [Text] -> Text
T.concat [Text
name, Text
": ", JsExpr -> Text
jsAst2Text JsExpr
val]) [(Text, JsExpr)]
props)
, Text
"})"
]
jsAst2Text (JsProp JsExpr
object Text
name) = [Text] -> Text
T.concat [JsExpr -> Text
jsAst2Text JsExpr
object, Text
".", Text
name]
jsAst2Text (JsArrayProj JsExpr
i JsExpr
exp) =
[Text] -> Text
T.concat [JsExpr -> Text
jsAst2Text JsExpr
exp, Text
"[", JsExpr -> Text
jsAst2Text JsExpr
i, Text
"]"]
jsAst2Text (JsInt Int
i) = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i
jsAst2Text (JsBool Bool
True) = [Char] -> Text
T.pack [Char]
"true"
jsAst2Text (JsBool Bool
False) = [Char] -> Text
T.pack [Char]
"false"
jsAst2Text (JsDouble Double
d) = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Double -> [Char]
forall a. Show a => a -> [Char]
show Double
d
jsAst2Text (JsInteger Integer
i) = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
i
jsAst2Text (JsStr [Char]
s) = Text
"\"" Text -> Text -> Text
`T.append` [Char] -> Text
T.pack ((Char -> [Char]) -> ShowS
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> [Char]
translateChar [Char]
s) Text -> Text -> Text
`T.append` Text
"\""
jsAst2Text (JsArray [JsExpr]
l) =
[Text] -> Text
T.concat [Text
"[", Text -> [Text] -> Text
T.intercalate Text
", " ((JsExpr -> Text) -> [JsExpr] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map JsExpr -> Text
jsAst2Text [JsExpr]
l), Text
"]"]
jsAst2Text (JsErrorExp JsExpr
t) =
[Text] -> Text
T.concat [Text
"$JSRTS.throw(new Error( ", JsExpr -> Text
jsAst2Text JsExpr
t, Text
"))"]
jsAst2Text (JsBinOp Text
op JsExpr
a1 JsExpr
a2) =
[Text] -> Text
T.concat [Text
"(", JsExpr -> Text
jsAst2Text JsExpr
a1, Text
" ", Text
op, Text
" ", JsExpr -> Text
jsAst2Text JsExpr
a2, Text
")"]
jsAst2Text (JsUniOp Text
op JsExpr
a) = [Text] -> Text
T.concat [Text
"(", Text
op, JsExpr -> Text
jsAst2Text JsExpr
a, Text
")"]
jsAst2Text (JsForeign Text
code [JsExpr]
args) =
let args_repl :: Text -> t -> [Text] -> Text
args_repl Text
c t
i [] = Text
c
args_repl Text
c t
i (Text
t:[Text]
r) =
Text -> t -> [Text] -> Text
args_repl (HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace (Text
"%" Text -> Text -> Text
`T.append` [Char] -> Text
T.pack (t -> [Char]
forall a. Show a => a -> [Char]
show t
i)) ([Text] -> Text
T.concat [Text
"(", Text
t, Text
")"]) Text
c) (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) [Text]
r
in [Text] -> Text
T.concat [Text
"(", Text -> Integer -> [Text] -> Text
forall {t}. (Show t, Num t) => Text -> t -> [Text] -> Text
args_repl Text
code Integer
0 ((JsExpr -> Text) -> [JsExpr] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map JsExpr -> Text
jsAst2Text [JsExpr]
args), Text
")"]
jsAst2Text (JsB2I JsExpr
x) = JsExpr -> Text
jsAst2Text (JsExpr -> Text) -> JsExpr -> Text
forall a b. (a -> b) -> a -> b
$ Text -> JsExpr -> JsExpr -> JsExpr
JsBinOp Text
"+" JsExpr
x (Int -> JsExpr
JsInt Int
0)
jsAst2Text (JsForce JsExpr
e) = [Text] -> Text
T.concat [Text
"$JSRTS.force(", JsExpr -> Text
jsAst2Text JsExpr
e, Text
")"]
jsLazy :: JsExpr -> JsExpr
jsLazy :: JsExpr -> JsExpr
jsLazy JsExpr
e = JsExpr -> [JsExpr] -> JsExpr
JsNew (JsExpr -> Text -> JsExpr
JsProp (Text -> JsExpr
JsVar Text
"$JSRTS") Text
"Lazy") [([Text] -> JsStmt -> JsExpr
JsLambda [] (JsStmt -> JsExpr) -> JsStmt -> JsExpr
forall a b. (a -> b) -> a -> b
$ JsExpr -> JsStmt
JsReturn JsExpr
e)]
jsExpr2Stmt :: JsExpr -> JsStmt
jsExpr2Stmt :: JsExpr -> JsStmt
jsExpr2Stmt = JsExpr -> JsStmt
JsExprStmt
jsStmt2Expr :: JsStmt -> JsExpr
jsStmt2Expr :: JsStmt -> JsExpr
jsStmt2Expr (JsExprStmt JsExpr
x) = JsExpr
x
jsStmt2Expr JsStmt
x = JsExpr -> [JsExpr] -> JsExpr
JsApp ([Text] -> JsStmt -> JsExpr
JsLambda [] JsStmt
x) []