{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ViewPatterns #-}
module GHC.StgToJS.Linker.Opt
( pretty
, optRenderJs
)
where
import GHC.Prelude
import GHC.Int
import GHC.Exts
import GHC.JS.Syntax
import GHC.JS.Ppr
import GHC.Utils.Outputable
import GHC.Data.FastString
import GHC.Types.Unique.Map
import Data.List (sortOn)
import Data.Char (isAlpha,isDigit,ord)
import qualified Data.ByteString.Short as SBS
pretty :: JsRender doc => Bool -> JStat -> doc
pretty :: forall doc. JsRender doc => Bool -> JStat -> doc
pretty Bool
render_pretty = \case
BlockStat [] -> doc
forall doc. IsOutput doc => doc
empty
JStat
s | Bool
render_pretty -> 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
forall doc. RenderJs doc
defaultRenderJs [JStat
s]
| Bool
otherwise -> 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
forall doc. RenderJs doc
optRenderJs [JStat
s]
optRenderJs :: RenderJs doc
optRenderJs :: forall doc. RenderJs doc
optRenderJs = RenderJs doc
forall doc. RenderJs doc
defaultRenderJs
{ renderJsV = ghcjsRenderJsV
, renderJsS = ghcjsRenderJsS
, renderJsI = ghcjsRenderJsI
}
hdd :: SBS.ShortByteString
hdd :: ShortByteString
hdd = [Word8] -> ShortByteString
SBS.pack ((Char -> Word8) -> [Char] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) [Char]
"h$$")
ghcjsRenderJsI :: IsLine doc => RenderJs doc -> Ident -> doc
ghcjsRenderJsI :: forall doc. IsLine doc => RenderJs doc -> Ident -> doc
ghcjsRenderJsI RenderJs doc
_ (Ident -> FastString
identFS -> FastString
fs)
| ShortByteString
hdd ShortByteString -> ShortByteString -> Bool
`SBS.isPrefixOf` FastString -> ShortByteString
fastStringToShortByteString FastString
fs
, Int
u <- FastString -> Int
uniqueOfFS FastString
fs
= [Char] -> doc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"h$$" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Word -> doc
forall doc. IsLine doc => Word -> doc
hexDoc (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
u)
| Bool
otherwise
= FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext FastString
fs
hexDoc :: IsLine doc => Word -> doc
hexDoc :: forall doc. IsLine doc => Word -> doc
hexDoc Word
0 = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'0'
hexDoc Word
v = [Char] -> doc
forall doc. IsLine doc => [Char] -> doc
text ([Char] -> doc) -> [Char] -> doc
forall a b. (a -> b) -> a -> b
$ Word -> [Char]
go Word
v
where
sym :: Int -> Char
sym (I# Int#
i) = Char# -> Char
C# (Addr# -> Int# -> Char#
indexCharOffAddr# Addr#
chars Int#
i)
chars :: Addr#
chars = Addr#
"0123456789abcdef"#
go :: Word -> [Char]
go = \case
Word
0 -> []
Word
n -> Int -> Char
sym (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word
n Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x0F))
Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Int -> Char
sym (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word
n Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0xF0) Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` Int
4))
Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Word -> [Char]
go (Word
n Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
ghcjsRenderJsS :: JsRender doc => RenderJs doc -> JStat -> doc
ghcjsRenderJsS :: forall doc. JsRender doc => RenderJs doc -> JStat -> doc
ghcjsRenderJsS RenderJs doc
r JStat
s = RenderJs doc -> JsRender doc => RenderJs doc -> JStat -> doc
forall doc.
RenderJs doc -> JsRender doc => RenderJs doc -> JStat -> doc
renderJsS RenderJs doc
forall doc. RenderJs doc
defaultRenderJs RenderJs doc
r JStat
s
ghcjsRenderJsV :: JsRender doc => RenderJs doc -> JVal -> doc
ghcjsRenderJsV :: forall doc. JsRender doc => RenderJs doc -> JVal -> doc
ghcjsRenderJsV RenderJs doc
r (JHash UniqMap FastString JExpr
m)
| UniqMap FastString JExpr -> Bool
forall k a. UniqMap k a -> Bool
isNullUniqMap UniqMap FastString JExpr
m = [Char] -> doc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"{}"
| 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
forall doc. IsLine doc => [doc] -> doc
fsep ([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) -> FastString -> doc
forall doc. IsLine doc => FastString -> doc
quoteIfRequired FastString
x doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
forall doc. IsLine doc => doc
colon 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
y)
([(FastString, JExpr)] -> [doc])
-> ([(FastString, JExpr)] -> [(FastString, JExpr)])
-> [(FastString, JExpr)]
-> [doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((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) ([(FastString, JExpr)] -> doc) -> [(FastString, JExpr)] -> doc
forall a b. (a -> b) -> a -> b
$ UniqMap FastString JExpr -> [(FastString, JExpr)]
forall k a. UniqMap k a -> [(k, a)]
nonDetUniqMapToList UniqMap FastString JExpr
m
where
quoteIfRequired :: IsLine doc => FastString -> doc
quoteIfRequired :: forall doc. IsLine doc => FastString -> doc
quoteIfRequired FastString
x
| FastString -> Bool
isUnquotedKey FastString
x = FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext FastString
x
| Bool
otherwise = 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
'\''
isUnquotedKey :: FastString -> Bool
isUnquotedKey :: FastString -> Bool
isUnquotedKey FastString
fs = case FastString -> [Char]
unpackFS FastString
fs of
[] -> Bool
False
s :: [Char]
s@(Char
c:[Char]
cs) -> (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit [Char]
s Bool -> Bool -> Bool
|| (Char -> Bool
validFirstIdent Char
c Bool -> Bool -> Bool
&& (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
validOtherIdent [Char]
cs)
validFirstIdent :: Char -> Bool
validFirstIdent Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'$' Bool -> Bool -> Bool
|| Char -> Bool
isAlpha Char
c
validOtherIdent :: Char -> Bool
validOtherIdent Char
c = Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c
ghcjsRenderJsV RenderJs doc
r JVal
v = RenderJs doc -> JsRender doc => RenderJs doc -> JVal -> doc
forall doc.
RenderJs doc -> JsRender doc => RenderJs doc -> JVal -> doc
renderJsV RenderJs doc
forall doc. RenderJs doc
defaultRenderJs RenderJs doc
r JVal
v