{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE BlockArguments #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module GHC.JS.Ppr
( renderJs
, renderJs'
, renderPrefixJs
, renderPrefixJs'
, JsToDoc(..)
, defaultRenderJs
, RenderJs(..)
, jsToDoc
, pprStringLit
, flattenBlocks
, braceNest
, hangBrace
)
where
import GHC.Prelude
import GHC.JS.Syntax
import GHC.JS.Transform
import Data.Char (isControl, ord)
import Data.List (sortOn)
import Numeric(showHex)
import GHC.Utils.Outputable (Outputable (..), docToSDoc)
import GHC.Utils.Ppr as PP
import GHC.Data.FastString
import GHC.Types.Unique.Map
instance Outputable JExpr where
ppr :: JExpr -> SDoc
ppr = Doc -> SDoc
docToSDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (JsToDoc a, JMacro a) => a -> Doc
renderJs
instance Outputable JVal where
ppr :: JVal -> SDoc
ppr = Doc -> SDoc
docToSDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (JsToDoc a, JMacro a) => a -> Doc
renderJs
($$$) :: Doc -> Doc -> Doc
Doc
x $$$ :: Doc -> Doc -> Doc
$$$ Doc
y = Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ Doc
x Doc -> Doc -> Doc
$+$ Doc
y
renderJs :: (JsToDoc a, JMacro a) => a -> Doc
renderJs :: forall a. (JsToDoc a, JMacro a) => a -> Doc
renderJs = forall a. (JsToDoc a, JMacro a) => RenderJs -> a -> Doc
renderJs' RenderJs
defaultRenderJs
renderJs' :: (JsToDoc a, JMacro a) => RenderJs -> a -> Doc
renderJs' :: forall a. (JsToDoc a, JMacro a) => RenderJs -> a -> Doc
renderJs' RenderJs
r = forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. JMacro a => Maybe FastString -> a -> a
jsSaturate forall a. Maybe a
Nothing
data RenderJs = RenderJs
{ RenderJs -> RenderJs -> JStat -> Doc
renderJsS :: !(RenderJs -> JStat -> Doc)
, RenderJs -> RenderJs -> JExpr -> Doc
renderJsE :: !(RenderJs -> JExpr -> Doc)
, RenderJs -> RenderJs -> JVal -> Doc
renderJsV :: !(RenderJs -> JVal -> Doc)
, RenderJs -> RenderJs -> Ident -> Doc
renderJsI :: !(RenderJs -> Ident -> Doc)
}
defaultRenderJs :: RenderJs
defaultRenderJs :: RenderJs
defaultRenderJs = (RenderJs -> JStat -> Doc)
-> (RenderJs -> JExpr -> Doc)
-> (RenderJs -> JVal -> Doc)
-> (RenderJs -> Ident -> Doc)
-> RenderJs
RenderJs RenderJs -> JStat -> Doc
defRenderJsS RenderJs -> JExpr -> Doc
defRenderJsE RenderJs -> JVal -> Doc
defRenderJsV RenderJs -> Ident -> Doc
defRenderJsI
jsToDoc :: JsToDoc a => a -> Doc
jsToDoc :: forall a. JsToDoc a => a -> Doc
jsToDoc = forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
defaultRenderJs
renderPrefixJs :: (JsToDoc a, JMacro a) => FastString -> a -> Doc
renderPrefixJs :: forall a. (JsToDoc a, JMacro a) => FastString -> a -> Doc
renderPrefixJs FastString
pfx = forall a.
(JsToDoc a, JMacro a) =>
RenderJs -> FastString -> a -> Doc
renderPrefixJs' RenderJs
defaultRenderJs FastString
pfx
renderPrefixJs' :: (JsToDoc a, JMacro a) => RenderJs -> FastString -> a -> Doc
renderPrefixJs' :: forall a.
(JsToDoc a, JMacro a) =>
RenderJs -> FastString -> a -> Doc
renderPrefixJs' RenderJs
r FastString
pfx = forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. JMacro a => Maybe FastString -> a -> a
jsSaturate (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ FastString
"jmId_" forall a. Monoid a => a -> a -> a
`mappend` FastString
pfx)
braceNest :: Doc -> Doc
braceNest :: Doc -> Doc
braceNest Doc
x = Char -> Doc
char Char
'{' Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest Int
2 Doc
x Doc -> Doc -> Doc
$$ Char -> Doc
char Char
'}'
hangBrace :: Doc -> Doc -> Doc
hangBrace :: Doc -> Doc -> Doc
hangBrace Doc
hdr Doc
body = [Doc] -> Doc
sep [ Doc
hdr Doc -> Doc -> Doc
<> Char -> Doc
char Char
' ' Doc -> Doc -> Doc
<> Char -> Doc
char Char
'{', Int -> Doc -> Doc
nest Int
2 Doc
body, Char -> Doc
char Char
'}' ]
class JsToDoc a where jsToDocR :: RenderJs -> a -> Doc
instance JsToDoc JStat where jsToDocR :: RenderJs -> JStat -> Doc
jsToDocR RenderJs
r = RenderJs -> RenderJs -> JStat -> Doc
renderJsS RenderJs
r RenderJs
r
instance JsToDoc JExpr where jsToDocR :: RenderJs -> JExpr -> Doc
jsToDocR RenderJs
r = RenderJs -> RenderJs -> JExpr -> Doc
renderJsE RenderJs
r RenderJs
r
instance JsToDoc JVal where jsToDocR :: RenderJs -> JVal -> Doc
jsToDocR RenderJs
r = RenderJs -> RenderJs -> JVal -> Doc
renderJsV RenderJs
r RenderJs
r
instance JsToDoc Ident where jsToDocR :: RenderJs -> Ident -> Doc
jsToDocR RenderJs
r = RenderJs -> RenderJs -> Ident -> Doc
renderJsI RenderJs
r RenderJs
r
instance JsToDoc [JExpr] where
jsToDocR :: RenderJs -> [JExpr] -> Doc
jsToDocR RenderJs
r = [Doc] -> Doc
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ((Doc -> Doc -> Doc
<> Doc
semi) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r)
instance JsToDoc [JStat] where
jsToDocR :: RenderJs -> [JStat] -> Doc
jsToDocR RenderJs
r = [Doc] -> Doc
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ((Doc -> Doc -> Doc
<> Doc
semi) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r)
defRenderJsS :: RenderJs -> JStat -> Doc
defRenderJsS :: RenderJs -> JStat -> Doc
defRenderJsS RenderJs
r = \case
IfStat JExpr
cond JStat
x JStat
y -> Doc -> Doc -> Doc
hangBrace (String -> Doc
text String
"if" Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
cond))
(forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JStat
x)
Doc -> Doc -> Doc
$$ Doc
mbElse
where mbElse :: Doc
mbElse | JStat
y forall a. Eq a => a -> a -> Bool
== [JStat] -> JStat
BlockStat [] = Doc
PP.empty
| Bool
otherwise = Doc -> Doc -> Doc
hangBrace (String -> Doc
text String
"else") (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JStat
y)
DeclStat Ident
x Maybe JExpr
Nothing -> String -> Doc
text String
"var" Doc -> Doc -> Doc
<+> forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r Ident
x
DeclStat Ident
x (Just JExpr
e) -> String -> Doc
text String
"var" Doc -> Doc -> Doc
<+> forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r Ident
x Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<+> forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
e
WhileStat Bool
False JExpr
p JStat
b -> Doc -> Doc -> Doc
hangBrace (String -> Doc
text String
"while" Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
p)) (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JStat
b)
WhileStat Bool
True JExpr
p JStat
b -> (Doc -> Doc -> Doc
hangBrace (String -> Doc
text String
"do") (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JStat
b)) Doc -> Doc -> Doc
$+$ String -> Doc
text String
"while" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
p)
UnsatBlock IdentSupply JStat
e -> forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r forall a b. (a -> b) -> a -> b
$ forall a. IdentSupply a -> a
pseudoSaturate IdentSupply JStat
e
BreakStat Maybe LexicalFastString
l -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Doc
text String
"break") (\(LexicalFastString FastString
s) -> (String -> Doc
text String
"break" Doc -> Doc -> Doc
<+> FastString -> Doc
ftext FastString
s)) Maybe LexicalFastString
l
ContinueStat Maybe LexicalFastString
l -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Doc
text String
"continue") (\(LexicalFastString FastString
s) -> (String -> Doc
text String
"continue" Doc -> Doc -> Doc
<+> FastString -> Doc
ftext FastString
s)) Maybe LexicalFastString
l
LabelStat (LexicalFastString FastString
l) JStat
s -> FastString -> Doc
ftext FastString
l Doc -> Doc -> Doc
<> Char -> Doc
char Char
':' Doc -> Doc -> Doc
$$ JStat -> Doc
printBS JStat
s
where
printBS :: JStat -> Doc
printBS (BlockStat [JStat]
ss) = [Doc] -> Doc
vcat forall a b. (a -> b) -> a -> b
$ [JStat] -> [Doc]
interSemi forall a b. (a -> b) -> a -> b
$ [JStat] -> [JStat]
flattenBlocks [JStat]
ss
printBS JStat
x = forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JStat
x
interSemi :: [JStat] -> [Doc]
interSemi [JStat
x] = [forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JStat
x]
interSemi [] = []
interSemi (JStat
x:[JStat]
xs) = (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JStat
x Doc -> Doc -> Doc
<> Doc
semi) forall a. a -> [a] -> [a]
: [JStat] -> [Doc]
interSemi [JStat]
xs
ForInStat Bool
each Ident
i JExpr
e JStat
b -> Doc -> Doc -> Doc
hangBrace (String -> Doc
text String
txt Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r Ident
i Doc -> Doc -> Doc
<+> String -> Doc
text String
"in" Doc -> Doc -> Doc
<+> forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
e)) (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JStat
b)
where txt :: String
txt | Bool
each = String
"for each"
| Bool
otherwise = String
"for"
SwitchStat JExpr
e [(JExpr, JStat)]
l JStat
d -> Doc -> Doc -> Doc
hangBrace (String -> Doc
text String
"switch" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
e)) Doc
cases
where l' :: [Doc]
l' = forall a b. (a -> b) -> [a] -> [b]
map (\(JExpr
c,JStat
s) -> (String -> Doc
text String
"case" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
c) Doc -> Doc -> Doc
<> Char -> Doc
char Char
':') Doc -> Doc -> Doc
$$$ (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JStat
s)) [(JExpr, JStat)]
l forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"default:" Doc -> Doc -> Doc
$$$ (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JStat
d)]
cases :: Doc
cases = [Doc] -> Doc
vcat [Doc]
l'
ReturnStat JExpr
e -> String -> Doc
text String
"return" Doc -> Doc -> Doc
<+> forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
e
ApplStat JExpr
e [JExpr]
es -> forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
e Doc -> Doc -> Doc
<> (Doc -> Doc
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r) [JExpr]
es)
TryStat JStat
s Ident
i JStat
s1 JStat
s2 -> Doc -> Doc -> Doc
hangBrace (String -> Doc
text String
"try") (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JStat
s) Doc -> Doc -> Doc
$$ Doc
mbCatch Doc -> Doc -> Doc
$$ Doc
mbFinally
where mbCatch :: Doc
mbCatch | JStat
s1 forall a. Eq a => a -> a -> Bool
== [JStat] -> JStat
BlockStat [] = Doc
PP.empty
| Bool
otherwise = Doc -> Doc -> Doc
hangBrace (String -> Doc
text String
"catch" Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r Ident
i)) (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JStat
s1)
mbFinally :: Doc
mbFinally | JStat
s2 forall a. Eq a => a -> a -> Bool
== [JStat] -> JStat
BlockStat [] = Doc
PP.empty
| Bool
otherwise = Doc -> Doc -> Doc
hangBrace (String -> Doc
text String
"finally") (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JStat
s2)
AssignStat JExpr
i JExpr
x -> case JExpr
x of
ValExpr (JFunc [Ident]
is JStat
b) -> [Doc] -> Doc
sep [forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
i Doc -> Doc -> Doc
<+> String -> Doc
text String
"= function" Doc -> Doc -> Doc
<> Doc -> Doc
parens ([Doc] -> Doc
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r) forall a b. (a -> b) -> a -> b
$ [Ident]
is) Doc -> Doc -> Doc
<> Char -> Doc
char Char
'{', Int -> Doc -> Doc
nest Int
2 (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JStat
b), String -> Doc
text String
"}"]
JExpr
_ -> forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
i Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<+> forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
x
UOpStat JUOp
op JExpr
x
| JUOp -> Bool
isPre JUOp
op Bool -> Bool -> Bool
&& JUOp -> Bool
isAlphaOp JUOp
op -> FastString -> Doc
ftext (JUOp -> FastString
uOpText JUOp
op) Doc -> Doc -> Doc
<+> RenderJs -> JExpr -> Doc
optParens RenderJs
r JExpr
x
| JUOp -> Bool
isPre JUOp
op -> FastString -> Doc
ftext (JUOp -> FastString
uOpText JUOp
op) Doc -> Doc -> Doc
<> RenderJs -> JExpr -> Doc
optParens RenderJs
r JExpr
x
| Bool
otherwise -> RenderJs -> JExpr -> Doc
optParens RenderJs
r JExpr
x Doc -> Doc -> Doc
<> FastString -> Doc
ftext (JUOp -> FastString
uOpText JUOp
op)
BlockStat [JStat]
xs -> forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r ([JStat] -> [JStat]
flattenBlocks [JStat]
xs)
flattenBlocks :: [JStat] -> [JStat]
flattenBlocks :: [JStat] -> [JStat]
flattenBlocks = \case
BlockStat [JStat]
y:[JStat]
ys -> [JStat] -> [JStat]
flattenBlocks [JStat]
y forall a. [a] -> [a] -> [a]
++ [JStat] -> [JStat]
flattenBlocks [JStat]
ys
JStat
y:[JStat]
ys -> JStat
y forall a. a -> [a] -> [a]
: [JStat] -> [JStat]
flattenBlocks [JStat]
ys
[] -> []
optParens :: RenderJs -> JExpr -> Doc
optParens :: RenderJs -> JExpr -> Doc
optParens RenderJs
r JExpr
x = case JExpr
x of
UOpExpr JUOp
_ JExpr
_ -> Doc -> Doc
parens (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
x)
JExpr
_ -> forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
x
defRenderJsE :: RenderJs -> JExpr -> Doc
defRenderJsE :: RenderJs -> JExpr -> Doc
defRenderJsE RenderJs
r = \case
ValExpr JVal
x -> forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JVal
x
SelExpr JExpr
x Ident
y -> forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
x Doc -> Doc -> Doc
<> Char -> Doc
char Char
'.' Doc -> Doc -> Doc
<> forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r Ident
y
IdxExpr JExpr
x JExpr
y -> forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
x Doc -> Doc -> Doc
<> Doc -> Doc
brackets (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
y)
IfExpr JExpr
x JExpr
y JExpr
z -> Doc -> Doc
parens (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
x Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'?' Doc -> Doc -> Doc
<+> forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
y Doc -> Doc -> Doc
<+> Char -> Doc
char Char
':' Doc -> Doc -> Doc
<+> forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
z)
InfixExpr JOp
op JExpr
x JExpr
y -> Doc -> Doc
parens forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep [forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
x, FastString -> Doc
ftext (JOp -> FastString
opText JOp
op), forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
y]
UOpExpr JUOp
op JExpr
x
| JUOp -> Bool
isPre JUOp
op Bool -> Bool -> Bool
&& JUOp -> Bool
isAlphaOp JUOp
op -> FastString -> Doc
ftext (JUOp -> FastString
uOpText JUOp
op) Doc -> Doc -> Doc
<+> RenderJs -> JExpr -> Doc
optParens RenderJs
r JExpr
x
| JUOp -> Bool
isPre JUOp
op -> FastString -> Doc
ftext (JUOp -> FastString
uOpText JUOp
op) Doc -> Doc -> Doc
<> RenderJs -> JExpr -> Doc
optParens RenderJs
r JExpr
x
| Bool
otherwise -> RenderJs -> JExpr -> Doc
optParens RenderJs
r JExpr
x Doc -> Doc -> Doc
<> FastString -> Doc
ftext (JUOp -> FastString
uOpText JUOp
op)
ApplExpr JExpr
je [JExpr]
xs -> forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
je Doc -> Doc -> Doc
<> (Doc -> Doc
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r) [JExpr]
xs)
UnsatExpr IdentSupply JExpr
e -> forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r forall a b. (a -> b) -> a -> b
$ forall a. IdentSupply a -> a
pseudoSaturate IdentSupply JExpr
e
defRenderJsV :: RenderJs -> JVal -> Doc
defRenderJsV :: RenderJs -> JVal -> Doc
defRenderJsV RenderJs
r = \case
JVar Ident
i -> forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r Ident
i
JList [JExpr]
xs -> Doc -> Doc
brackets forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r) [JExpr]
xs
JDouble (SaneDouble Double
d)
| Double
d forall a. Ord a => a -> a -> Bool
< Double
0 Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isNegativeZero Double
d -> Doc -> Doc
parens (Double -> Doc
double Double
d)
| Bool
otherwise -> Double -> Doc
double Double
d
JInt Integer
i
| Integer
i forall a. Ord a => a -> a -> Bool
< Integer
0 -> Doc -> Doc
parens (Integer -> Doc
integer Integer
i)
| Bool
otherwise -> Integer -> Doc
integer Integer
i
JStr FastString
s -> FastString -> Doc
pprStringLit FastString
s
JRegEx FastString
s -> [Doc] -> Doc
hcat [Char -> Doc
char Char
'/',FastString -> Doc
ftext FastString
s, Char -> Doc
char Char
'/']
JHash UniqMap FastString JExpr
m
| forall k a. UniqMap k a -> Bool
isNullUniqMap UniqMap FastString JExpr
m -> String -> Doc
text String
"{}"
| Bool
otherwise -> Doc -> Doc
braceNest forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. (a -> b) -> [a] -> [b]
map (\(FastString
x,JExpr
y) -> Doc -> Doc
squotes (FastString -> Doc
ftext FastString
x) Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<+> forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
y)
forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (FastString -> LexicalFastString
LexicalFastString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall k a. UniqMap k a -> [(k, a)]
nonDetEltsUniqMap UniqMap FastString JExpr
m)
JFunc [Ident]
is JStat
b -> Doc -> Doc
parens forall a b. (a -> b) -> a -> b
$ Doc -> Doc -> Doc
hangBrace (String -> Doc
text String
"function" Doc -> Doc -> Doc
<> Doc -> Doc
parens ([Doc] -> Doc
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r) forall a b. (a -> b) -> a -> b
$ [Ident]
is)) (forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JStat
b)
UnsatVal IdentSupply JVal
f -> forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r forall a b. (a -> b) -> a -> b
$ forall a. IdentSupply a -> a
pseudoSaturate IdentSupply JVal
f
defRenderJsI :: RenderJs -> Ident -> Doc
defRenderJsI :: RenderJs -> Ident -> Doc
defRenderJsI RenderJs
_ (TxtI FastString
t) = FastString -> Doc
ftext FastString
t
pprStringLit :: FastString -> Doc
pprStringLit :: FastString -> Doc
pprStringLit FastString
s = [Doc] -> Doc
hcat [Char -> Doc
char Char
'\"',FastString -> Doc
encodeJson FastString
s, Char -> Doc
char Char
'\"']
encodeJson :: FastString -> Doc
encodeJson :: FastString -> Doc
encodeJson FastString
xs = [Doc] -> Doc
hcat (forall a b. (a -> b) -> [a] -> [b]
map Char -> Doc
encodeJsonChar (FastString -> String
unpackFS FastString
xs))
encodeJsonChar :: Char -> Doc
encodeJsonChar :: Char -> Doc
encodeJsonChar = \case
Char
'/' -> String -> Doc
text String
"\\/"
Char
'\b' -> String -> Doc
text String
"\\b"
Char
'\f' -> String -> Doc
text String
"\\f"
Char
'\n' -> String -> Doc
text String
"\\n"
Char
'\r' -> String -> Doc
text String
"\\r"
Char
'\t' -> String -> Doc
text String
"\\t"
Char
'"' -> String -> Doc
text String
"\\\""
Char
'\\' -> String -> Doc
text String
"\\\\"
Char
c
| Bool -> Bool
not (Char -> Bool
isControl Char
c) Bool -> Bool -> Bool
&& Char -> Int
ord Char
c forall a. Ord a => a -> a -> Bool
<= Int
127 -> Char -> Doc
char Char
c
| Char -> Int
ord Char
c forall a. Ord a => a -> a -> Bool
<= Int
0xff -> forall {a}. (Integral a, Show a) => String -> Int -> a -> Doc
hexxs String
"\\x" Int
2 (Char -> Int
ord Char
c)
| Char -> Int
ord Char
c forall a. Ord a => a -> a -> Bool
<= Int
0xffff -> forall {a}. (Integral a, Show a) => String -> Int -> a -> Doc
hexxs String
"\\u" Int
4 (Char -> Int
ord Char
c)
| Bool
otherwise -> let cp0 :: Int
cp0 = Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Int
0x10000
in forall {a}. (Integral a, Show a) => String -> Int -> a -> Doc
hexxs String
"\\u" Int
4 ((Int
cp0 forall a. Bits a => a -> Int -> a
`shiftR` Int
10) forall a. Num a => a -> a -> a
+ Int
0xd800) Doc -> Doc -> Doc
<>
forall {a}. (Integral a, Show a) => String -> Int -> a -> Doc
hexxs String
"\\u" Int
4 ((Int
cp0 forall a. Bits a => a -> a -> a
.&. Int
0x3ff) forall a. Num a => a -> a -> a
+ Int
0xdc00)
where hexxs :: String -> Int -> a -> Doc
hexxs String
prefix Int
pad a
cp =
let h :: String
h = forall a. (Integral a, Show a) => a -> ShowS
showHex a
cp String
""
in String -> Doc
text (String
prefix forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
pad forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
h) Char
'0' forall a. [a] -> [a] -> [a]
++ String
h)
uOpText :: JUOp -> FastString
uOpText :: JUOp -> FastString
uOpText = \case
JUOp
NotOp -> FastString
"!"
JUOp
BNotOp -> FastString
"~"
JUOp
NegOp -> FastString
"-"
JUOp
PlusOp -> FastString
"+"
JUOp
NewOp -> FastString
"new"
JUOp
TypeofOp -> FastString
"typeof"
JUOp
DeleteOp -> FastString
"delete"
JUOp
YieldOp -> FastString
"yield"
JUOp
VoidOp -> FastString
"void"
JUOp
PreIncOp -> FastString
"++"
JUOp
PostIncOp -> FastString
"++"
JUOp
PreDecOp -> FastString
"--"
JUOp
PostDecOp -> FastString
"--"
opText :: JOp -> FastString
opText :: JOp -> FastString
opText = \case
JOp
EqOp -> FastString
"=="
JOp
StrictEqOp -> FastString
"==="
JOp
NeqOp -> FastString
"!="
JOp
StrictNeqOp -> FastString
"!=="
JOp
GtOp -> FastString
">"
JOp
GeOp -> FastString
">="
JOp
LtOp -> FastString
"<"
JOp
LeOp -> FastString
"<="
JOp
AddOp -> FastString
"+"
JOp
SubOp -> FastString
"-"
JOp
MulOp -> FastString
"*"
JOp
DivOp -> FastString
"/"
JOp
ModOp -> FastString
"%"
JOp
LeftShiftOp -> FastString
"<<"
JOp
RightShiftOp -> FastString
">>"
JOp
ZRightShiftOp -> FastString
">>>"
JOp
BAndOp -> FastString
"&"
JOp
BOrOp -> FastString
"|"
JOp
BXorOp -> FastString
"^"
JOp
LAndOp -> FastString
"&&"
JOp
LOrOp -> FastString
"||"
JOp
InstanceofOp -> FastString
"instanceof"
JOp
InOp -> FastString
"in"
isPre :: JUOp -> Bool
isPre :: JUOp -> Bool
isPre = \case
JUOp
PostIncOp -> Bool
False
JUOp
PostDecOp -> Bool
False
JUOp
_ -> Bool
True
isAlphaOp :: JUOp -> Bool
isAlphaOp :: JUOp -> Bool
isAlphaOp = \case
JUOp
NewOp -> Bool
True
JUOp
TypeofOp -> Bool
True
JUOp
DeleteOp -> Bool
True
JUOp
YieldOp -> Bool
True
JUOp
VoidOp -> Bool
True
JUOp
_ -> Bool
False