{-# 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 (Doc -> SDoc) -> (JExpr -> Doc) -> JExpr -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JExpr -> Doc
forall a. (JsToDoc a, JMacro a) => a -> Doc
renderJs
instance Outputable JVal where
ppr :: JVal -> SDoc
ppr = Doc -> SDoc
docToSDoc (Doc -> SDoc) -> (JVal -> Doc) -> JVal -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JVal -> Doc
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 (Doc -> Doc) -> Doc -> Doc
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 = RenderJs -> a -> Doc
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 = RenderJs -> a -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r (a -> Doc) -> (a -> a) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FastString -> a -> a
forall a. JMacro a => Maybe FastString -> a -> a
jsSaturate Maybe FastString
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 = RenderJs -> a -> Doc
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 = RenderJs -> FastString -> a -> Doc
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 = RenderJs -> a -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r (a -> Doc) -> (a -> a) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FastString -> a -> a
forall a. JMacro a => Maybe FastString -> a -> a
jsSaturate (FastString -> Maybe FastString
forall a. a -> Maybe a
Just (FastString -> Maybe FastString) -> FastString -> Maybe FastString
forall a b. (a -> b) -> a -> b
$ FastString
"jmId_" FastString -> FastString -> FastString
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 ([Doc] -> Doc) -> ([JExpr] -> [Doc]) -> [JExpr] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JExpr -> Doc) -> [JExpr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc -> Doc -> Doc
<> Doc
semi) (Doc -> Doc) -> (JExpr -> Doc) -> JExpr -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderJs -> JExpr -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r)
instance JsToDoc [JStat] where
jsToDocR :: RenderJs -> [JStat] -> Doc
jsToDocR RenderJs
r = [Doc] -> Doc
vcat ([Doc] -> Doc) -> ([JStat] -> [Doc]) -> [JStat] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JStat -> Doc) -> [JStat] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc -> Doc -> Doc
<> Doc
semi) (Doc -> Doc) -> (JStat -> Doc) -> JStat -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderJs -> JStat -> Doc
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 (RenderJs -> JExpr -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
cond))
(RenderJs -> JStat -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JStat
x)
Doc -> Doc -> Doc
$$ Doc
mbElse
where mbElse :: Doc
mbElse | JStat
y JStat -> JStat -> Bool
forall a. Eq a => a -> a -> Bool
== [JStat] -> JStat
BlockStat [] = Doc
PP.empty
| Bool
otherwise = Doc -> Doc -> Doc
hangBrace (String -> Doc
text String
"else") (RenderJs -> JStat -> Doc
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
<+> RenderJs -> Ident -> 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
<+> RenderJs -> Ident -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r Ident
x Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<+> RenderJs -> JExpr -> 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 (RenderJs -> JExpr -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
p)) (RenderJs -> JStat -> Doc
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") (RenderJs -> JStat -> Doc
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 (RenderJs -> JExpr -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
p)
UnsatBlock IdentSupply JStat
e -> RenderJs -> JStat -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r (JStat -> Doc) -> JStat -> Doc
forall a b. (a -> b) -> a -> b
$ IdentSupply JStat -> JStat
forall a. IdentSupply a -> a
pseudoSaturate IdentSupply JStat
e
BreakStat Maybe LexicalFastString
l -> Doc -> (LexicalFastString -> Doc) -> Maybe LexicalFastString -> Doc
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 -> Doc -> (LexicalFastString -> Doc) -> Maybe LexicalFastString -> Doc
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 ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [JStat] -> [Doc]
interSemi ([JStat] -> [Doc]) -> [JStat] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [JStat] -> [JStat]
flattenBlocks [JStat]
ss
printBS JStat
x = RenderJs -> JStat -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JStat
x
interSemi :: [JStat] -> [Doc]
interSemi [JStat
x] = [RenderJs -> JStat -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JStat
x]
interSemi [] = []
interSemi (JStat
x:[JStat]
xs) = (RenderJs -> JStat -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JStat
x Doc -> Doc -> Doc
<> Doc
semi) Doc -> [Doc] -> [Doc]
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 (RenderJs -> Ident -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r Ident
i Doc -> Doc -> Doc
<+> String -> Doc
text String
"in" Doc -> Doc -> Doc
<+> RenderJs -> JExpr -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
e)) (RenderJs -> JStat -> Doc
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 (RenderJs -> JExpr -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
e)) Doc
cases
where l' :: [Doc]
l' = ((JExpr, JStat) -> Doc) -> [(JExpr, JStat)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(JExpr
c,JStat
s) -> (String -> Doc
text String
"case" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (RenderJs -> JExpr -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
c) Doc -> Doc -> Doc
<> Char -> Doc
char Char
':') Doc -> Doc -> Doc
$$$ (RenderJs -> JStat -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JStat
s)) [(JExpr, JStat)]
l [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"default:" Doc -> Doc -> Doc
$$$ (RenderJs -> JStat -> 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
<+> RenderJs -> JExpr -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
e
ApplStat JExpr
e [JExpr]
es -> RenderJs -> JExpr -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
e Doc -> Doc -> Doc
<> (Doc -> Doc
parens (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (JExpr -> Doc) -> [JExpr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (RenderJs -> JExpr -> Doc
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") (RenderJs -> JStat -> Doc
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 JStat -> JStat -> Bool
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 (RenderJs -> Ident -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r Ident
i)) (RenderJs -> JStat -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JStat
s1)
mbFinally :: Doc
mbFinally | JStat
s2 JStat -> JStat -> Bool
forall a. Eq a => a -> a -> Bool
== [JStat] -> JStat
BlockStat [] = Doc
PP.empty
| Bool
otherwise = Doc -> Doc -> Doc
hangBrace (String -> Doc
text String
"finally") (RenderJs -> JStat -> Doc
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 [RenderJs -> JExpr -> Doc
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 ([Doc] -> Doc) -> ([Ident] -> [Doc]) -> [Ident] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([Ident] -> [Doc]) -> [Ident] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ident -> Doc) -> [Ident] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (RenderJs -> Ident -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r) ([Ident] -> Doc) -> [Ident] -> Doc
forall a b. (a -> b) -> a -> b
$ [Ident]
is) Doc -> Doc -> Doc
<> Char -> Doc
char Char
'{', Int -> Doc -> Doc
nest Int
2 (RenderJs -> JStat -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JStat
b), String -> Doc
text String
"}"]
JExpr
_ -> RenderJs -> JExpr -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
i Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<+> RenderJs -> JExpr -> 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 -> RenderJs -> [JStat] -> Doc
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 [JStat] -> [JStat] -> [JStat]
forall a. [a] -> [a] -> [a]
++ [JStat] -> [JStat]
flattenBlocks [JStat]
ys
JStat
y:[JStat]
ys -> JStat
y JStat -> [JStat] -> [JStat]
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 (RenderJs -> JExpr -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
x)
JExpr
_ -> RenderJs -> JExpr -> Doc
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 -> RenderJs -> JVal -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JVal
x
SelExpr JExpr
x Ident
y -> RenderJs -> JExpr -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
x Doc -> Doc -> Doc
<> Char -> Doc
char Char
'.' Doc -> Doc -> Doc
<> RenderJs -> Ident -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r Ident
y
IdxExpr JExpr
x JExpr
y -> RenderJs -> JExpr -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
x Doc -> Doc -> Doc
<> Doc -> Doc
brackets (RenderJs -> JExpr -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
y)
IfExpr JExpr
x JExpr
y JExpr
z -> Doc -> Doc
parens (RenderJs -> JExpr -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
x Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'?' Doc -> Doc -> Doc
<+> RenderJs -> JExpr -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
y Doc -> Doc -> Doc
<+> Char -> Doc
char Char
':' Doc -> Doc -> Doc
<+> RenderJs -> JExpr -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
z)
InfixExpr JOp
op JExpr
x JExpr
y -> Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep [RenderJs -> JExpr -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
x, FastString -> Doc
ftext (JOp -> FastString
opText JOp
op), RenderJs -> JExpr -> Doc
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 -> RenderJs -> JExpr -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
je Doc -> Doc -> Doc
<> (Doc -> Doc
parens (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (JExpr -> Doc) -> [JExpr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (RenderJs -> JExpr -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r) [JExpr]
xs)
UnsatExpr IdentSupply JExpr
e -> RenderJs -> JExpr -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r (JExpr -> Doc) -> JExpr -> Doc
forall a b. (a -> b) -> a -> b
$ IdentSupply JExpr -> JExpr
forall a. IdentSupply a -> a
pseudoSaturate IdentSupply JExpr
e
defRenderJsV :: RenderJs -> JVal -> Doc
defRenderJsV :: RenderJs -> JVal -> Doc
defRenderJsV RenderJs
r = \case
JVar Ident
i -> RenderJs -> Ident -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r Ident
i
JList [JExpr]
xs -> Doc -> Doc
brackets (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (JExpr -> Doc) -> [JExpr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (RenderJs -> JExpr -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r) [JExpr]
xs
JDouble (SaneDouble Double
d)
| Double
d Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 Bool -> Bool -> Bool
|| Double -> 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 Integer -> Integer -> Bool
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
| UniqMap FastString JExpr -> Bool
forall k a. UniqMap k a -> Bool
isNullUniqMap UniqMap FastString JExpr
m -> String -> Doc
text String
"{}"
| Bool
otherwise -> Doc -> Doc
braceNest (Doc -> Doc)
-> ([(FastString, JExpr)] -> Doc) -> [(FastString, JExpr)] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hsep ([Doc] -> Doc)
-> ([(FastString, JExpr)] -> [Doc]) -> [(FastString, JExpr)] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc])
-> ([(FastString, JExpr)] -> [Doc])
-> [(FastString, JExpr)]
-> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((FastString, JExpr) -> Doc) -> [(FastString, JExpr)] -> [Doc]
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
<+> RenderJs -> JExpr -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JExpr
y)
([(FastString, JExpr)] -> Doc) -> [(FastString, JExpr)] -> Doc
forall a b. (a -> b) -> a -> b
$ ((FastString, JExpr) -> LexicalFastString)
-> [(FastString, JExpr)] -> [(FastString, JExpr)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (FastString -> LexicalFastString
LexicalFastString (FastString -> LexicalFastString)
-> ((FastString, JExpr) -> FastString)
-> (FastString, JExpr)
-> LexicalFastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FastString, JExpr) -> FastString
forall a b. (a, b) -> a
fst) (UniqMap FastString JExpr -> [(FastString, JExpr)]
forall k a. UniqMap k a -> [(k, a)]
nonDetEltsUniqMap UniqMap FastString JExpr
m)
JFunc [Ident]
is JStat
b -> Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
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 ([Doc] -> Doc) -> ([Ident] -> [Doc]) -> [Ident] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([Ident] -> [Doc]) -> [Ident] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ident -> Doc) -> [Ident] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (RenderJs -> Ident -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r) ([Ident] -> Doc) -> [Ident] -> Doc
forall a b. (a -> b) -> a -> b
$ [Ident]
is)) (RenderJs -> JStat -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r JStat
b)
UnsatVal IdentSupply JVal
f -> RenderJs -> JVal -> Doc
forall a. JsToDoc a => RenderJs -> a -> Doc
jsToDocR RenderJs
r (JVal -> Doc) -> JVal -> Doc
forall a b. (a -> b) -> a -> b
$ IdentSupply JVal -> JVal
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 ((Char -> Doc) -> String -> [Doc]
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
127 -> Char -> Doc
char Char
c
| Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xff -> String -> Int -> Int -> Doc
forall {a}. Integral a => String -> Int -> a -> Doc
hexxs String
"\\x" Int
2 (Char -> Int
ord Char
c)
| Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xffff -> String -> Int -> Int -> Doc
forall {a}. Integral 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x10000
in String -> Int -> Int -> Doc
forall {a}. Integral a => String -> Int -> a -> Doc
hexxs String
"\\u" Int
4 ((Int
cp0 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
10) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xd800) Doc -> Doc -> Doc
<>
String -> Int -> Int -> Doc
forall {a}. Integral a => String -> Int -> a -> Doc
hexxs String
"\\u" Int
4 ((Int
cp0 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3ff) Int -> Int -> Int
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 = a -> ShowS
forall a. Integral a => a -> ShowS
showHex a
cp String
""
in String -> Doc
text (String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
pad Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
h) Char
'0' String -> ShowS
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