module Language.PureScript.CodeGen.JS.Printer
( prettyPrintJS
, prettyPrintJSWithSourceMaps
) where
import Prelude
import Control.Arrow ((<+>))
import Control.Monad (forM, mzero)
import Control.Monad.State (StateT, evalStateT)
import Control.PatternArrows
import qualified Control.Arrow as A
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.List.NonEmpty as NEL (toList)
import Language.PureScript.AST (SourceSpan(..))
import Language.PureScript.CodeGen.JS.Common
import Language.PureScript.CoreImp.AST
import Language.PureScript.CoreImp.Module
import Language.PureScript.Comments
import Language.PureScript.Crash
import Language.PureScript.Pretty.Common
import Language.PureScript.PSString (PSString, decodeString, prettyPrintStringJS)
literals :: (Emit gen) => Pattern PrinterState AST gen
literals :: forall gen. Emit gen => Pattern PrinterState AST gen
literals = forall a u b. (a -> StateT u Maybe b) -> Pattern u a b
mkPattern' forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
match'
where
match' :: (Emit gen) => AST -> StateT PrinterState Maybe gen
match' :: forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
match' AST
js = (forall gen. Emit gen => Maybe SourceSpan -> gen
addMapping' (AST -> Maybe SourceSpan
getSourceSpan AST
js) forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
match AST
js
match :: (Emit gen) => AST -> StateT PrinterState Maybe gen
match :: forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
match (NumericLiteral Maybe SourceSpan
_ Either Integer Double
n) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. Show a => a -> String
show forall a. Show a => a -> String
show Either Integer Double
n
match (StringLiteral Maybe SourceSpan
_ PSString
s) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit forall a b. (a -> b) -> a -> b
$ PSString -> Text
prettyPrintStringJS PSString
s
match (BooleanLiteral Maybe SourceSpan
_ Bool
True) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
"true"
match (BooleanLiteral Maybe SourceSpan
_ Bool
False) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
"false"
match (ArrayLiteral Maybe SourceSpan
_ [AST]
xs) = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
"[ "
, forall m. Monoid m => m -> [m] -> m
intercalate (forall gen. Emit gen => Text -> gen
emit Text
", ") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [AST]
xs forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
prettyPrintJS'
, forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
" ]"
]
match (ObjectLiteral Maybe SourceSpan
_ []) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
"{}"
match (ObjectLiteral Maybe SourceSpan
_ [(PSString, AST)]
ps) = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
"{\n"
, forall gen.
StateT PrinterState Maybe gen -> StateT PrinterState Maybe gen
withIndent forall a b. (a -> b) -> a -> b
$ do
[gen]
jss <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(PSString, AST)]
ps forall a b. (a -> b) -> a -> b
$ \(PSString
key, AST
value) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall gen. Emit gen => PSString -> gen
objectPropertyToString PSString
key forall a. Semigroup a => a -> a -> a
<> forall gen. Emit gen => Text -> gen
emit Text
": ") forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
prettyPrintJS' forall a b. (a -> b) -> a -> b
$ AST
value
gen
indentString <- forall gen. Emit gen => StateT PrinterState Maybe gen
currentIndent
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall m. Monoid m => m -> [m] -> m
intercalate (forall gen. Emit gen => Text -> gen
emit Text
",\n") forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (gen
indentString forall a. Semigroup a => a -> a -> a
<>) [gen]
jss
, forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
"\n"
, forall gen. Emit gen => StateT PrinterState Maybe gen
currentIndent
, forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
"}"
]
where
objectPropertyToString :: (Emit gen) => PSString -> gen
objectPropertyToString :: forall gen. Emit gen => PSString -> gen
objectPropertyToString PSString
s =
forall gen. Emit gen => Text -> gen
emit forall a b. (a -> b) -> a -> b
$ case PSString -> Maybe Text
decodeString PSString
s of
Just Text
s' | Text -> Bool
isValidJsIdentifier Text
s' ->
Text
s'
Maybe Text
_ ->
PSString -> Text
prettyPrintStringJS PSString
s
match (Block Maybe SourceSpan
_ [AST]
sts) = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
"{\n"
, forall gen.
StateT PrinterState Maybe gen -> StateT PrinterState Maybe gen
withIndent forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => [AST] -> StateT PrinterState Maybe gen
prettyStatements [AST]
sts
, forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
"\n"
, forall gen. Emit gen => StateT PrinterState Maybe gen
currentIndent
, forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
"}"
]
match (Var Maybe SourceSpan
_ Text
ident) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
ident
match (VariableIntroduction Maybe SourceSpan
_ Text
ident Maybe (InitializerEffects, AST)
value) = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit forall a b. (a -> b) -> a -> b
$ Text
"var " forall a. Semigroup a => a -> a -> a
<> Text
ident
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall gen. Emit gen => Text -> gen
emit Text
" = " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
prettyPrintJS' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) Maybe (InitializerEffects, AST)
value
]
match (Assignment Maybe SourceSpan
_ AST
target AST
value) = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
prettyPrintJS' AST
target
, forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
" = "
, forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
prettyPrintJS' AST
value
]
match (While Maybe SourceSpan
_ AST
cond AST
sts) = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
"while ("
, forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
prettyPrintJS' AST
cond
, forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
") "
, forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
prettyPrintJS' AST
sts
]
match (For Maybe SourceSpan
_ Text
ident AST
start AST
end AST
sts) = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit forall a b. (a -> b) -> a -> b
$ Text
"for (var " forall a. Semigroup a => a -> a -> a
<> Text
ident forall a. Semigroup a => a -> a -> a
<> Text
" = "
, forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
prettyPrintJS' AST
start
, forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit forall a b. (a -> b) -> a -> b
$ Text
"; " forall a. Semigroup a => a -> a -> a
<> Text
ident forall a. Semigroup a => a -> a -> a
<> Text
" < "
, forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
prettyPrintJS' AST
end
, forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit forall a b. (a -> b) -> a -> b
$ Text
"; " forall a. Semigroup a => a -> a -> a
<> Text
ident forall a. Semigroup a => a -> a -> a
<> Text
"++) "
, forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
prettyPrintJS' AST
sts
]
match (ForIn Maybe SourceSpan
_ Text
ident AST
obj AST
sts) = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit forall a b. (a -> b) -> a -> b
$ Text
"for (var " forall a. Semigroup a => a -> a -> a
<> Text
ident forall a. Semigroup a => a -> a -> a
<> Text
" in "
, forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
prettyPrintJS' AST
obj
, forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
") "
, forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
prettyPrintJS' AST
sts
]
match (IfElse Maybe SourceSpan
_ AST
cond AST
thens Maybe AST
elses) = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
"if ("
, forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
prettyPrintJS' AST
cond
, forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
") "
, forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
prettyPrintJS' AST
thens
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall gen. Emit gen => Text -> gen
emit Text
" else " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
prettyPrintJS') Maybe AST
elses
]
match (Return Maybe SourceSpan
_ AST
value) = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
"return "
, forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
prettyPrintJS' AST
value
]
match (ReturnNoResult Maybe SourceSpan
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
"return"
match (Throw Maybe SourceSpan
_ AST
value) = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
"throw "
, forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
prettyPrintJS' AST
value
]
match (Comment (SourceComments [Comment]
com) AST
js) = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
"\n"
, forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Comment]
com forall gen. Emit gen => Comment -> StateT PrinterState Maybe gen
comment
, forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
prettyPrintJS' AST
js
]
match (Comment CIComments
PureAnnotation AST
js) = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
"/* #__PURE__ */ "
, forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
prettyPrintJS' AST
js
]
match AST
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero
comment :: (Emit gen) => Comment -> StateT PrinterState Maybe gen
(LineComment Text
com) = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ forall gen. Emit gen => StateT PrinterState Maybe gen
currentIndent
, forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
"//" forall a. Semigroup a => a -> a -> a
<> forall gen. Emit gen => Text -> gen
emit Text
com forall a. Semigroup a => a -> a -> a
<> forall gen. Emit gen => Text -> gen
emit Text
"\n"
]
comment (BlockComment Text
com) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$
[ forall gen. Emit gen => StateT PrinterState Maybe gen
currentIndent
, forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
"/**\n"
] forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map forall gen. Emit gen => Text -> StateT PrinterState Maybe gen
asLine (Text -> [Text]
T.lines Text
com) forall a. [a] -> [a] -> [a]
++
[ forall gen. Emit gen => StateT PrinterState Maybe gen
currentIndent
, forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
" */\n"
, forall gen. Emit gen => StateT PrinterState Maybe gen
currentIndent
]
where
asLine :: (Emit gen) => Text -> StateT PrinterState Maybe gen
asLine :: forall gen. Emit gen => Text -> StateT PrinterState Maybe gen
asLine Text
s = do
gen
i <- forall gen. Emit gen => StateT PrinterState Maybe gen
currentIndent
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ gen
i forall a. Semigroup a => a -> a -> a
<> forall gen. Emit gen => Text -> gen
emit Text
" * " forall a. Semigroup a => a -> a -> a
<> (forall gen. Emit gen => Text -> gen
emit forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
removeComments) Text
s forall a. Semigroup a => a -> a -> a
<> forall gen. Emit gen => Text -> gen
emit Text
"\n"
removeComments :: Text -> Text
removeComments :: Text -> Text
removeComments Text
t =
case Text -> Text -> Maybe Text
T.stripPrefix Text
"*/" Text
t of
Just Text
rest -> Text -> Text
removeComments Text
rest
Maybe Text
Nothing -> case Text -> Maybe (Char, Text)
T.uncons Text
t of
Just (Char
x, Text
xs) -> Char
x Char -> Text -> Text
`T.cons` Text -> Text
removeComments Text
xs
Maybe (Char, Text)
Nothing -> Text
""
prettyImport :: (Emit gen) => Import -> StateT PrinterState Maybe gen
prettyImport :: forall gen. Emit gen => Import -> StateT PrinterState Maybe gen
prettyImport (Import Text
ident PSString
from) =
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall gen. Emit gen => Text -> gen
emit forall a b. (a -> b) -> a -> b
$
Text
"import * as " forall a. Semigroup a => a -> a -> a
<> Text
ident forall a. Semigroup a => a -> a -> a
<> Text
" from " forall a. Semigroup a => a -> a -> a
<> PSString -> Text
prettyPrintStringJS PSString
from forall a. Semigroup a => a -> a -> a
<> Text
";"
prettyExport :: (Emit gen) => Export -> StateT PrinterState Maybe gen
prettyExport :: forall gen. Emit gen => Export -> StateT PrinterState Maybe gen
prettyExport (Export NonEmpty Text
idents Maybe PSString
from) =
forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
"export {\n"
, forall gen.
StateT PrinterState Maybe gen -> StateT PrinterState Maybe gen
withIndent forall a b. (a -> b) -> a -> b
$ do
let exportsStrings :: NonEmpty gen
exportsStrings = forall gen. Emit gen => Text -> gen
emit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Maybe a -> Text -> Text
exportedIdentToString Maybe PSString
from forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Text
idents
gen
indentString <- forall gen. Emit gen => StateT PrinterState Maybe gen
currentIndent
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Monoid m => m -> [m] -> m
intercalate (forall gen. Emit gen => Text -> gen
emit Text
",\n") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NEL.toList forall a b. (a -> b) -> a -> b
$ (gen
indentString forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty gen
exportsStrings
, forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall gen. Emit gen => Text -> gen
emit Text
"\n"
, forall gen. Emit gen => StateT PrinterState Maybe gen
currentIndent
, forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall gen. Emit gen => Text -> gen
emit forall a b. (a -> b) -> a -> b
$ Text
"}" forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text
" from " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. PSString -> Text
prettyPrintStringJS) Maybe PSString
from forall a. Semigroup a => a -> a -> a
<> Text
";"
]
where
exportedIdentToString :: Maybe a -> Text -> Text
exportedIdentToString Maybe a
Nothing Text
ident
| Text -> Bool
nameIsJsReserved Text
ident Bool -> Bool -> Bool
|| Text -> Bool
nameIsJsBuiltIn Text
ident
= Text
"$$" forall a. Semigroup a => a -> a -> a
<> Text
ident forall a. Semigroup a => a -> a -> a
<> Text
" as " forall a. Semigroup a => a -> a -> a
<> Text
ident
exportedIdentToString Maybe a
_ Text
"$main"
= (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
identCharToText Text
"$main" forall a. Semigroup a => a -> a -> a
<> Text
" as $main"
exportedIdentToString Maybe a
_ Text
ident
= (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
identCharToText Text
ident
accessor :: Pattern PrinterState AST (Text, AST)
accessor :: Pattern PrinterState AST (Text, AST)
accessor = forall a b u. (a -> Maybe b) -> Pattern u a b
mkPattern AST -> Maybe (Text, AST)
match
where
match :: AST -> Maybe (Text, AST)
match (Indexer Maybe SourceSpan
_ (StringLiteral Maybe SourceSpan
_ PSString
prop) AST
val) =
case PSString -> Maybe Text
decodeString PSString
prop of
Just Text
s | Text -> Bool
isValidJsIdentifier Text
s -> forall a. a -> Maybe a
Just (Text
s, AST
val)
Maybe Text
_ -> forall a. Maybe a
Nothing
match AST
_ = forall a. Maybe a
Nothing
indexer :: (Emit gen) => Pattern PrinterState AST (gen, AST)
indexer :: forall gen. Emit gen => Pattern PrinterState AST (gen, AST)
indexer = forall a u b. (a -> StateT u Maybe b) -> Pattern u a b
mkPattern' forall {a}. Emit a => AST -> StateT PrinterState Maybe (a, AST)
match
where
match :: AST -> StateT PrinterState Maybe (a, AST)
match (Indexer Maybe SourceSpan
_ AST
index AST
val) = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
prettyPrintJS' AST
index forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure AST
val
match AST
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero
lam :: Pattern PrinterState AST ((Maybe Text, [Text], Maybe SourceSpan), AST)
lam :: Pattern
PrinterState AST ((Maybe Text, [Text], Maybe SourceSpan), AST)
lam = forall a b u. (a -> Maybe b) -> Pattern u a b
mkPattern AST -> Maybe ((Maybe Text, [Text], Maybe SourceSpan), AST)
match
where
match :: AST -> Maybe ((Maybe Text, [Text], Maybe SourceSpan), AST)
match (Function Maybe SourceSpan
ss Maybe Text
name [Text]
args AST
ret) = forall a. a -> Maybe a
Just ((Maybe Text
name, [Text]
args, Maybe SourceSpan
ss), AST
ret)
match AST
_ = forall a. Maybe a
Nothing
app :: (Emit gen) => Pattern PrinterState AST (gen, AST)
app :: forall gen. Emit gen => Pattern PrinterState AST (gen, AST)
app = forall a u b. (a -> StateT u Maybe b) -> Pattern u a b
mkPattern' forall {a}. Emit a => AST -> StateT PrinterState Maybe (a, AST)
match
where
match :: AST -> StateT PrinterState Maybe (a, AST)
match (App Maybe SourceSpan
_ AST
val [AST]
args) = do
[a]
jss <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
prettyPrintJS' [AST]
args
forall (m :: * -> *) a. Monad m => a -> m a
return (forall m. Monoid m => m -> [m] -> m
intercalate (forall gen. Emit gen => Text -> gen
emit Text
", ") [a]
jss, AST
val)
match AST
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero
instanceOf :: Pattern PrinterState AST (AST, AST)
instanceOf :: Pattern PrinterState AST (AST, AST)
instanceOf = forall a b u. (a -> Maybe b) -> Pattern u a b
mkPattern AST -> Maybe (AST, AST)
match
where
match :: AST -> Maybe (AST, AST)
match (InstanceOf Maybe SourceSpan
_ AST
val AST
ty) = forall a. a -> Maybe a
Just (AST
val, AST
ty)
match AST
_ = forall a. Maybe a
Nothing
unary' :: (Emit gen) => UnaryOperator -> (AST -> Text) -> Operator PrinterState AST gen
unary' :: forall gen.
Emit gen =>
UnaryOperator -> (AST -> Text) -> Operator PrinterState AST gen
unary' UnaryOperator
op AST -> Text
mkStr = forall u a s r.
Pattern u a (s, a) -> (s -> r -> r) -> Operator u a r
Wrap forall gen. Emit gen => Pattern PrinterState AST (gen, AST)
match forall a. Semigroup a => a -> a -> a
(<>)
where
match :: (Emit gen) => Pattern PrinterState AST (gen, AST)
match :: forall gen. Emit gen => Pattern PrinterState AST (gen, AST)
match = forall a b u. (a -> Maybe b) -> Pattern u a b
mkPattern AST -> Maybe (gen, AST)
match'
where
match' :: AST -> Maybe (gen, AST)
match' (Unary Maybe SourceSpan
_ UnaryOperator
op' AST
val) | UnaryOperator
op' forall a. Eq a => a -> a -> Bool
== UnaryOperator
op = forall a. a -> Maybe a
Just (forall gen. Emit gen => Text -> gen
emit forall a b. (a -> b) -> a -> b
$ AST -> Text
mkStr AST
val, AST
val)
match' AST
_ = forall a. Maybe a
Nothing
unary :: (Emit gen) => UnaryOperator -> Text -> Operator PrinterState AST gen
unary :: forall gen.
Emit gen =>
UnaryOperator -> Text -> Operator PrinterState AST gen
unary UnaryOperator
op Text
str = forall gen.
Emit gen =>
UnaryOperator -> (AST -> Text) -> Operator PrinterState AST gen
unary' UnaryOperator
op (forall a b. a -> b -> a
const Text
str)
negateOperator :: (Emit gen) => Operator PrinterState AST gen
negateOperator :: forall gen. Emit gen => Operator PrinterState AST gen
negateOperator = forall gen.
Emit gen =>
UnaryOperator -> (AST -> Text) -> Operator PrinterState AST gen
unary' UnaryOperator
Negate (\AST
v -> if AST -> Bool
isNegate AST
v then Text
"- " else Text
"-")
where
isNegate :: AST -> Bool
isNegate (Unary Maybe SourceSpan
_ UnaryOperator
Negate AST
_) = Bool
True
isNegate AST
_ = Bool
False
binary :: (Emit gen) => BinaryOperator -> Text -> Operator PrinterState AST gen
binary :: forall gen.
Emit gen =>
BinaryOperator -> Text -> Operator PrinterState AST gen
binary BinaryOperator
op Text
str = forall u a r. Pattern u a (a, a) -> (r -> r -> r) -> Operator u a r
AssocL Pattern PrinterState AST (AST, AST)
match (\gen
v1 gen
v2 -> gen
v1 forall a. Semigroup a => a -> a -> a
<> forall gen. Emit gen => Text -> gen
emit (Text
" " forall a. Semigroup a => a -> a -> a
<> Text
str forall a. Semigroup a => a -> a -> a
<> Text
" ") forall a. Semigroup a => a -> a -> a
<> gen
v2)
where
match :: Pattern PrinterState AST (AST, AST)
match :: Pattern PrinterState AST (AST, AST)
match = forall a b u. (a -> Maybe b) -> Pattern u a b
mkPattern AST -> Maybe (AST, AST)
match'
where
match' :: AST -> Maybe (AST, AST)
match' (Binary Maybe SourceSpan
_ BinaryOperator
op' AST
v1 AST
v2) | BinaryOperator
op' forall a. Eq a => a -> a -> Bool
== BinaryOperator
op = forall a. a -> Maybe a
Just (AST
v1, AST
v2)
match' AST
_ = forall a. Maybe a
Nothing
prettyStatements :: (Emit gen) => [AST] -> StateT PrinterState Maybe gen
prettyStatements :: forall gen. Emit gen => [AST] -> StateT PrinterState Maybe gen
prettyStatements [AST]
sts = do
[gen]
jss <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [AST]
sts forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
prettyPrintJS'
gen
indentString <- forall gen. Emit gen => StateT PrinterState Maybe gen
currentIndent
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall m. Monoid m => m -> [m] -> m
intercalate (forall gen. Emit gen => Text -> gen
emit Text
"\n") forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((forall a. Semigroup a => a -> a -> a
<> forall gen. Emit gen => Text -> gen
emit Text
";") forall b c a. (b -> c) -> (a -> b) -> a -> c
. (gen
indentString forall a. Semigroup a => a -> a -> a
<>)) [gen]
jss
prettyModule :: (Emit gen) => Module -> StateT PrinterState Maybe gen
prettyModule :: forall gen. Emit gen => Module -> StateT PrinterState Maybe gen
prettyModule Module{[Comment]
[AST]
[Export]
[Import]
modExports :: Module -> [Export]
modBody :: Module -> [AST]
modImports :: Module -> [Import]
modHeader :: Module -> [Comment]
modExports :: [Export]
modBody :: [AST]
modImports :: [Import]
modHeader :: [Comment]
..} = do
gen
header <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall gen. Emit gen => Comment -> StateT PrinterState Maybe gen
comment [Comment]
modHeader
[gen]
imps <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall gen. Emit gen => Import -> StateT PrinterState Maybe gen
prettyImport [Import]
modImports
gen
body <- forall gen. Emit gen => [AST] -> StateT PrinterState Maybe gen
prettyStatements [AST]
modBody
[gen]
exps <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall gen. Emit gen => Export -> StateT PrinterState Maybe gen
prettyExport [Export]
modExports
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ gen
header forall a. Semigroup a => a -> a -> a
<> forall m. Monoid m => m -> [m] -> m
intercalate (forall gen. Emit gen => Text -> gen
emit Text
"\n") ([gen]
imps forall a. [a] -> [a] -> [a]
++ gen
body forall a. a -> [a] -> [a]
: [gen]
exps)
prettyPrintJSWithSourceMaps :: Module -> (Text, [SMap])
prettyPrintJSWithSourceMaps :: Module -> (Text, [SMap])
prettyPrintJSWithSourceMaps Module
js =
let StrPos (SourcePos
_, Text
s, [SMap]
mp) = (forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
internalError String
"Incomplete pattern") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Int -> PrinterState
PrinterState Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall gen. Emit gen => Module -> StateT PrinterState Maybe gen
prettyModule) Module
js
in (Text
s, [SMap]
mp)
prettyPrintJS :: Module -> Text
prettyPrintJS :: Module -> Text
prettyPrintJS = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => String -> a
internalError String
"Incomplete pattern") PlainString -> Text
runPlainString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Int -> PrinterState
PrinterState Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall gen. Emit gen => Module -> StateT PrinterState Maybe gen
prettyModule
prettyPrintJS' :: (Emit gen) => AST -> StateT PrinterState Maybe gen
prettyPrintJS' :: forall gen. Emit gen => AST -> StateT PrinterState Maybe gen
prettyPrintJS' = forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
A.runKleisli forall a b. (a -> b) -> a -> b
$ forall u a b. Pattern u a b -> Kleisli (StateT u Maybe) a b
runPattern forall gen. Emit gen => Pattern PrinterState AST gen
matchValue
where
matchValue :: (Emit gen) => Pattern PrinterState AST gen
matchValue :: forall gen. Emit gen => Pattern PrinterState AST gen
matchValue = forall u a r. OperatorTable u a r -> Pattern u a r -> Pattern u a r
buildPrettyPrinter forall gen. Emit gen => OperatorTable PrinterState AST gen
operators (forall gen. Emit gen => Pattern PrinterState AST gen
literals forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall gen. Emit gen => gen -> gen
parensPos forall gen. Emit gen => Pattern PrinterState AST gen
matchValue)
operators :: (Emit gen) => OperatorTable PrinterState AST gen
operators :: forall gen. Emit gen => OperatorTable PrinterState AST gen
operators =
forall u a r. [[Operator u a r]] -> OperatorTable u a r
OperatorTable [ [ forall u a s r.
Pattern u a (s, a) -> (s -> r -> r) -> Operator u a r
Wrap forall gen. Emit gen => Pattern PrinterState AST (gen, AST)
indexer forall a b. (a -> b) -> a -> b
$ \gen
index gen
val -> gen
val forall a. Semigroup a => a -> a -> a
<> forall gen. Emit gen => Text -> gen
emit Text
"[" forall a. Semigroup a => a -> a -> a
<> gen
index forall a. Semigroup a => a -> a -> a
<> forall gen. Emit gen => Text -> gen
emit Text
"]" ]
, [ forall u a s r.
Pattern u a (s, a) -> (s -> r -> r) -> Operator u a r
Wrap Pattern PrinterState AST (Text, AST)
accessor forall a b. (a -> b) -> a -> b
$ \Text
prop gen
val -> gen
val forall a. Semigroup a => a -> a -> a
<> forall gen. Emit gen => Text -> gen
emit Text
"." forall a. Semigroup a => a -> a -> a
<> forall gen. Emit gen => Text -> gen
emit Text
prop ]
, [ forall u a s r.
Pattern u a (s, a) -> (s -> r -> r) -> Operator u a r
Wrap forall gen. Emit gen => Pattern PrinterState AST (gen, AST)
app forall a b. (a -> b) -> a -> b
$ \gen
args gen
val -> gen
val forall a. Semigroup a => a -> a -> a
<> forall gen. Emit gen => Text -> gen
emit Text
"(" forall a. Semigroup a => a -> a -> a
<> gen
args forall a. Semigroup a => a -> a -> a
<> forall gen. Emit gen => Text -> gen
emit Text
")" ]
, [ forall gen.
Emit gen =>
UnaryOperator -> Text -> Operator PrinterState AST gen
unary UnaryOperator
New Text
"new " ]
, [ forall u a s r.
Pattern u a (s, a) -> (s -> r -> r) -> Operator u a r
Wrap Pattern
PrinterState AST ((Maybe Text, [Text], Maybe SourceSpan), AST)
lam forall a b. (a -> b) -> a -> b
$ \(Maybe Text
name, [Text]
args, Maybe SourceSpan
ss) gen
ret -> forall gen. Emit gen => Maybe SourceSpan -> gen
addMapping' Maybe SourceSpan
ss forall a. Semigroup a => a -> a -> a
<>
forall gen. Emit gen => Text -> gen
emit (Text
"function "
forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
name
forall a. Semigroup a => a -> a -> a
<> Text
"(" forall a. Semigroup a => a -> a -> a
<> forall m. Monoid m => m -> [m] -> m
intercalate Text
", " [Text]
args forall a. Semigroup a => a -> a -> a
<> Text
") ")
forall a. Semigroup a => a -> a -> a
<> gen
ret ]
, [ forall gen.
Emit gen =>
UnaryOperator -> Text -> Operator PrinterState AST gen
unary UnaryOperator
Not Text
"!"
, forall gen.
Emit gen =>
UnaryOperator -> Text -> Operator PrinterState AST gen
unary UnaryOperator
BitwiseNot Text
"~"
, forall gen.
Emit gen =>
UnaryOperator -> Text -> Operator PrinterState AST gen
unary UnaryOperator
Positive Text
"+"
, forall gen. Emit gen => Operator PrinterState AST gen
negateOperator ]
, [ forall gen.
Emit gen =>
BinaryOperator -> Text -> Operator PrinterState AST gen
binary BinaryOperator
Multiply Text
"*"
, forall gen.
Emit gen =>
BinaryOperator -> Text -> Operator PrinterState AST gen
binary BinaryOperator
Divide Text
"/"
, forall gen.
Emit gen =>
BinaryOperator -> Text -> Operator PrinterState AST gen
binary BinaryOperator
Modulus Text
"%" ]
, [ forall gen.
Emit gen =>
BinaryOperator -> Text -> Operator PrinterState AST gen
binary BinaryOperator
Add Text
"+"
, forall gen.
Emit gen =>
BinaryOperator -> Text -> Operator PrinterState AST gen
binary BinaryOperator
Subtract Text
"-" ]
, [ forall gen.
Emit gen =>
BinaryOperator -> Text -> Operator PrinterState AST gen
binary BinaryOperator
ShiftLeft Text
"<<"
, forall gen.
Emit gen =>
BinaryOperator -> Text -> Operator PrinterState AST gen
binary BinaryOperator
ShiftRight Text
">>"
, forall gen.
Emit gen =>
BinaryOperator -> Text -> Operator PrinterState AST gen
binary BinaryOperator
ZeroFillShiftRight Text
">>>" ]
, [ forall gen.
Emit gen =>
BinaryOperator -> Text -> Operator PrinterState AST gen
binary BinaryOperator
LessThan Text
"<"
, forall gen.
Emit gen =>
BinaryOperator -> Text -> Operator PrinterState AST gen
binary BinaryOperator
LessThanOrEqualTo Text
"<="
, forall gen.
Emit gen =>
BinaryOperator -> Text -> Operator PrinterState AST gen
binary BinaryOperator
GreaterThan Text
">"
, forall gen.
Emit gen =>
BinaryOperator -> Text -> Operator PrinterState AST gen
binary BinaryOperator
GreaterThanOrEqualTo Text
">="
, forall u a r. Pattern u a (a, a) -> (r -> r -> r) -> Operator u a r
AssocR Pattern PrinterState AST (AST, AST)
instanceOf forall a b. (a -> b) -> a -> b
$ \gen
v1 gen
v2 -> gen
v1 forall a. Semigroup a => a -> a -> a
<> forall gen. Emit gen => Text -> gen
emit Text
" instanceof " forall a. Semigroup a => a -> a -> a
<> gen
v2 ]
, [ forall gen.
Emit gen =>
BinaryOperator -> Text -> Operator PrinterState AST gen
binary BinaryOperator
EqualTo Text
"==="
, forall gen.
Emit gen =>
BinaryOperator -> Text -> Operator PrinterState AST gen
binary BinaryOperator
NotEqualTo Text
"!==" ]
, [ forall gen.
Emit gen =>
BinaryOperator -> Text -> Operator PrinterState AST gen
binary BinaryOperator
BitwiseAnd Text
"&" ]
, [ forall gen.
Emit gen =>
BinaryOperator -> Text -> Operator PrinterState AST gen
binary BinaryOperator
BitwiseXor Text
"^" ]
, [ forall gen.
Emit gen =>
BinaryOperator -> Text -> Operator PrinterState AST gen
binary BinaryOperator
BitwiseOr Text
"|" ]
, [ forall gen.
Emit gen =>
BinaryOperator -> Text -> Operator PrinterState AST gen
binary BinaryOperator
And Text
"&&" ]
, [ forall gen.
Emit gen =>
BinaryOperator -> Text -> Operator PrinterState AST gen
binary BinaryOperator
Or Text
"||" ]
]