{-# 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 #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.JS.Ppr
-- Copyright   :  (c) The University of Glasgow 2001
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Jeffrey Young  <jeffrey.young@iohk.io>
--                Luite Stegeman <luite.stegeman@iohk.io>
--                Sylvain Henry  <sylvain.henry@iohk.io>
--                Josh Meredith  <josh.meredith@iohk.io>
-- Stability   :  experimental
--
--
-- * Domain and Purpose
--
--     GHC.JS.Ppr defines the code generation facilities for the JavaScript
--     backend. That is, this module exports a function from the JS backend IR
--     to JavaScript compliant concrete syntax that can readily be executed by
--     nodejs or called in a browser.
--
-- * Design
--
--     This module follows the architecture and style of the other backends in
--     GHC: it instances Outputable for the relevant types, creates a class that
--     describes a morphism from the IR domain to JavaScript concrete Syntax and
--     then generates that syntax on a case by case basis.
--
-- * How to use
--
--     The key functions are @renderJS@, @jsToDoc@, and the @RenderJS@ record.
--     Use the @RenderJS@ record and @jsToDoc@ to define a custom renderers for
--     specific parts of the backend, for example in 'GHC.StgToJS.Linker.Opt' a
--     custom renderer ensures all @Ident@ generated by the linker optimization
--     pass are prefixed differently than the default. Use @renderJS@ to
--     generate JavaScript concrete syntax in the general case, suitable for
--     human consumption.
-----------------------------------------------------------------------------

module GHC.JS.Ppr
  ( renderJs
  , renderPrefixJs
  , renderPrefixJs'
  , JsToDoc(..)
  , defaultRenderJs
  , RenderJs(..)
  , JsRender(..)
  , jsToDoc
  , pprStringLit
  , interSemi
  , braceNest
  , hangBrace
  )
where

import GHC.Prelude

import GHC.JS.Ident
import GHC.JS.Syntax

import Data.Char (isControl, ord)
import Data.List (sortOn)

import Numeric(showHex)

import GHC.Utils.Outputable
import GHC.Data.FastString
import GHC.Types.Unique.Map

instance Outputable JExpr where
  ppr :: JExpr -> SDoc
ppr = JExpr -> SDoc
forall a. JsToDoc a => a -> SDoc
renderJs

instance Outputable JVal where
  ppr :: JVal -> SDoc
ppr = JVal -> SDoc
forall a. JsToDoc a => a -> SDoc
renderJs

--------------------------------------------------------------------------------
--                            Top level API
--------------------------------------------------------------------------------

-- | Render a syntax tree as a pretty-printable document
-- (simply showing the resultant doc produces a nice,
-- well formatted String).
renderJs :: (JsToDoc a) => a -> SDoc
renderJs :: forall a. JsToDoc a => a -> SDoc
renderJs = RenderJs SDoc -> a -> SDoc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
renderJs' RenderJs SDoc
forall doc. RenderJs doc
defaultRenderJs

{-# SPECIALISE renderJs' :: JsToDoc a => RenderJs HLine -> a -> HLine #-}
{-# SPECIALISE renderJs' :: JsToDoc a => RenderJs SDoc  -> a -> SDoc  #-}
renderJs' :: (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
renderJs' :: forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
renderJs' RenderJs doc
r = RenderJs doc -> a -> doc
forall doc. JsRender doc => RenderJs doc -> a -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r

data RenderJs doc = RenderJs
  { forall doc.
RenderJs doc -> JsRender doc => RenderJs doc -> JStat -> doc
renderJsS :: !(JsRender doc => RenderJs doc -> JStat -> doc)
  , forall doc.
RenderJs doc -> JsRender doc => RenderJs doc -> JExpr -> doc
renderJsE :: !(JsRender doc => RenderJs doc -> JExpr -> doc)
  , forall doc.
RenderJs doc -> JsRender doc => RenderJs doc -> JVal -> doc
renderJsV :: !(JsRender doc => RenderJs doc -> JVal  -> doc)
  , forall doc.
RenderJs doc -> JsRender doc => RenderJs doc -> Ident -> doc
renderJsI :: !(JsRender doc => RenderJs doc -> Ident -> doc)
  }

defaultRenderJs :: RenderJs doc
defaultRenderJs :: forall doc. RenderJs doc
defaultRenderJs = (JsRender doc => RenderJs doc -> JStat -> doc)
-> (JsRender doc => RenderJs doc -> JExpr -> doc)
-> (JsRender doc => RenderJs doc -> JVal -> doc)
-> (JsRender doc => RenderJs doc -> Ident -> doc)
-> RenderJs doc
forall doc.
(JsRender doc => RenderJs doc -> JStat -> doc)
-> (JsRender doc => RenderJs doc -> JExpr -> doc)
-> (JsRender doc => RenderJs doc -> JVal -> doc)
-> (JsRender doc => RenderJs doc -> Ident -> doc)
-> RenderJs doc
RenderJs JsRender doc => RenderJs doc -> JStat -> doc
RenderJs doc -> JStat -> doc
forall doc. JsRender doc => RenderJs doc -> JStat -> doc
defRenderJsS JsRender doc => RenderJs doc -> JExpr -> doc
RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
defRenderJsE JsRender doc => RenderJs doc -> JVal -> doc
RenderJs doc -> JVal -> doc
forall doc. JsRender doc => RenderJs doc -> JVal -> doc
defRenderJsV JsRender doc => RenderJs doc -> Ident -> doc
RenderJs doc -> Ident -> doc
forall doc. JsRender doc => RenderJs doc -> Ident -> doc
defRenderJsI

jsToDoc :: JsToDoc a => a -> SDoc
jsToDoc :: forall a. JsToDoc a => a -> SDoc
jsToDoc = RenderJs SDoc -> a -> SDoc
forall doc. JsRender doc => RenderJs doc -> a -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs SDoc
forall doc. RenderJs doc
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) => a -> SDoc
renderPrefixJs :: forall a. JsToDoc a => a -> SDoc
renderPrefixJs = RenderJs SDoc -> a -> SDoc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
renderPrefixJs' RenderJs SDoc
forall doc. RenderJs doc
defaultRenderJs

renderPrefixJs' :: (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
renderPrefixJs' :: forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
renderPrefixJs' RenderJs doc
r = RenderJs doc -> a -> doc
forall doc. JsRender doc => RenderJs doc -> a -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r

--------------------------------------------------------------------------------
--                            Code Generator
--------------------------------------------------------------------------------

class JsToDoc a where jsToDocR :: JsRender doc => RenderJs doc -> a -> doc
instance JsToDoc JStat   where jsToDocR :: forall doc. JsRender doc => RenderJs doc -> JStat -> doc
jsToDocR RenderJs doc
r = RenderJs doc -> JsRender doc => RenderJs doc -> JStat -> doc
forall doc.
RenderJs doc -> JsRender doc => RenderJs doc -> JStat -> doc
renderJsS RenderJs doc
r RenderJs doc
r
instance JsToDoc JExpr   where jsToDocR :: forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
jsToDocR RenderJs doc
r = RenderJs doc -> JsRender doc => RenderJs doc -> JExpr -> doc
forall doc.
RenderJs doc -> JsRender doc => RenderJs doc -> JExpr -> doc
renderJsE RenderJs doc
r RenderJs doc
r
instance JsToDoc JVal    where jsToDocR :: forall doc. JsRender doc => RenderJs doc -> JVal -> doc
jsToDocR RenderJs doc
r = RenderJs doc -> JsRender doc => RenderJs doc -> JVal -> doc
forall doc.
RenderJs doc -> JsRender doc => RenderJs doc -> JVal -> doc
renderJsV RenderJs doc
r RenderJs doc
r
instance JsToDoc Ident   where jsToDocR :: forall doc. JsRender doc => RenderJs doc -> Ident -> doc
jsToDocR RenderJs doc
r = RenderJs doc -> JsRender doc => RenderJs doc -> Ident -> doc
forall doc.
RenderJs doc -> JsRender doc => RenderJs doc -> Ident -> doc
renderJsI RenderJs doc
r RenderJs doc
r
instance JsToDoc [JExpr] where jsToDocR :: forall doc. JsRender doc => RenderJs doc -> [JExpr] -> doc
jsToDocR RenderJs doc
r = [doc] -> doc
forall doc. JsRender doc => [doc] -> doc
jcat ([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
forall doc. JsRender doc => doc -> doc
addSemi (doc -> doc) -> (JExpr -> doc) -> JExpr -> doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r)
instance JsToDoc [JStat] where jsToDocR :: forall doc. JsRender doc => RenderJs doc -> [JStat] -> doc
jsToDocR RenderJs doc
r = [doc] -> doc
forall doc. JsRender doc => [doc] -> doc
jcat ([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
forall doc. JsRender doc => doc -> doc
addSemi (doc -> doc) -> (JStat -> doc) -> JStat -> doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderJs doc -> JStat -> doc
forall doc. JsRender doc => RenderJs doc -> JStat -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r)

defRenderJsS :: JsRender doc => RenderJs doc -> JStat -> doc
defRenderJsS :: forall doc. JsRender doc => RenderJs doc -> JStat -> doc
defRenderJsS RenderJs doc
r = \case
  IfStat JExpr
cond JStat
x JStat
y -> [doc] -> doc
forall doc. JsRender doc => [doc] -> doc
jcat
                        [ doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
hangBrace (String -> doc
forall doc. IsLine doc => String -> doc
text String
"if" doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
<+?> doc -> doc
forall doc. IsLine doc => doc -> doc
parens (RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JExpr
cond)) (RenderJs doc -> JStat -> doc
forall doc. JsRender doc => RenderJs doc -> JStat -> doc
optBlock RenderJs doc
r JStat
x)
                        , doc
mbElse
                        ]
        where mbElse :: doc
mbElse | JStat
y JStat -> JStat -> Bool
forall a. Eq a => a -> a -> Bool
== [JStat] -> JStat
BlockStat []  = doc
forall doc. IsOutput doc => doc
empty
                     | Bool
otherwise = doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
hangBrace (String -> doc
forall doc. IsLine doc => String -> doc
text String
"else") (RenderJs doc -> JStat -> doc
forall doc. JsRender doc => RenderJs doc -> JStat -> doc
optBlock RenderJs doc
r JStat
y)
  DeclStat Ident
x Maybe JExpr
Nothing  -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"var" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> RenderJs doc -> Ident -> doc
forall doc. JsRender doc => RenderJs doc -> Ident -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r Ident
x
    -- 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()
    --                               {
    --                               ...
    --                             });
    --
  DeclStat Ident
x (Just (ValExpr f :: JVal
f@(JFunc {}))) -> doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
jhang (String -> doc
forall doc. IsLine doc => String -> doc
text String
"var" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> RenderJs doc -> Ident -> doc
forall doc. JsRender doc => RenderJs doc -> Ident -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r Ident
x doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
<+?> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'=') (RenderJs doc -> JVal -> doc
forall doc. JsRender doc => RenderJs doc -> JVal -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JVal
f)
  DeclStat Ident
x (Just JExpr
e) -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"var" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> RenderJs doc -> Ident -> doc
forall doc. JsRender doc => RenderJs doc -> Ident -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r Ident
x doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
<+?> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'=' doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
<+?> RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JExpr
e
  WhileStat Bool
False JExpr
p JStat
b -> doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
hangBrace (String -> doc
forall doc. IsLine doc => String -> doc
text String
"while" doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
<+?> doc -> doc
forall doc. IsLine doc => doc -> doc
parens (RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JExpr
p)) (RenderJs doc -> JStat -> doc
forall doc. JsRender doc => RenderJs doc -> JStat -> doc
optBlock RenderJs doc
r JStat
b)
  WhileStat Bool
True  JExpr
p JStat
b -> doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
hangBrace (String -> doc
forall doc. IsLine doc => String -> doc
text String
"do") (RenderJs doc -> JStat -> doc
forall doc. JsRender doc => RenderJs doc -> JStat -> doc
optBlock RenderJs doc
r JStat
b) doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
<+?> String -> doc
forall doc. IsLine doc => String -> doc
text String
"while" doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
<+?> doc -> doc
forall doc. IsLine doc => doc -> doc
parens (RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JExpr
p)
  BreakStat Maybe JLabel
l         -> doc -> doc
forall doc. JsRender doc => doc -> doc
addSemi (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ doc -> (JLabel -> doc) -> Maybe JLabel -> doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> doc
forall doc. IsLine doc => String -> doc
text String
"break")    (\(LexicalFastString FastString
s) -> (String -> doc
forall doc. IsLine doc => String -> doc
text String
"break"    doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext FastString
s)) Maybe JLabel
l
  ContinueStat Maybe JLabel
l      -> doc -> doc
forall doc. JsRender doc => doc -> doc
addSemi (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ doc -> (JLabel -> doc) -> Maybe JLabel -> doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> doc
forall doc. IsLine doc => String -> doc
text String
"continue") (\(LexicalFastString FastString
s) -> (String -> doc
forall doc. IsLine doc => String -> doc
text String
"continue" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext FastString
s)) Maybe JLabel
l
  LabelStat (LexicalFastString FastString
l) JStat
s -> FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext FastString
l doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
':' doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
$$$ JStat -> doc
printBS JStat
s
        where
          printBS :: JStat -> doc
printBS (BlockStat [JStat]
ss) = [doc] -> doc
forall doc. JsRender doc => [doc] -> doc
interSemi ([doc] -> doc) -> [doc] -> doc
forall a b. (a -> b) -> a -> b
$ (JStat -> doc) -> [JStat] -> [doc]
forall a b. (a -> b) -> [a] -> [b]
map (RenderJs doc -> JStat -> doc
forall doc. JsRender doc => RenderJs doc -> JStat -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r) [JStat]
ss
          printBS JStat
x = RenderJs doc -> JStat -> doc
forall doc. JsRender doc => RenderJs doc -> JStat -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JStat
x

  ForStat JStat
init JExpr
p JStat
s1 JStat
sb -> doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
hangBrace (String -> doc
forall doc. IsLine doc => String -> doc
text String
"for" doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
<+?> doc -> doc
forall doc. IsLine doc => doc -> doc
parens doc
forCond) (RenderJs doc -> JStat -> doc
forall doc. JsRender doc => RenderJs doc -> JStat -> doc
optBlock RenderJs doc
r JStat
sb)
    where
      forCond :: doc
forCond = RenderJs doc -> JStat -> doc
forall doc. JsRender doc => RenderJs doc -> JStat -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JStat
init doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
forall doc. IsLine doc => doc
semi doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
<+?> RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JExpr
p doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
forall doc. IsLine doc => doc
semi doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
<+?> doc -> doc
forall doc. IsLine doc => doc -> doc
parens (RenderJs doc -> JStat -> doc
forall doc. JsRender doc => RenderJs doc -> JStat -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JStat
s1)
  ForInStat Bool
each Ident
i JExpr
e JStat
b -> doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
hangBrace (String -> doc
forall doc. IsLine doc => String -> doc
text String
txt doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
<+?> doc -> doc
forall doc. IsLine doc => doc -> doc
parens (RenderJs doc -> Ident -> doc
forall doc. JsRender doc => RenderJs doc -> Ident -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r Ident
i doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> doc
forall doc. IsLine doc => String -> doc
text String
"in" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JExpr
e)) (RenderJs doc -> JStat -> doc
forall doc. JsRender doc => RenderJs doc -> JStat -> doc
optBlock RenderJs doc
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
forall doc. JsRender doc => doc -> doc -> doc
hangBrace (String -> doc
forall doc. IsLine doc => String -> doc
text String
"switch" doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
<+?> doc -> doc
forall doc. IsLine doc => doc -> doc
parens (RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
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
forall doc. IsLine doc => String -> doc
text String
"case" doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
<+?> doc -> doc
forall doc. IsLine doc => doc -> doc
parens (RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JExpr
c) doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
forall doc. IsLine doc => doc
colon) doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
$$$ doc -> doc
forall doc. JsRender doc => doc -> doc
jnest (RenderJs doc -> JStat -> doc
forall doc. JsRender doc => RenderJs doc -> JStat -> doc
optBlock RenderJs doc
r JStat
s)) [(JExpr, JStat)]
l
                   [doc] -> [doc] -> [doc]
forall a. [a] -> [a] -> [a]
++ [(String -> doc
forall doc. IsLine doc => String -> doc
text String
"default:") doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
$$$ doc -> doc
forall doc. JsRender doc => doc -> doc
jnest (RenderJs doc -> JStat -> doc
forall doc. JsRender doc => RenderJs doc -> JStat -> doc
optBlock RenderJs doc
r JStat
d)]
              cases :: doc
cases = (doc -> doc -> doc) -> [doc] -> doc
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
($$$) [doc]
l'
  ReturnStat JExpr
e      -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"return" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JExpr
e
  ApplStat JExpr
e [JExpr]
es     -> RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JExpr
e doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> (doc -> doc
forall doc. IsLine doc => doc -> doc
parens (doc -> doc) -> ([doc] -> doc) -> [doc] -> doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (doc -> doc -> doc) -> doc -> [doc] -> doc
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
(<+?>) doc
forall doc. IsOutput doc => doc
empty ([doc] -> doc) -> ([doc] -> [doc]) -> [doc] -> doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. doc -> [doc] -> [doc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate doc
forall doc. IsLine doc => 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 doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r) [JExpr]
es)
  FuncStat Ident
i [Ident]
is JStat
b   -> doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
hangBrace (String -> doc
forall doc. IsLine doc => String -> doc
text String
"function" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> RenderJs doc -> Ident -> doc
forall doc. JsRender doc => RenderJs doc -> Ident -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r Ident
i
                                  doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc -> doc
forall doc. IsLine doc => doc -> doc
parens ((doc -> doc -> doc) -> doc -> [doc] -> doc
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
(<+?>) doc
forall doc. IsOutput doc => doc
empty ([doc] -> doc) -> ([Ident] -> [doc]) -> [Ident] -> doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. doc -> [doc] -> [doc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate doc
forall doc. IsLine doc => 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 doc -> Ident -> doc
forall doc. JsRender doc => RenderJs doc -> Ident -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r) ([Ident] -> doc) -> [Ident] -> doc
forall a b. (a -> b) -> a -> b
$ [Ident]
is))
                             (RenderJs doc -> JStat -> doc
forall doc. JsRender doc => RenderJs doc -> JStat -> doc
optBlock RenderJs doc
r JStat
b)
  TryStat JStat
s Ident
i JStat
s1 JStat
s2 -> doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
hangBrace (String -> doc
forall doc. IsLine doc => String -> doc
text String
"try") (RenderJs doc -> JStat -> doc
forall doc. JsRender doc => RenderJs doc -> JStat -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JStat
s) doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
<+?> doc
mbCatch doc -> doc -> doc
forall doc. JsRender doc => 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
forall doc. IsOutput doc => doc
empty
                      | Bool
otherwise = doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
hangBrace (String -> doc
forall doc. IsLine doc => String -> doc
text String
"catch" doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
<+?> doc -> doc
forall doc. IsLine doc => doc -> doc
parens (RenderJs doc -> Ident -> doc
forall doc. JsRender doc => RenderJs doc -> Ident -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r Ident
i)) (RenderJs doc -> JStat -> doc
forall doc. JsRender doc => RenderJs doc -> JStat -> doc
optBlock RenderJs doc
r JStat
s1)
              mbFinally :: doc
mbFinally | JStat
s2 JStat -> JStat -> Bool
forall a. Eq a => a -> a -> Bool
== [JStat] -> JStat
BlockStat [] = doc
forall doc. IsOutput doc => doc
empty
                        | Bool
otherwise = doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
hangBrace (String -> doc
forall doc. IsLine doc => String -> doc
text String
"finally") (RenderJs doc -> JStat -> doc
forall doc. JsRender doc => RenderJs doc -> JStat -> doc
optBlock RenderJs doc
r JStat
s2)
  AssignStat JExpr
i AOp
op 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.
    --
    --    long_variable_name = (function()
    --                               {
    --                               ...
    --                             });
    --
    ValExpr f :: JVal
f@(JFunc {}) -> doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
jhang (RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JExpr
i doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext (AOp -> FastString
aOpText AOp
op)) (RenderJs doc -> JVal -> doc
forall doc. JsRender doc => RenderJs doc -> JVal -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JVal
f)
    JExpr
_                    -> RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JExpr
i doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
<+?> FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext (AOp -> FastString
aOpText AOp
op) doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
<+?> RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JExpr
x
  UOpStat UOp
op JExpr
x
    | UOp -> Bool
isPre UOp
op Bool -> Bool -> Bool
&& UOp -> Bool
isAlphaOp UOp
op -> FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext (UOp -> FastString
uOpText UOp
op) doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
optParens RenderJs doc
r JExpr
x
    | UOp -> Bool
isPre UOp
op                 -> FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext (UOp -> FastString
uOpText UOp
op) doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
optParens RenderJs doc
r JExpr
x
    | Bool
otherwise                -> RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
optParens RenderJs doc
r JExpr
x doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext (UOp -> FastString
uOpText UOp
op)
  BlockStat [JStat]
xs -> RenderJs doc -> [JStat] -> doc
forall doc. JsRender doc => RenderJs doc -> [JStat] -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r [JStat]
xs

-- | Remove one Block layering if we know we already have braces around the
-- statement
optBlock :: JsRender doc => RenderJs doc -> JStat -> doc
optBlock :: forall doc. JsRender doc => RenderJs doc -> JStat -> doc
optBlock RenderJs doc
r JStat
x = case JStat
x of
  BlockStat{} -> RenderJs doc -> JStat -> doc
forall doc. JsRender doc => RenderJs doc -> JStat -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JStat
x
  JStat
_           -> doc -> doc
forall doc. JsRender doc => doc -> doc
addSemi (RenderJs doc -> JStat -> doc
forall doc. JsRender doc => RenderJs doc -> JStat -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JStat
x)

optParens :: JsRender doc => RenderJs doc -> JExpr -> doc
optParens :: forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
optParens RenderJs doc
r JExpr
x = case JExpr
x of
  UOpExpr UOp
_ JExpr
_ -> doc -> doc
forall doc. IsLine doc => doc -> doc
parens (RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JExpr
x)
  JExpr
_           -> RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JExpr
x

defRenderJsE :: JsRender doc => RenderJs doc -> JExpr -> doc
defRenderJsE :: forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
defRenderJsE RenderJs doc
r = \case
  ValExpr JVal
x         -> RenderJs doc -> JVal -> doc
forall doc. JsRender doc => RenderJs doc -> JVal -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JVal
x
  SelExpr JExpr
x Ident
y       -> RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JExpr
x doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'.' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> RenderJs doc -> Ident -> doc
forall doc. JsRender doc => RenderJs doc -> Ident -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r Ident
y
  IdxExpr JExpr
x JExpr
y       -> RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JExpr
x doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc -> doc
forall doc. IsLine doc => doc -> doc
brackets (RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JExpr
y)
  IfExpr JExpr
x JExpr
y JExpr
z      -> doc -> doc
forall doc. IsLine doc => doc -> doc
parens (RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JExpr
x doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
<+?> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'?' doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
<+?> RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JExpr
y doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
<+?> doc
forall doc. IsLine doc => doc
colon doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
<+?> RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JExpr
z)
  InfixExpr Op
op JExpr
x JExpr
y  -> doc -> doc
forall doc. IsLine doc => doc -> doc
parens (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JExpr
x doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
<+?> FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext (Op -> FastString
opText Op
op) doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
<+?> RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JExpr
y
  UOpExpr UOp
op JExpr
x
    | UOp -> Bool
isPre UOp
op Bool -> Bool -> Bool
&& UOp -> Bool
isAlphaOp UOp
op -> FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext (UOp -> FastString
uOpText UOp
op) doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
optParens RenderJs doc
r JExpr
x
    | UOp -> Bool
isPre UOp
op                 -> FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext (UOp -> FastString
uOpText UOp
op) doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
optParens RenderJs doc
r JExpr
x
    | Bool
otherwise                -> RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
optParens RenderJs doc
r JExpr
x doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext (UOp -> FastString
uOpText UOp
op)
  ApplExpr JExpr
je [JExpr]
xs -> RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JExpr
je doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> (doc -> doc
forall doc. IsLine doc => doc -> doc
parens (doc -> doc) -> ([doc] -> doc) -> [doc] -> doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (doc -> doc -> doc) -> doc -> [doc] -> doc
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
(<+?>) doc
forall doc. IsOutput doc => doc
empty ([doc] -> doc) -> ([doc] -> [doc]) -> [doc] -> doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. doc -> [doc] -> [doc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate doc
forall doc. IsLine doc => 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 doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r) [JExpr]
xs)

defRenderJsV :: JsRender doc => RenderJs doc -> JVal -> doc
defRenderJsV :: forall doc. JsRender doc => RenderJs doc -> JVal -> doc
defRenderJsV RenderJs doc
r = \case
  JVar Ident
i    -> RenderJs doc -> Ident -> doc
forall doc. JsRender doc => RenderJs doc -> Ident -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r Ident
i
  JList [JExpr]
xs  -> doc -> doc
forall doc. IsLine doc => doc -> doc
brackets (doc -> doc) -> ([doc] -> doc) -> [doc] -> doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (doc -> doc -> doc) -> doc -> [doc] -> doc
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
(<+?>) doc
forall doc. IsOutput doc => doc
empty ([doc] -> doc) -> ([doc] -> [doc]) -> [doc] -> doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. doc -> [doc] -> [doc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate doc
forall doc. IsLine doc => 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 doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
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
forall doc. IsLine doc => doc -> doc
parens (Double -> doc
forall doc. IsLine doc => Double -> doc
double Double
d)
    | Bool
otherwise                 -> Double -> doc
forall doc. IsLine doc => Double -> doc
double Double
d
  JInt Integer
i
    | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0     -> doc -> doc
forall doc. IsLine doc => doc -> doc
parens (Integer -> doc
forall doc. IsLine doc => Integer -> doc
integer Integer
i)
    | Bool
otherwise -> Integer -> doc
forall doc. IsLine doc => Integer -> doc
integer Integer
i
  JStr   FastString
s -> FastString -> doc
forall doc. IsLine doc => FastString -> doc
pprStringLit FastString
s
  JRegEx FastString
s -> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'/' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext FastString
s doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'/'
  JBool Bool
b -> String -> doc
forall doc. IsLine doc => String -> doc
text (if Bool
b then String
"true" else String
"false")
  JHash UniqMap FastString JExpr
m
    | UniqMap FastString JExpr -> Bool
forall k a. UniqMap k a -> Bool
isNullUniqMap UniqMap FastString JExpr
m  -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"{}"
    | Bool
otherwise -> doc -> doc
forall doc. JsRender doc => doc -> doc
braceNest (doc -> doc)
-> ([(FastString, JExpr)] -> doc) -> [(FastString, JExpr)] -> doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (doc -> doc -> doc) -> doc -> [doc] -> doc
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
(<+?>) doc
forall doc. IsOutput doc => doc
empty ([doc] -> doc)
-> ([(FastString, JExpr)] -> [doc]) -> [(FastString, JExpr)] -> doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. doc -> [doc] -> [doc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate doc
forall doc. IsLine doc => 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) -> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'\'' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext FastString
x doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'\'' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
forall doc. IsLine doc => doc
colon doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
<+?> RenderJs doc -> JExpr -> doc
forall doc. JsRender doc => RenderJs doc -> JExpr -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JExpr
y)
                          -- nonDetKeysUniqMap doesn't introduce non-determinism here
                          -- because we sort the elements lexically
                          ([(FastString, JExpr)] -> doc) -> [(FastString, JExpr)] -> doc
forall a b. (a -> b) -> a -> b
$ ((FastString, JExpr) -> JLabel)
-> [(FastString, JExpr)] -> [(FastString, JExpr)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (FastString -> JLabel
LexicalFastString (FastString -> JLabel)
-> ((FastString, JExpr) -> FastString)
-> (FastString, JExpr)
-> JLabel
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)]
nonDetUniqMapToList UniqMap FastString JExpr
m)
  JFunc [Ident]
is JStat
b -> doc -> doc
forall doc. IsLine doc => doc -> doc
parens (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
hangBrace (String -> doc
forall doc. IsLine doc => String -> doc
text String
"function" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc -> doc
forall doc. IsLine doc => doc -> doc
parens ((doc -> doc -> doc) -> doc -> [doc] -> doc
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
(<+?>) doc
forall doc. IsOutput doc => doc
empty ([doc] -> doc) -> ([Ident] -> [doc]) -> [Ident] -> doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. doc -> [doc] -> [doc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate doc
forall doc. IsLine doc => 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 doc -> Ident -> doc
forall doc. JsRender doc => RenderJs doc -> Ident -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r) ([Ident] -> doc) -> [Ident] -> doc
forall a b. (a -> b) -> a -> b
$ [Ident]
is)) (RenderJs doc -> JStat -> doc
forall doc. JsRender doc => RenderJs doc -> JStat -> doc
forall a doc. (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc
jsToDocR RenderJs doc
r JStat
b)

defRenderJsI :: JsRender doc => RenderJs doc -> Ident -> doc
defRenderJsI :: forall doc. JsRender doc => RenderJs doc -> Ident -> doc
defRenderJsI RenderJs doc
_  Ident
t = FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext (Ident -> FastString
identFS Ident
t)

aOpText :: AOp -> FastString
aOpText :: AOp -> FastString
aOpText = \case
  AOp
AssignOp    -> FastString
"="
  AOp
AddAssignOp -> FastString
"+="
  AOp
SubAssignOp -> FastString
"-="


uOpText :: UOp -> FastString
uOpText :: UOp -> FastString
uOpText = \case
  UOp
NotOp     -> FastString
"!"
  UOp
BNotOp    -> FastString
"~"
  UOp
NegOp     -> FastString
"-"
  UOp
PlusOp    -> FastString
"+"
  UOp
NewOp     -> FastString
"new"
  UOp
TypeofOp  -> FastString
"typeof"
  UOp
DeleteOp  -> FastString
"delete"
  UOp
YieldOp   -> FastString
"yield"
  UOp
VoidOp    -> FastString
"void"
  UOp
PreIncOp  -> FastString
"++"
  UOp
PostIncOp -> FastString
"++"
  UOp
PreDecOp  -> FastString
"--"
  UOp
PostDecOp -> FastString
"--"

opText :: Op -> FastString
opText :: Op -> FastString
opText = \case
  Op
EqOp          -> FastString
"=="
  Op
StrictEqOp    -> FastString
"==="
  Op
NeqOp         -> FastString
"!="
  Op
StrictNeqOp   -> FastString
"!=="
  Op
GtOp          -> FastString
">"
  Op
GeOp          -> FastString
">="
  Op
LtOp          -> FastString
"<"
  Op
LeOp          -> FastString
"<="
  Op
AddOp         -> FastString
"+"
  Op
SubOp         -> FastString
"-"
  Op
MulOp         -> FastString
"*"
  Op
DivOp         -> FastString
"/"
  Op
ModOp         -> FastString
"%"
  Op
LeftShiftOp   -> FastString
"<<"
  Op
RightShiftOp  -> FastString
">>"
  Op
ZRightShiftOp -> FastString
">>>"
  Op
BAndOp        -> FastString
"&"
  Op
BOrOp         -> FastString
"|"
  Op
BXorOp        -> FastString
"^"
  Op
LAndOp        -> FastString
"&&"
  Op
LOrOp         -> FastString
"||"
  Op
InstanceofOp  -> FastString
"instanceof"
  Op
InOp          -> FastString
"in"


isPre :: UOp -> Bool
isPre :: UOp -> Bool
isPre = \case
  UOp
PostIncOp -> Bool
False
  UOp
PostDecOp -> Bool
False
  UOp
_         -> Bool
True

isAlphaOp :: UOp -> Bool
isAlphaOp :: UOp -> Bool
isAlphaOp = \case
  UOp
NewOp    -> Bool
True
  UOp
TypeofOp -> Bool
True
  UOp
DeleteOp -> Bool
True
  UOp
YieldOp  -> Bool
True
  UOp
VoidOp   -> Bool
True
  UOp
_        -> Bool
False

pprStringLit :: IsLine doc => FastString -> doc
pprStringLit :: forall doc. IsLine doc => FastString -> doc
pprStringLit FastString
s = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'\"' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> FastString -> doc
forall doc. IsLine doc => FastString -> doc
encodeJson FastString
s doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'\"'

--------------------------------------------------------------------------------
--                            Utilities
--------------------------------------------------------------------------------

encodeJson :: IsLine doc => FastString -> doc
encodeJson :: forall doc. IsLine doc => FastString -> doc
encodeJson FastString
xs = [doc] -> doc
forall doc. IsLine doc => [doc] -> doc
hcat ((Char -> doc) -> String -> [doc]
forall a b. (a -> b) -> [a] -> [b]
map Char -> doc
forall doc. IsLine doc => Char -> doc
encodeJsonChar (FastString -> String
unpackFS FastString
xs))

encodeJsonChar :: IsLine doc => Char -> doc
encodeJsonChar :: forall doc. IsLine doc => Char -> doc
encodeJsonChar = \case
  Char
'/'  -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"\\/"
  Char
'\b' -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"\\b"
  Char
'\f' -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"\\f"
  Char
'\n' -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"\\n"
  Char
'\r' -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"\\r"
  Char
'\t' -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"\\t"
  Char
'"'  -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"\\\""
  Char
'\\' -> String -> doc
forall doc. IsLine doc => 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
forall doc. IsLine doc => 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} {doc}.
(Integral a, IsLine doc) =>
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} {doc}.
(Integral a, IsLine doc) =>
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 -- output surrogate pair
                        in String -> Int -> Int -> doc
forall {a} {doc}.
(Integral a, IsLine doc) =>
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
forall doc. IsLine doc => doc -> doc -> doc
<>
                           String -> Int -> Int -> doc
forall {a} {doc}.
(Integral a, IsLine doc) =>
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 -> String -> String
forall a. Integral a => a -> String -> String
showHex a
cp String
""
            in  String -> doc
forall doc. IsLine doc => String -> doc
text (String
prefix String -> String -> String
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 -> String -> String
forall a. [a] -> [a] -> [a]
++ String
h)


interSemi :: JsRender doc => [doc] -> doc
interSemi :: forall doc. JsRender doc => [doc] -> doc
interSemi = (doc -> doc -> doc) -> doc -> [doc] -> doc
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
($$$) doc
forall doc. IsOutput doc => doc
empty ([doc] -> doc) -> ([doc] -> [doc]) -> [doc] -> doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. doc -> doc -> [doc] -> [doc]
forall doc. IsLine doc => doc -> doc -> [doc] -> [doc]
punctuateFinal doc
forall doc. IsLine doc => doc
semi doc
forall doc. IsLine doc => doc
semi

-- | The structure `{body}`, optionally indented over multiple lines
{-# INLINE braceNest #-}
braceNest :: JsRender doc => doc -> doc
braceNest :: forall doc. JsRender doc => doc -> doc
braceNest doc
x = doc
forall doc. IsLine doc => doc
lbrace doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
$$$ doc -> doc
forall doc. JsRender doc => doc -> doc
jnest doc
x doc -> doc -> doc
forall doc. JsRender doc => doc -> doc -> doc
$$$ doc
forall doc. IsLine doc => doc
rbrace

-- | The structure `hdr {body}`, optionally indented over multiple lines
{-# INLINE hangBrace #-}
hangBrace :: JsRender doc => doc -> doc -> doc
hangBrace :: forall doc. JsRender doc => doc -> doc -> doc
hangBrace doc
hdr doc
body = [doc] -> doc
forall doc. JsRender doc => [doc] -> doc
jcat [ doc
hdr doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
' ' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'{', doc -> doc
forall doc. JsRender doc => doc -> doc
jnest doc
body, Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'}' ]

{-# INLINE jhang #-}
jhang :: JsRender doc => doc -> doc -> doc
jhang :: forall doc. JsRender doc => doc -> doc -> doc
jhang doc
hdr doc
body = [doc] -> doc
forall doc. JsRender doc => [doc] -> doc
jcat [ doc
hdr, doc -> doc
forall doc. JsRender doc => doc -> doc
jnest doc
body]

-- | JsRender controls the differences in whitespace between HLine and SDoc.
-- Generally, this involves the indentation and newlines in the human-readable
-- SDoc implementation being replaced in the HLine version by the minimal
-- whitespace required for valid JavaScript syntax.
class IsLine doc => JsRender doc where

  -- | Concatenate with an optional single space
  (<+?>)    :: doc -> doc -> doc
  -- | Concatenate with an optional newline
  ($$$)     :: doc -> doc -> doc
  -- | Concatenate these `doc`s, either vertically (SDoc) or horizontally (HLine)
  jcat      :: [doc] -> doc
  -- | Optionally indent the following
  jnest     :: doc -> doc
  -- | Append semi-colon (and line-break in HLine mode)
  addSemi   :: doc -> doc

instance JsRender SDoc where
  <+?> :: SDoc -> SDoc -> SDoc
(<+?>) = SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
(<+>)
  {-# INLINE (<+?>) #-}
  $$$ :: SDoc -> SDoc -> SDoc
($$$)  = SDoc -> SDoc -> SDoc
($+$)
  {-# INLINE ($$$) #-}
  jcat :: [SDoc] -> SDoc
jcat               = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
  {-# INLINE jcat #-}
  jnest :: SDoc -> SDoc
jnest              = Int -> SDoc -> SDoc
nest Int
2
  {-# INLINE jnest #-}
  addSemi :: SDoc -> SDoc
addSemi SDoc
x = SDoc
x SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
semi
  {-# INLINE addSemi #-}


instance JsRender HLine where
  <+?> :: HLine -> HLine -> HLine
(<+?>) = HLine -> HLine -> HLine
forall doc. IsLine doc => doc -> doc -> doc
(<>)
  {-# INLINE (<+?>) #-}
  $$$ :: HLine -> HLine -> HLine
($$$)  = HLine -> HLine -> HLine
forall doc. IsLine doc => doc -> doc -> doc
(<>)
  {-# INLINE ($$$) #-}
  jcat :: [HLine] -> HLine
jcat               = [HLine] -> HLine
forall doc. IsLine doc => [doc] -> doc
hcat
  {-# INLINE jcat #-}
  jnest :: HLine -> HLine
jnest              = HLine -> HLine
forall a. a -> a
id
  {-# INLINE jnest #-}
  addSemi :: HLine -> HLine
addSemi HLine
x = HLine
x HLine -> HLine -> HLine
forall doc. IsLine doc => doc -> doc -> doc
<> HLine
forall doc. IsLine doc => doc
semi HLine -> HLine -> HLine
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> HLine
forall doc. IsLine doc => Char -> doc
char Char
'\n'
  -- we add a line-break to avoid issues with lines too long in minified outputs
  {-# INLINE addSemi #-}