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 (Operator(..), OperatorTable(..), Pattern(..), buildPrettyPrinter, mkPattern, mkPattern')
import Control.Arrow qualified as A
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import Data.List.NonEmpty qualified as NEL (toList)
import Language.PureScript.AST (SourceSpan(..))
import Language.PureScript.CodeGen.JS.Common (identCharToText, isValidJsIdentifier, nameIsJsBuiltIn, nameIsJsReserved)
import Language.PureScript.CoreImp.AST (AST(..), BinaryOperator(..), CIComments(..), UnaryOperator(..), getSourceSpan)
import Language.PureScript.CoreImp.Module (Export(..), Import(..), Module(..))
import Language.PureScript.Comments (Comment(..))
import Language.PureScript.Crash (internalError)
import Language.PureScript.Pretty.Common (Emit(..), PrinterState(..), SMap, StrPos(..), addMapping', currentIndent, intercalate, parensPos, runPlainString, withIndent)
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
"||" ]
]