{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE BlockArguments #-}

-- For Outputable instances for JS syntax
{-# OPTIONS_GHC -Wno-orphans #-}

-- | Pretty-printing JavaScript
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

-- | Render a syntax tree as a pretty-printable document
-- (simply showing the resultant doc produces a nice,
-- well formatted String).
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

-- | Render a syntax tree as a pretty-printable document, using a given prefix
-- to all generated names. Use this with distinct prefixes to ensure distinct
-- generated names between independent calls to render(Prefix)Js.
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
'}'

-- | Hang with braces:
--
--  hdr {
--    body
--  }
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
    -- special treatment for functions, otherwise there is too much left padding
    -- (more than the length of the expression assigned to). E.g.
    --
    --    var long_variable_name = (function()
    --                               {
    --                               ...
    --                             });
    --
    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)
                          -- nonDetEltsUniqMap doesn't introduce non-determinism here
                          -- because we sort the elements lexically
                          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 -- output surrogate pair
                        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