{-# OPTIONS -fno-warn-orphans #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Fay.Compiler.Print where
import Fay.Compiler.Prelude
import Fay.Compiler.PrimOp
import Fay.Types
import Data.Aeson
import qualified Data.ByteString.Lazy.UTF8 as UTF8
import Language.Haskell.Exts hiding (alt, name, op, sym)
printJSString :: Printable a => a -> String
printJSString :: a -> String
printJSString x :: a
x = PrintWriter -> String
pwOutputString (Printer -> PrintReader -> PrintWriter
execPrinter (a -> Printer
forall a. Printable a => a -> Printer
printJS a
x) PrintReader
defaultPrintReader)
printJSPretty :: Printable a => a -> String
printJSPretty :: a -> String
printJSPretty x :: a
x = PrintWriter -> String
pwOutputString (Printer -> PrintReader -> PrintWriter
execPrinter (a -> Printer
forall a. Printable a => a -> Printer
printJS a
x) PrintReader
defaultPrintReader{ prPretty :: Bool
prPretty = Bool
True })
toJsStringLit :: String -> String
toJsStringLit :: String -> String
toJsStringLit = ByteString -> String
UTF8.toString (ByteString -> String)
-> (String -> ByteString) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
forall a. ToJSON a => a -> ByteString
encode
instance Printable JsLit where
printJS :: JsLit -> Printer
printJS typ :: JsLit
typ = String -> Printer
write (String -> Printer) -> String -> Printer
forall a b. (a -> b) -> a -> b
$ case JsLit
typ of
(JsChar char :: Char
char) -> String -> String
toJsStringLit [Char
char]
(JsStr str :: String
str) -> String -> String
toJsStringLit String
str
(JsInt int :: Int
int) -> Int -> String
forall a. Show a => a -> String
show Int
int
(JsFloating rat :: Double
rat) -> Double -> String
forall a. Show a => a -> String
show Double
rat
(JsBool b :: Bool
b) -> if Bool
b then "true" else "false"
instance Printable (QName l) where
printJS :: QName l -> Printer
printJS qname :: QName l
qname =
case QName l
qname of
Qual _ (ModuleName _ "Fay$") name :: Name l
name -> "Fay$$" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Name l -> Printer
forall a. Printable a => a -> Printer
printJS Name l
name
Qual _ moduleName :: ModuleName l
moduleName name :: Name l
name -> ModuleName l -> Printer
forall a. Printable a => a -> Printer
printJS ModuleName l
moduleName Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Name l -> Printer
forall l. Name l -> Printer
printProp Name l
name
UnQual _ name :: Name l
name -> Name l -> Printer
forall a. Printable a => a -> Printer
printJS Name l
name
Special _ con :: SpecialCon l
con -> SpecialCon l -> Printer
forall a. Printable a => a -> Printer
printJS SpecialCon l
con
printProp :: Name l -> Printer
printProp :: Name l -> Printer
printProp name :: Name l
name = (PrintReader -> Bool) -> Printer -> Printer -> Printer
askIf PrintReader -> Bool
prPrettyOperators Printer
pretty Printer
ugly
where pretty :: Printer
pretty = if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
allowedNameChars) String
nameString then Printer
dot else Printer
brackets
ugly :: Printer
ugly = Printer
dot
dot :: Printer
dot = "." Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Name l -> Printer
forall a. Printable a => a -> Printer
printJS Name l
name
brackets :: Printer
brackets = "[" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> String -> Printer
write (String -> String
toJsStringLit String
nameString) Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "]"
nameString :: String
nameString = case Name l
name of
Ident _ s :: String
s -> String
s
Symbol _ s :: String
s -> String
s
instance Printable (ModuleName l) where
printJS :: ModuleName l -> Printer
printJS (ModuleName _ "Fay$") = "Fay$"
printJS (ModuleName _ moduleName :: String
moduleName) = String -> Printer
write (String -> Printer) -> String -> Printer
forall a b. (a -> b) -> a -> b
$ String -> String
go String
moduleName
where go :: String -> String
go ('.':xs :: String
xs) = '.' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
xs
go (x :: Char
x:xs :: String
xs) = String -> String
normalizeName [Char
x] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
go String
xs
go [] = []
instance Printable (Name l) where
printJS :: Name l -> Printer
printJS = String -> Printer
write (String -> Printer) -> (Name l -> String) -> Name l -> Printer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name l -> String
forall l. Name l -> String
encodeName
instance Printable (SpecialCon l) where
printJS :: SpecialCon l -> Printer
printJS specialCon :: SpecialCon l
specialCon =
QName () -> Printer
forall a. Printable a => a -> Printer
printJS (QName () -> Printer) -> QName () -> Printer
forall a b. (a -> b) -> a -> b
$ () -> String -> QName ()
forall a. a -> String -> QName a
fayBuiltin () (String -> QName ()) -> String -> QName ()
forall a b. (a -> b) -> a -> b
$
case SpecialCon l
specialCon of
UnitCon _ -> "unit"
Cons _ -> "cons"
_ -> String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ "Special constructor not supported: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
SpecialCon () -> String
forall a. Show a => a -> String
show (SpecialCon l -> SpecialCon ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void SpecialCon l
specialCon)
printStmts :: [JsStmt] -> Printer
printStmts :: [JsStmt] -> Printer
printStmts = [Printer] -> Printer
forall a. Monoid a => [a] -> a
mconcat ([Printer] -> Printer)
-> ([JsStmt] -> [Printer]) -> [JsStmt] -> Printer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JsStmt -> Printer) -> [JsStmt] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map JsStmt -> Printer
forall a. Printable a => a -> Printer
printJS
instance Printable JsStmt where
printJS :: JsStmt -> Printer
printJS (JsExpStmt e :: JsExp
e) =
JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
e Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> ";" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Printer
newline
printJS (JsBlock stmts :: [JsStmt]
stmts) =
"{ " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> [JsStmt] -> Printer
printStmts [JsStmt]
stmts Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "}"
printJS (JsMapVar name :: JsName
name expr :: JsExp
expr) =
"var " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsName -> Printer
forall a. Printable a => a -> Printer
printJS JsName
name Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> " : {[key: string]: any;} = " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
expr Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> ";" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Printer
newline
printJS (JsVar name :: JsName
name expr :: JsExp
expr) =
"var " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsName -> Printer
forall a. Printable a => a -> Printer
printJS JsName
name Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> " = " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
expr Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> ";" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Printer
newline
printJS (JsUpdate name :: JsName
name expr :: JsExp
expr) =
JsName -> Printer
forall a. Printable a => a -> Printer
printJS JsName
name Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> " = " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
expr Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> ";" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Printer
newline
printJS (JsSetProp name :: JsName
name prop :: JsName
prop expr :: JsExp
expr) =
JsName -> Printer
forall a. Printable a => a -> Printer
printJS JsName
name Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "." Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsName -> Printer
forall a. Printable a => a -> Printer
printJS JsName
prop Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> " = " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
expr Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> ";" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Printer
newline
printJS (JsSetQName msrcloc :: Maybe SrcSpan
msrcloc name :: QName ()
name expr :: JsExp
expr) =
Printer -> (SrcSpan -> Printer) -> Maybe SrcSpan -> Printer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Printer
forall a. Monoid a => a
mempty SrcSpan -> Printer
mapping Maybe SrcSpan
msrcloc Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> QName () -> Printer
forall a. Printable a => a -> Printer
printJS QName ()
name Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> " = " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
expr Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> ";" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Printer
newline
printJS (JsSetConstructor name :: QName ()
name expr :: JsExp
expr) =
QName () -> Printer
forall l. QName l -> Printer
printCons QName ()
name Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> " = " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
expr Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> ";" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Printer
newline Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<>
QName () -> Printer
forall l. QName l -> Printer
printCons QName ()
name Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> ".prototype.instance = \"" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> QName () -> Printer
forall l. QName l -> Printer
printConsUnQual QName ()
name Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "\";" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Printer
newline
printJS (JsSetModule mp :: ModulePath
mp expr :: JsExp
expr) =
ModulePath -> Printer
forall a. Printable a => a -> Printer
printJS ModulePath
mp Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> " = " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
expr Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> ";" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Printer
newline
printJS (JsSetPropExtern name :: JsName
name prop :: JsName
prop expr :: JsExp
expr) =
JsName -> Printer
forall a. Printable a => a -> Printer
printJS JsName
name Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "['" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsName -> Printer
forall a. Printable a => a -> Printer
printJS JsName
prop Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "'] = " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
expr Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> ";" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Printer
newline
printJS (JsIf expr :: JsExp
expr thens :: [JsStmt]
thens elses :: [JsStmt]
elses) =
"if (" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
expr Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> ") {" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Printer
newline Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<>
Printer -> Printer
indented ([JsStmt] -> Printer
printStmts [JsStmt]
thens) Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<>
"}" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<>
(if [JsStmt] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [JsStmt]
elses
then Printer
forall a. Monoid a => a
mempty
else " else {" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Printer
newline Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<>
Printer -> Printer
indented ([JsStmt] -> Printer
printStmts [JsStmt]
elses) Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<>
"}") Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Printer
newline
printJS (JsEarlyReturn expr :: JsExp
expr) =
"return " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
expr Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> ";" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Printer
newline
printJS (JsThrow expr :: JsExp
expr) =
"throw " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
expr Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> ";" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Printer
newline
printJS (JsWhile cond :: JsExp
cond stmts :: [JsStmt]
stmts) =
"while (" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
cond Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> ") {" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Printer
newline Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<>
Printer -> Printer
indented ([JsStmt] -> Printer
printStmts [JsStmt]
stmts) Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<>
"}" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Printer
newline
printJS JsContinue = "continue;" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Printer
newline
instance Printable ModulePath where
printJS :: ModulePath -> Printer
printJS = String -> Printer
write (String -> Printer)
-> (ModulePath -> String) -> ModulePath -> Printer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "." ([String] -> String)
-> (ModulePath -> [String]) -> ModulePath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModulePath -> [String]
unModulePath
instance Printable JsExp where
printJS :: JsExp -> Printer
printJS (JsSeq es :: [JsExp]
es) = "(" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> String -> [Printer] -> Printer
mintercalate "," ((JsExp -> Printer) -> [JsExp] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map JsExp -> Printer
forall a. Printable a => a -> Printer
printJS [JsExp]
es) Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> ")"
printJS (JsRawExp e :: String
e) = String -> Printer
write String
e
printJS (JsName name :: JsName
name) = JsName -> Printer
forall a. Printable a => a -> Printer
printJS JsName
name
printJS (JsThrowExp expr :: JsExp
expr) = "(function(){ throw (" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
expr Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "); })()"
printJS JsNull = "null"
printJS JsUndefined = "undefined"
printJS (JsLit lit :: JsLit
lit) = JsLit -> Printer
forall a. Printable a => a -> Printer
printJS JsLit
lit
printJS (JsParen expr :: JsExp
expr) = "(" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
expr Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> ")"
printJS (JsList exprs :: [JsExp]
exprs) = "[" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> String -> [Printer] -> Printer
mintercalate "," ((JsExp -> Printer) -> [JsExp] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map JsExp -> Printer
forall a. Printable a => a -> Printer
printJS [JsExp]
exprs) Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "]"
printJS (JsNew name :: JsName
name args :: [JsExp]
args) = "new " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS (JsExp -> [JsExp] -> JsExp
JsApp (JsName -> JsExp
JsName JsName
name) [JsExp]
args)
printJS (JsIndex i :: Int
i expr :: JsExp
expr) = "(" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
expr Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> ")[" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> String -> Printer
write (Int -> String
forall a. Show a => a -> String
show Int
i) Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "]"
printJS (JsEq expr1 :: JsExp
expr1 expr2 :: JsExp
expr2) = JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
expr1 Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> " === " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
expr2
printJS (JsNeq expr1 :: JsExp
expr1 expr2 :: JsExp
expr2) = JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
expr1 Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> " !== " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
expr2
printJS (JsGetProp expr :: JsExp
expr prop :: JsName
prop) = JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
expr Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "." Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsName -> Printer
forall a. Printable a => a -> Printer
printJS JsName
prop
printJS (JsLookup expr1 :: JsExp
expr1 expr2 :: JsExp
expr2) = JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
expr1 Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "[" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
expr2 Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "]"
printJS (JsUpdateProp name :: JsExp
name prop :: JsName
prop expr :: JsExp
expr) =
"(" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
name Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "." Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsName -> Printer
forall a. Printable a => a -> Printer
printJS JsName
prop Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> " = " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
expr Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> ")"
printJS (JsInfix op :: String
op x :: JsExp
x y :: JsExp
y) = JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
x Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> " " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> String -> Printer
write String
op Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> " " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
y
printJS (JsGetPropExtern expr :: JsExp
expr prop :: String
prop) =
JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
expr Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "[" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> String -> Printer
write (String -> String
toJsStringLit String
prop) Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "]"
printJS (JsUpdatePropExtern name :: JsExp
name prop :: JsName
prop expr :: JsExp
expr) =
"(" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
name Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "['" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsName -> Printer
forall a. Printable a => a -> Printer
printJS JsName
prop Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "'] = " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
expr Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> ")"
printJS (JsTernaryIf cond :: JsExp
cond conseq :: JsExp
conseq alt :: JsExp
alt) =
JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
cond Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> " ? " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
conseq Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> " : " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
alt
printJS (JsInstanceOf expr :: JsExp
expr classname :: JsName
classname) =
JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
expr Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> " instanceof " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsName -> Printer
forall a. Printable a => a -> Printer
printJS JsName
classname
printJS (JsObj assoc :: [(String, JsExp)]
assoc) =
"{" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> String -> [Printer] -> Printer
mintercalate "," (((String, JsExp) -> Printer) -> [(String, JsExp)] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map (String, JsExp) -> Printer
forall a. Printable a => (String, a) -> Printer
cons [(String, JsExp)]
assoc) Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "}"
where cons :: (String, a) -> Printer
cons (key :: String
key,value :: a
value) = String -> Printer
write (String -> String
toJsStringLit String
key) Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> ": " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> a -> Printer
forall a. Printable a => a -> Printer
printJS a
value
printJS (JsLitObj assoc :: [(Name, JsExp)]
assoc) = "{" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> String -> [Printer] -> Printer
mintercalate "," (((Name, JsExp) -> Printer) -> [(Name, JsExp)] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map (Name, JsExp) -> Printer
forall a a. (Printable a, Printable a) => (a, a) -> Printer
cons [(Name, JsExp)]
assoc) Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "}"
where cons :: (a, a) -> Printer
cons (key :: a
key,value :: a
value) = "\"" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> a -> Printer
forall a. Printable a => a -> Printer
printJS a
key Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> ": " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> a -> Printer
forall a. Printable a => a -> Printer
printJS a
value
printJS (JsFun nm :: Maybe JsName
nm params :: [JsName]
params stmts :: [JsStmt]
stmts ret :: Maybe JsExp
ret) =
"function"
Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Printer -> (JsName -> Printer) -> Maybe JsName -> Printer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Printer
forall a. Monoid a => a
mempty ((" " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<>) (Printer -> Printer) -> (JsName -> Printer) -> JsName -> Printer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsName -> Printer
forall a. Printable a => a -> Printer
printJS (JsName -> Printer) -> (JsName -> JsName) -> JsName -> Printer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsName -> JsName
ident) Maybe JsName
nm
Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "("
Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> String -> [Printer] -> Printer
mintercalate "," ((JsName -> Printer) -> [JsName] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map JsName -> Printer
forall a. Printable a => a -> Printer
printJS [JsName]
params)
Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "){" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Printer
newline
Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Printer -> Printer
indented ([JsStmt] -> Printer
printStmts [JsStmt]
stmts Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<>
case Maybe JsExp
ret of
Just ret' :: JsExp
ret' -> "return " Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
ret' Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> ";" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Printer
newline
Nothing -> Printer
forall a. Monoid a => a
mempty)
Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "}"
printJS (JsApp op :: JsExp
op args :: [JsExp]
args) =
JsExp -> Printer
forall a. Printable a => a -> Printer
printJS (case JsExp
op of JsFun {} -> JsExp -> JsExp
JsParen JsExp
op; _ -> JsExp
op)
Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "("
Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> String -> [Printer] -> Printer
mintercalate "," ((JsExp -> Printer) -> [JsExp] -> [Printer]
forall a b. (a -> b) -> [a] -> [b]
map JsExp -> Printer
forall a. Printable a => a -> Printer
printJS [JsExp]
args)
Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> ")"
printJS (JsNegApp args :: JsExp
args) = "(-(" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
args Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "))"
printJS (JsAnd a :: JsExp
a b :: JsExp
b) = JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
a Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "&&" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
b
printJS (JsOr a :: JsExp
a b :: JsExp
b) = JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
a Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "||" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> JsExp -> Printer
forall a. Printable a => a -> Printer
printJS JsExp
b
ident :: JsName -> JsName
ident :: JsName -> JsName
ident n :: JsName
n = case JsName
n of
JsConstructor (Qual _ _ s :: Name
s) -> QName () -> JsName
JsNameVar (QName () -> JsName) -> QName () -> JsName
forall a b. (a -> b) -> a -> b
$ () -> Name -> QName ()
forall l. l -> Name l -> QName l
UnQual () Name
s
a :: JsName
a -> JsName
a
instance Printable JsName where
printJS :: JsName -> Printer
printJS name :: JsName
name =
case JsName
name of
JsNameVar qname :: QName ()
qname -> QName () -> Printer
forall a. Printable a => a -> Printer
printJS QName ()
qname
JsThis -> "this"
JsThunk -> (PrintReader -> Bool) -> Printer -> Printer -> Printer
askIf PrintReader -> Bool
prPrettyThunks "$" "Fay$$$"
JsForce -> (PrintReader -> Bool) -> Printer -> Printer -> Printer
askIf PrintReader -> Bool
prPrettyThunks "_" "Fay$$_"
JsApply -> (PrintReader -> Bool) -> Printer -> Printer -> Printer
askIf PrintReader -> Bool
prPrettyThunks "__" "Fay$$__"
JsParam i :: Integer
i -> "$p" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> String -> Printer
write (Integer -> String
forall a. Show a => a -> String
show Integer
i)
JsTmp i :: Integer
i -> "$tmp" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> String -> Printer
write (Integer -> String
forall a. Show a => a -> String
show Integer
i)
JsConstructor qname :: QName ()
qname -> QName () -> Printer
forall l. QName l -> Printer
printCons QName ()
qname
JsBuiltIn qname :: Name
qname -> "Fay$$" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Name -> Printer
forall a. Printable a => a -> Printer
printJS Name
qname
JsParametrizedType -> "type"
JsModuleName (ModuleName _ m :: String
m) -> String -> Printer
write String
m
printCons :: QName l -> Printer
printCons :: QName l -> Printer
printCons (UnQual _ n :: Name l
n) = Name l -> Printer
forall l. Name l -> Printer
printConsName Name l
n
printCons (Qual _ (ModuleName _ m :: String
m) n :: Name l
n) = String -> Printer
write String
m Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> "." Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<> Name l -> Printer
forall l. Name l -> Printer
printConsName Name l
n
printCons Special {} = String -> Printer
forall a. HasCallStack => String -> a
error "qname2String Special"
printConsUnQual :: QName l -> Printer
printConsUnQual :: QName l -> Printer
printConsUnQual (UnQual _ x :: Name l
x) = Name l -> Printer
forall a. Printable a => a -> Printer
printJS Name l
x
printConsUnQual (Qual _ _ n :: Name l
n) = Name l -> Printer
forall a. Printable a => a -> Printer
printJS Name l
n
printConsUnQual Special {} = String -> Printer
forall a. HasCallStack => String -> a
error "printConsUnqual Special"
printConsName :: Name l -> Printer
printConsName :: Name l -> Printer
printConsName = ("_" Printer -> Printer -> Printer
forall a. Semigroup a => a -> a -> a
<>) (Printer -> Printer) -> (Name l -> Printer) -> Name l -> Printer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name l -> Printer
forall a. Printable a => a -> Printer
printJS
reservedWords :: [String]
reservedWords :: [String]
reservedWords =
["abstract","boolean","break","byte","case","catch","char","class"
,"comment","const","continue","debugger","default","delete","do","double"
,"else","enum","export","extends","false","final","finally","float"
,"for","function","global","goto","if","implements","import","in"
,"instanceOf","instanceof","int","interface","label","long","native"
,"new","null","package","private","protected","public","return","short"
,"static","super","switch","synchronized","this","throw","throws"
,"transient","true","try","typeof","undefined","var","void","while"
,"window","with","yield"]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["__defineGetter__", "__defineSetter__", "__lookupGetter__", "__lookupSetter__", "constructor", "force", "forced", "hasOwnProperty", "isPrototypeOf", "propertyIsEnumerable", "toLocaleString", "toString", "value", "valueOf"]
allowedNameChars :: String
allowedNameChars :: String
allowedNameChars = ['a'..'z'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ ['A'..'Z'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ ['0'..'9'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ "_"
encodeName :: Name l -> String
encodeName :: Name l -> String
encodeName n :: Name l
n = case Name l
n of
(Ident _ idn :: String
idn) -> String -> String
encodeString String
idn
(Symbol _ sym :: String
sym) -> String -> String
encodeString String
sym
where encodeString :: String -> String
encodeString ('$':'g':'e':'n':name :: String
name) = "$gen_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
normalizeName String
name
encodeString name :: String
name
| String
name String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
reservedWords = "$_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
normalizeName String
name
| Bool
otherwise = String -> String
normalizeName String
name
normalizeName :: String -> String
normalizeName :: String -> String
normalizeName = (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
encodeChar
where
encodeChar :: Char -> String
encodeChar c :: Char
c | Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
allowedNameChars = [Char
c]
| Bool
otherwise = Char -> String
forall a. Enum a => a -> String
escapeChar Char
c
escapeChar :: a -> String
escapeChar c :: a
c = "$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Enum a => a -> String
charId a
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ "$"
charId :: a -> String
charId c :: a
c = Int -> String
forall a. Show a => a -> String
show (a -> Int
forall a. Enum a => a -> Int
fromEnum a
c)
mintercalate :: String -> [Printer] -> Printer
mintercalate :: String -> [Printer] -> Printer
mintercalate str :: String
str xs :: [Printer]
xs = [Printer] -> Printer
forall a. Monoid a => [a] -> a
mconcat ([Printer] -> Printer) -> [Printer] -> Printer
forall a b. (a -> b) -> a -> b
$ Printer -> [Printer] -> [Printer]
forall a. a -> [a] -> [a]
intersperse (String -> Printer
write String
str) [Printer]
xs