{-|
Module      : IRTS.JavaScript.AST
Description : The JavaScript AST.

License     : BSD3
Maintainer  : The Idris Community.
-}

{-# 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
  | JsComment 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 -> String
(Int -> JsStmt -> ShowS)
-> (JsStmt -> String) -> ([JsStmt] -> ShowS) -> Show JsStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsStmt] -> ShowS
$cshowList :: [JsStmt] -> ShowS
show :: JsStmt -> String
$cshow :: JsStmt -> String
showsPrec :: Int -> JsStmt -> ShowS
$cshowsPrec :: Int -> JsStmt -> ShowS
Show, JsStmt -> JsStmt -> Bool
(JsStmt -> JsStmt -> Bool)
-> (JsStmt -> JsStmt -> Bool) -> Eq JsStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JsStmt -> JsStmt -> Bool
$c/= :: JsStmt -> JsStmt -> Bool
== :: JsStmt -> JsStmt -> Bool
$c== :: JsStmt -> JsStmt -> Bool
Eq, Typeable JsStmt
Constr
DataType
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 d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsStmt -> c JsStmt
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cJsBreak :: Constr
$cJsContinue :: Constr
$cJsForever :: Constr
$cJsError :: Constr
$cJsSwitchCase :: Constr
$cJsIf :: Constr
$cJsSet :: Constr
$cJsDecLet :: Constr
$cJsDecConst :: Constr
$cJsDecVar :: Constr
$cJsReturn :: Constr
$cJsSeq :: Constr
$cJsFun :: Constr
$cJsExprStmt :: Constr
$cJsComment :: Constr
$cJsEmpty :: Constr
$tJsStmt :: DataType
gmapMo :: (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
gmapMp :: (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
gmapM :: (forall d. Data d => d -> m d) -> JsStmt -> m JsStmt
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JsStmt -> m JsStmt
gmapQi :: Int -> (forall d. Data d => d -> u) -> JsStmt -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JsStmt -> u
gmapQ :: (forall d. Data d => d -> u) -> JsStmt -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JsStmt -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JsStmt -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JsStmt -> r
gmapT :: (forall b. Data b => b -> b) -> JsStmt -> JsStmt
$cgmapT :: (forall b. Data b => b -> b) -> JsStmt -> JsStmt
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JsStmt)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JsStmt)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c JsStmt)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JsStmt)
dataTypeOf :: JsStmt -> DataType
$cdataTypeOf :: JsStmt -> DataType
toConstr :: JsStmt -> Constr
$ctoConstr :: JsStmt -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsStmt
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsStmt
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsStmt -> c JsStmt
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsStmt -> c JsStmt
$cp1Data :: Typeable 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 -> String
(Int -> JsExpr -> ShowS)
-> (JsExpr -> String) -> ([JsExpr] -> ShowS) -> Show JsExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsExpr] -> ShowS
$cshowList :: [JsExpr] -> ShowS
show :: JsExpr -> String
$cshow :: JsExpr -> String
showsPrec :: Int -> JsExpr -> ShowS
$cshowsPrec :: Int -> JsExpr -> ShowS
Show, JsExpr -> JsExpr -> Bool
(JsExpr -> JsExpr -> Bool)
-> (JsExpr -> JsExpr -> Bool) -> Eq JsExpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JsExpr -> JsExpr -> Bool
$c/= :: JsExpr -> JsExpr -> Bool
== :: JsExpr -> JsExpr -> Bool
$c== :: JsExpr -> JsExpr -> Bool
Eq, Typeable JsExpr
Constr
DataType
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 d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsExpr -> c JsExpr
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cJsForce :: Constr
$cJsB2I :: Constr
$cJsForeign :: Constr
$cJsBinOp :: Constr
$cJsUniOp :: Constr
$cJsErrorExp :: Constr
$cJsArray :: Constr
$cJsStr :: Constr
$cJsDouble :: Constr
$cJsInteger :: Constr
$cJsBool :: Constr
$cJsInt :: Constr
$cJsProp :: Constr
$cJsObj :: Constr
$cJsArrayProj :: Constr
$cJsVar :: Constr
$cJsMethod :: Constr
$cJsPart :: Constr
$cJsNew :: Constr
$cJsApp :: Constr
$cJsLambda :: Constr
$cJsThis :: Constr
$cJsUndefined :: Constr
$cJsNull :: Constr
$tJsExpr :: DataType
gmapMo :: (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
gmapMp :: (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
gmapM :: (forall d. Data d => d -> m d) -> JsExpr -> m JsExpr
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JsExpr -> m JsExpr
gmapQi :: Int -> (forall d. Data d => d -> u) -> JsExpr -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JsExpr -> u
gmapQ :: (forall d. Data d => d -> u) -> JsExpr -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JsExpr -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JsExpr -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JsExpr -> r
gmapT :: (forall b. Data b => b -> b) -> JsExpr -> JsExpr
$cgmapT :: (forall b. Data b => b -> b) -> JsExpr -> JsExpr
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JsExpr)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JsExpr)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c JsExpr)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JsExpr)
dataTypeOf :: JsExpr -> DataType
$cdataTypeOf :: JsExpr -> DataType
toConstr :: JsExpr -> Constr
$ctoConstr :: JsExpr -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsExpr
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsExpr
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsExpr -> c JsExpr
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsExpr -> c JsExpr
$cp1Data :: Typeable JsExpr
Data, Typeable)

translateChar :: Char -> String
translateChar :: Char -> String
translateChar ch :: Char
ch
  | Char
'\b'   <- Char
ch       = "\\b"
  | Char
'\f'   <- Char
ch       = "\\f"
  | Char
'\n'   <- Char
ch       = "\\n"
  | Char
'\r'   <- Char
ch       = "\\r"
  | Char
'\t'   <- Char
ch       = "\\t"
  | Char
'\v'   <- Char
ch       = "\\v"
  | Char
'\\'   <- Char
ch       = "\\\\"
  | Char
'\"'   <- Char
ch       = "\\\""
  | Char
'\''   <- Char
ch       = "\\\'"
  | Char -> Int
ord Char
ch Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0x20      = "\\x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
pad 2 (Int -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex (Char -> Int
ord Char
ch) "")
  | Char -> Int
ord Char
ch Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0x7f      = [Char
ch]  -- 0x7f '\DEL'
  | Char -> Int
ord Char
ch Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xff     = "\\x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
pad 2 (Int -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex (Char -> Int
ord Char
ch) "")
  | Char -> Int
ord Char
ch Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xffff   = "\\u" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
pad 4 (Int -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex (Char -> Int
ord Char
ch) "")
  | Char -> Int
ord Char
ch Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x10ffff = "\\u{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex (Char -> Int
ord Char
ch) "}"
  | Bool
otherwise          = ShowS
forall a. HasCallStack => String -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ "Invalid Unicode code point U+" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex (Char -> Int
ord Char
ch) ""
  where
    pad :: Int -> String -> String
    pad :: Int -> ShowS
pad n :: Int
n s :: String
s = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) '0' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

indent :: Text -> Text
indent :: Text -> Text
indent x :: 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 (\y :: Text
y -> Int -> Text -> Text
T.replicate 4 " " 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 [] body :: JsExpr
body = JsExpr
body
jsCurryLam (x :: Text
x:xs :: [Text]
xs) body :: 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 fn :: JsExpr
fn [] = JsExpr
fn
jsCurryApp fn :: JsExpr
fn args :: [JsExpr]
args = (JsExpr -> JsExpr -> JsExpr) -> JsExpr -> [JsExpr] -> JsExpr
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ff :: JsExpr
ff aa :: JsExpr
aa -> JsExpr -> [JsExpr] -> JsExpr
JsApp JsExpr
ff [JsExpr
aa]) JsExpr
fn [JsExpr]
args

jsAppN :: Text -> [JsExpr] -> JsExpr
jsAppN :: Text -> [JsExpr] -> JsExpr
jsAppN fn :: Text
fn args :: [JsExpr]
args = JsExpr -> [JsExpr] -> JsExpr
JsApp (Text -> JsExpr
JsVar Text
fn) [JsExpr]
args

jsSetVar :: Text -> JsExpr -> JsStmt
jsSetVar :: Text -> JsExpr -> JsStmt
jsSetVar n :: Text
n x :: JsExpr
x = JsExpr -> JsExpr -> JsStmt
JsSet (Text -> JsExpr
JsVar Text
n) JsExpr
x

jsStmt2Text :: JsStmt -> Text
jsStmt2Text :: JsStmt -> Text
jsStmt2Text JsEmpty = ""
jsStmt2Text (JsComment c :: 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
`T.append`) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
c
jsStmt2Text (JsExprStmt e :: JsExpr
e) = [Text] -> Text
T.concat [JsExpr -> Text
jsAst2Text JsExpr
e, ";"]
jsStmt2Text (JsReturn x :: JsExpr
x) = [Text] -> Text
T.concat ["return ", JsExpr -> Text
jsAst2Text JsExpr
x, ";"]
jsStmt2Text (JsDecVar name :: Text
name exp :: JsExpr
exp) =
  [Text] -> Text
T.concat ["var ", Text
name, " = ", JsExpr -> Text
jsAst2Text JsExpr
exp, ";"]
jsStmt2Text (JsDecConst name :: Text
name exp :: JsExpr
exp) =
  [Text] -> Text
T.concat ["const ", Text
name, " = ", JsExpr -> Text
jsAst2Text JsExpr
exp, ";"]
jsStmt2Text (JsDecLet name :: Text
name exp :: JsExpr
exp) =
  [Text] -> Text
T.concat ["let ", Text
name, " = ", JsExpr -> Text
jsAst2Text JsExpr
exp, ";"]
jsStmt2Text (JsFun name :: Text
name args :: [Text]
args body :: JsStmt
body) =
  [Text] -> Text
T.concat
    [ "function "
    , Text
name
    , "("
    , Text -> [Text] -> Text
T.intercalate ", " [Text]
args
    , "){\n"
    , Text -> Text
indent (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ JsStmt -> Text
jsStmt2Text JsStmt
body
    , "}\n"
    ]
jsStmt2Text (JsIf cond :: JsExpr
cond conseq :: JsStmt
conseq (Just next :: JsStmt
next@(JsIf _ _ _))) =
  [Text] -> Text
T.concat
    [ "if("
    , JsExpr -> Text
jsAst2Text JsExpr
cond
    , ") {\n"
    , Text -> Text
indent (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ JsStmt -> Text
jsStmt2Text JsStmt
conseq
    , "} else "
    , JsStmt -> Text
jsStmt2Text JsStmt
next
    ]
jsStmt2Text (JsIf cond :: JsExpr
cond conseq :: JsStmt
conseq (Just alt :: JsStmt
alt)) =
  [Text] -> Text
T.concat
    [ "if("
    , JsExpr -> Text
jsAst2Text JsExpr
cond
    , ") {\n"
    , Text -> Text
indent (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ JsStmt -> Text
jsStmt2Text JsStmt
conseq
    , "} else {\n"
    , Text -> Text
indent (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ JsStmt -> Text
jsStmt2Text JsStmt
alt
    , "}\n"
    ]
jsStmt2Text (JsIf cond :: JsExpr
cond conseq :: JsStmt
conseq Nothing) =
  [Text] -> Text
T.concat ["if(", JsExpr -> Text
jsAst2Text JsExpr
cond, ") {\n", Text -> Text
indent (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ JsStmt -> Text
jsStmt2Text JsStmt
conseq, "}\n"]
jsStmt2Text (JsSwitchCase exp :: JsExpr
exp l :: [(JsExpr, JsStmt)]
l d :: Maybe JsStmt
d) =
  [Text] -> Text
T.concat
    [ "switch("
    , JsExpr -> Text
jsAst2Text JsExpr
exp
    , "){\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
    , "}\n"
    ]
  where
    case2Text :: (JsExpr, JsStmt) -> Text
    case2Text :: (JsExpr, JsStmt) -> Text
case2Text (x :: JsExpr
x, y :: JsStmt
y) =
      [Text] -> Text
T.concat
        [ "case "
        , JsExpr -> Text
jsAst2Text JsExpr
x
        , ":\n"
        , Text -> Text
indent (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [JsStmt -> Text
jsStmt2Text JsStmt
y, ";\nbreak;\n"]
        ]
    default2Text :: Maybe JsStmt -> Text
    default2Text :: Maybe JsStmt -> Text
default2Text Nothing = ""
    default2Text (Just z :: JsStmt
z) =
      [Text] -> Text
T.concat ["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, ";\nbreak;\n"]]
jsStmt2Text (JsError t :: JsExpr
t) = [Text] -> Text
T.concat ["$JSRTS.die(", JsExpr -> Text
jsAst2Text JsExpr
t, ");\n"]
jsStmt2Text (JsForever x :: JsStmt
x) =
  [Text] -> Text
T.concat ["for(;;) {\n", Text -> Text
indent (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ JsStmt -> Text
jsStmt2Text JsStmt
x, "}\n"]
jsStmt2Text JsContinue = "continue;"
jsStmt2Text JsBreak = "break;"
jsStmt2Text (JsSeq JsEmpty y :: JsStmt
y) = JsStmt -> Text
jsStmt2Text JsStmt
y
jsStmt2Text (JsSeq x :: JsStmt
x JsEmpty) = JsStmt -> Text
jsStmt2Text JsStmt
x
jsStmt2Text (JsSeq x :: JsStmt
x y :: JsStmt
y) = [Text] -> Text
T.concat [JsStmt -> Text
jsStmt2Text JsStmt
x, "\n", JsStmt -> Text
jsStmt2Text JsStmt
y]
jsStmt2Text (JsSet term :: JsExpr
term exp :: JsExpr
exp) =
  [Text] -> Text
T.concat [JsExpr -> Text
jsAst2Text JsExpr
term, " = ", JsExpr -> Text
jsAst2Text JsExpr
exp, ";"]

jsAst2Text :: JsExpr -> Text
jsAst2Text :: JsExpr -> Text
jsAst2Text JsNull = "null"
jsAst2Text JsUndefined = "(void 0)"
jsAst2Text JsThis = "this"
jsAst2Text (JsLambda args :: [Text]
args body :: JsStmt
body) =
  [Text] -> Text
T.concat
    [ "(function"
    , "("
    , Text -> [Text] -> Text
T.intercalate ", " [Text]
args
    , "){\n"
    , Text -> Text
indent (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ JsStmt -> Text
jsStmt2Text JsStmt
body
    , "})"
    ]
jsAst2Text (JsApp fn :: JsExpr
fn args :: [JsExpr]
args) =
  [Text] -> Text
T.concat [JsExpr -> Text
jsAst2Text JsExpr
fn, "(", Text -> [Text] -> Text
T.intercalate ", " ([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, ")"]
jsAst2Text (JsNew fn :: JsExpr
fn args :: [JsExpr]
args) =
  [Text] -> Text
T.concat ["new ", JsExpr -> Text
jsAst2Text JsExpr
fn, "(", Text -> [Text] -> Text
T.intercalate ", " ([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, ")"]
jsAst2Text (JsMethod obj :: JsExpr
obj name :: Text
name args :: [JsExpr]
args) =
  [Text] -> Text
T.concat
    [ JsExpr -> Text
jsAst2Text JsExpr
obj
    , "."
    , Text
name
    , "("
    , Text -> [Text] -> Text
T.intercalate ", " ([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
    , ")"
    ]
jsAst2Text (JsPart obj :: JsExpr
obj name :: Text
name) =
  [Text] -> Text
T.concat [JsExpr -> Text
jsAst2Text JsExpr
obj, "[", String -> Text
T.pack (Text -> String
forall a. Show a => a -> String
show Text
name), "]"]
jsAst2Text (JsVar x :: Text
x) = Text
x
jsAst2Text (JsObj props :: [(Text, JsExpr)]
props) =
  [Text] -> Text
T.concat
    [ "({"
    , Text -> [Text] -> Text
T.intercalate
        ", "
        (((Text, JsExpr) -> Text) -> [(Text, JsExpr)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(name :: Text
name, val :: JsExpr
val) -> [Text] -> Text
T.concat [Text
name, ": ", JsExpr -> Text
jsAst2Text JsExpr
val]) [(Text, JsExpr)]
props)
    , "})"
    ]
jsAst2Text (JsProp object :: JsExpr
object name :: Text
name) = [Text] -> Text
T.concat [JsExpr -> Text
jsAst2Text JsExpr
object, ".", Text
name]
jsAst2Text (JsArrayProj i :: JsExpr
i exp :: JsExpr
exp) =
  [Text] -> Text
T.concat [JsExpr -> Text
jsAst2Text JsExpr
exp, "[", JsExpr -> Text
jsAst2Text JsExpr
i, "]"]
jsAst2Text (JsInt i :: Int
i) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
i
jsAst2Text (JsBool True) = String -> Text
T.pack "true"
jsAst2Text (JsBool False) = String -> Text
T.pack "false"
jsAst2Text (JsDouble d :: Double
d) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
d
jsAst2Text (JsInteger i :: Integer
i) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
i
jsAst2Text (JsStr s :: String
s) =   "\"" Text -> Text -> Text
`T.append` String -> Text
T.pack ((Char -> String) -> ShowS
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
translateChar String
s) Text -> Text -> Text
`T.append` "\""
jsAst2Text (JsArray l :: [JsExpr]
l) =
  [Text] -> Text
T.concat ["[", Text -> [Text] -> Text
T.intercalate ", " ((JsExpr -> Text) -> [JsExpr] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map JsExpr -> Text
jsAst2Text [JsExpr]
l), "]"]
jsAst2Text (JsErrorExp t :: JsExpr
t) =
  [Text] -> Text
T.concat ["$JSRTS.throw(new Error(  ", JsExpr -> Text
jsAst2Text JsExpr
t, "))"]
jsAst2Text (JsBinOp op :: Text
op a1 :: JsExpr
a1 a2 :: JsExpr
a2) =
  [Text] -> Text
T.concat ["(", JsExpr -> Text
jsAst2Text JsExpr
a1, " ", Text
op, " ", JsExpr -> Text
jsAst2Text JsExpr
a2, ")"]
jsAst2Text (JsUniOp op :: Text
op a :: JsExpr
a) = [Text] -> Text
T.concat ["(", Text
op, JsExpr -> Text
jsAst2Text JsExpr
a, ")"]
jsAst2Text (JsForeign code :: Text
code args :: [JsExpr]
args) =
  let args_repl :: Text -> t -> [Text] -> Text
args_repl c :: Text
c i :: t
i [] = Text
c
      args_repl c :: Text
c i :: t
i (t :: Text
t:r :: [Text]
r) =
        Text -> t -> [Text] -> Text
args_repl (Text -> Text -> Text -> Text
T.replace ("%" Text -> Text -> Text
`T.append` String -> Text
T.pack (t -> String
forall a. Show a => a -> String
show t
i)) ([Text] -> Text
T.concat ["(", Text
t, ")"]) Text
c) (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ 1) [Text]
r
  in [Text] -> Text
T.concat ["(", Text -> Integer -> [Text] -> Text
forall t. (Show t, Num t) => Text -> t -> [Text] -> Text
args_repl Text
code 0 ((JsExpr -> Text) -> [JsExpr] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map JsExpr -> Text
jsAst2Text [JsExpr]
args), ")"]
jsAst2Text (JsB2I x :: JsExpr
x) = JsExpr -> Text
jsAst2Text (JsExpr -> Text) -> JsExpr -> Text
forall a b. (a -> b) -> a -> b
$ Text -> JsExpr -> JsExpr -> JsExpr
JsBinOp "+" JsExpr
x (Int -> JsExpr
JsInt 0)
jsAst2Text (JsForce e :: JsExpr
e) = [Text] -> Text
T.concat ["$JSRTS.force(", JsExpr -> Text
jsAst2Text JsExpr
e, ")"]

jsLazy :: JsExpr -> JsExpr
jsLazy :: JsExpr -> JsExpr
jsLazy e :: JsExpr
e = JsExpr -> [JsExpr] -> JsExpr
JsNew (JsExpr -> Text -> JsExpr
JsProp (Text -> JsExpr
JsVar "$JSRTS") "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 x :: JsExpr
x) = JsExpr
x
jsStmt2Expr x :: JsStmt
x = JsExpr -> [JsExpr] -> JsExpr
JsApp ([Text] -> JsStmt -> JsExpr
JsLambda [] JsStmt
x) []