{-# LANGUAGE FlexibleInstances, UndecidableInstances, OverlappingInstances, TypeFamilies, TemplateHaskell, QuasiQuotes, RankNTypes, GADTs #-}

-----------------------------------------------------------------------------
{- |
Module      :  Language.Javascript.JMacro
Copyright   :  (c) Gershom Bazerman, 2009
License     :  BSD 3 Clause
Maintainer  :  gershomb@gmail.com
Stability   :  experimental

Simple EDSL for lightweight (untyped) programmatic generation of Javascript.
-}
-----------------------------------------------------------------------------

module Language.Javascript.JMacro.QQ(jmacro,jmacroE,parseJM,parseJME) where
import Prelude hiding (tail, init, head, last, minimum, maximum, foldr1, foldl1, (!!), read)
import Control.Applicative hiding ((<|>),many,optional)
import Control.Arrow(first)
import Control.Monad (ap, return, liftM2, liftM3, when, mzero, guard)
import Control.Monad.State.Strict
import Data.Char(digitToInt, toLower, isUpper)
import Data.List(isPrefixOf, sort)
import Data.Generics(extQ,Data)
import Data.Maybe(fromMaybe)
import Data.Monoid
import qualified Data.Map as M

--import Language.Haskell.Meta.Parse
import qualified Language.Haskell.TH as TH
import Language.Haskell.TH(mkName)
--import qualified Language.Haskell.TH.Lib as TH
import Language.Haskell.TH.Quote

import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Expr
import Text.ParserCombinators.Parsec.Error
import qualified Text.ParserCombinators.Parsec.Token as P
import Text.ParserCombinators.Parsec.Language(javaStyle)

import Text.Regex.Posix.String

import Language.Javascript.JMacro.Base
import Language.Javascript.JMacro.Types
import Language.Javascript.JMacro.ParseTH

import System.IO.Unsafe
import Numeric(readHex)

-- import Debug.Trace

{--------------------------------------------------------------------
  QuasiQuotation
--------------------------------------------------------------------}

-- | QuasiQuoter for a block of JMacro statements.
jmacro :: QuasiQuoter
jmacro :: QuasiQuoter
jmacro = QuasiQuoter {quoteExp :: [Char] -> Q Exp
quoteExp = [Char] -> Q Exp
quoteJMExp, quotePat :: [Char] -> Q Pat
quotePat = [Char] -> Q Pat
quoteJMPat}

-- | QuasiQuoter for a JMacro expression.
jmacroE :: QuasiQuoter
jmacroE :: QuasiQuoter
jmacroE = QuasiQuoter {quoteExp :: [Char] -> Q Exp
quoteExp = [Char] -> Q Exp
quoteJMExpE, quotePat :: [Char] -> Q Pat
quotePat = [Char] -> Q Pat
quoteJMPatE}

quoteJMPat :: String -> TH.PatQ
quoteJMPat :: [Char] -> Q Pat
quoteJMPat [Char]
s = case [Char] -> Either ParseError JStat
parseJM [Char]
s of
               Right JStat
x -> forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) JStat
x
               Left ParseError
err -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (forall a. Show a => a -> [Char]
show ParseError
err)

quoteJMExp :: String -> TH.ExpQ
quoteJMExp :: [Char] -> Q Exp
quoteJMExp [Char]
s = case [Char] -> Either ParseError JStat
parseJM [Char]
s of
               Right JStat
x -> forall a. Data a => a -> Q Exp
jm2th JStat
x
               Left ParseError
err -> do
                   (Int
line,Int
_) <- Loc -> (Int, Int)
TH.loc_start forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Loc
TH.location
                   let pos :: SourcePos
pos = ParseError -> SourcePos
errorPos ParseError
err
                   let newPos :: SourcePos
newPos = SourcePos -> Int -> SourcePos
setSourceLine SourcePos
pos forall a b. (a -> b) -> a -> b
$ Int
line forall a. Num a => a -> a -> a
+ SourcePos -> Int
sourceLine SourcePos
pos forall a. Num a => a -> a -> a
- Int
1
                   forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ SourcePos -> ParseError -> ParseError
setErrorPos SourcePos
newPos ParseError
err)

quoteJMPatE :: String -> TH.PatQ
quoteJMPatE :: [Char] -> Q Pat
quoteJMPatE [Char]
s = case [Char] -> Either ParseError JExpr
parseJME [Char]
s of
               Right JExpr
x -> forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) JExpr
x
               Left ParseError
err -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (forall a. Show a => a -> [Char]
show ParseError
err)

quoteJMExpE :: String -> TH.ExpQ
quoteJMExpE :: [Char] -> Q Exp
quoteJMExpE [Char]
s = case [Char] -> Either ParseError JExpr
parseJME [Char]
s of
               Right JExpr
x -> forall a. Data a => a -> Q Exp
jm2th JExpr
x
               Left ParseError
err -> do
                   (Int
line,Int
_) <- Loc -> (Int, Int)
TH.loc_start forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Loc
TH.location
                   let pos :: SourcePos
pos = ParseError -> SourcePos
errorPos ParseError
err
                   let newPos :: SourcePos
newPos = SourcePos -> Int -> SourcePos
setSourceLine SourcePos
pos forall a b. (a -> b) -> a -> b
$ Int
line forall a. Num a => a -> a -> a
+ SourcePos -> Int
sourceLine SourcePos
pos forall a. Num a => a -> a -> a
- Int
1
                   forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ SourcePos -> ParseError -> ParseError
setErrorPos SourcePos
newPos ParseError
err)


-- | Traverse a syntax tree, replace an identifier by an
-- antiquotation of a free variable.
-- Don't replace identifiers on the right hand side of selector
-- expressions.
antiIdent :: JMacro a => String -> a -> a
antiIdent :: forall a. JMacro a => [Char] -> a -> a
antiIdent [Char]
s a
e = forall a. JMacro a => JMGadt a -> a
jfromGADT forall a b. (a -> b) -> a -> b
$ forall a. JMGadt a -> JMGadt a
go (forall a. JMacro a => a -> JMGadt a
jtoGADT a
e)
    where go :: forall a. JMGadt a -> JMGadt a
          go :: forall a. JMGadt a -> JMGadt a
go (JMGExpr (ValExpr (JVar (StrI [Char]
s'))))
             | [Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
s' = JExpr -> JMGadt JExpr
JMGExpr ([Char] -> JExpr
AntiExpr forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
fixIdent [Char]
s)
          go (JMGExpr (SelExpr JExpr
x Ident
i)) =
              JExpr -> JMGadt JExpr
JMGExpr (JExpr -> Ident -> JExpr
SelExpr (forall a. JMacro a => [Char] -> a -> a
antiIdent [Char]
s JExpr
x) Ident
i)
          go JMGadt a
x = forall (t :: * -> *) b.
Compos t =>
(forall a. t a -> t a) -> t b -> t b
composOp forall a. JMGadt a -> JMGadt a
go JMGadt a
x

antiIdents :: JMacro a => [String] -> a -> a
antiIdents :: forall a. JMacro a => [[Char]] -> a -> a
antiIdents [[Char]]
ss a
x = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. JMacro a => [Char] -> a -> a
antiIdent a
x [[Char]]
ss

fixIdent :: String -> String
fixIdent :: [Char] -> [Char]
fixIdent [Char]
"_" = [Char]
"_x_"
fixIdent css :: [Char]
css@(Char
c:[Char]
_)
    | Char -> Bool
isUpper Char
c = Char
'_' forall a. a -> [a] -> [a]
: [Char] -> [Char]
escapeDollar [Char]
css
    | Bool
otherwise = [Char] -> [Char]
escapeDollar [Char]
css
  where
    escapeDollar :: [Char] -> [Char]
escapeDollar = forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char
x forall a. Eq a => a -> a -> Bool
==Char
'$' then Char
'dž' else Char
x)
fixIdent [Char]
_ = [Char]
"_x_"


jm2th :: Data a => a -> TH.ExpQ
jm2th :: forall a. Data a => a -> Q Exp
jm2th a
v = forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Exp)) -> a -> m Exp
dataToExpQ (forall a b. a -> b -> a
const forall a. Maybe a
Nothing
                      forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` JStat -> Maybe (Q Exp)
handleStat
                      forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` JExpr -> Maybe (Q Exp)
handleExpr
                      forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` JVal -> Maybe (Q Exp)
handleVal
                      forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [Char] -> Maybe (Q Exp)
handleStr
                      forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` JType -> Maybe (Q Exp)
handleTyp
                     ) a
v

    where handleStat :: JStat -> Maybe (TH.ExpQ)
          handleStat :: JStat -> Maybe (Q Exp)
handleStat (BlockStat [JStat]
ss) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
                                      forall {m :: * -> *}. Quote m => [Char] -> m Exp -> m Exp
appConstr [Char]
"BlockStat" forall a b. (a -> b) -> a -> b
$
                                      forall (m :: * -> *). Quote m => [m Exp] -> m Exp
TH.listE ([JStat] -> [Q Exp]
blocks [JStat]
ss)
              where blocks :: [JStat] -> [TH.ExpQ]
                    blocks :: [JStat] -> [Q Exp]
blocks [] = []
                    blocks (DeclStat (StrI [Char]
i) Maybe JLocalType
t:[JStat]
xs) = case [Char]
i of
                     (Char
'!':Char
'!':[Char]
i') -> forall a. Data a => a -> Q Exp
jm2th (Ident -> Maybe JLocalType -> JStat
DeclStat ([Char] -> Ident
StrI [Char]
i') Maybe JLocalType
t) forall a. a -> [a] -> [a]
: [JStat] -> [Q Exp]
blocks [JStat]
xs
                     (Char
'!':[Char]
i') ->
                        [forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
TH.lamE [forall (m :: * -> *). Quote m => Name -> m Pat
TH.varP forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Name
mkName forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
fixIdent forall a b. (a -> b) -> a -> b
$ [Char]
i'] forall a b. (a -> b) -> a -> b
$
                                 forall {m :: * -> *}. Quote m => [Char] -> m Exp -> m Exp
appConstr [Char]
"BlockStat"
                                 (forall (m :: * -> *). Quote m => [m Exp] -> m Exp
TH.listE forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Q Exp
dsforall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JStat] -> [Q Exp]
blocks forall a b. (a -> b) -> a -> b
$ [JStat]
xs)) (forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (forall (m :: * -> *). Quote m => Name -> m Exp
TH.varE forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"jsv")
                                                                            (forall (m :: * -> *). Quote m => Lit -> m Exp
TH.litE forall a b. (a -> b) -> a -> b
$ [Char] -> Lit
TH.StringL [Char]
i'))]
                        where ds :: Q Exp
ds =
                                  forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE
                                        (forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (forall (m :: * -> *). Quote m => Name -> m Exp
TH.conE forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"DeclStat")
                                               (forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (forall (m :: * -> *). Quote m => Name -> m Exp
TH.conE forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"StrI")
                                                      (forall (m :: * -> *). Quote m => Lit -> m Exp
TH.litE forall a b. (a -> b) -> a -> b
$ [Char] -> Lit
TH.StringL [Char]
i')))
                                        (forall a. Data a => a -> Q Exp
jm2th Maybe JLocalType
t)
                     [Char]
_ ->
                        [forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE
                           (forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (forall (m :: * -> *). Quote m => Name -> m Exp
TH.varE forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"jVarTy")
                                  (forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
TH.lamE [forall (m :: * -> *). Quote m => Name -> m Pat
TH.varP forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Name
mkName forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
fixIdent forall a b. (a -> b) -> a -> b
$ [Char]
i] forall a b. (a -> b) -> a -> b
$
                                     forall {m :: * -> *}. Quote m => [Char] -> m Exp -> m Exp
appConstr [Char]
"BlockStat"
                                     (forall (m :: * -> *). Quote m => [m Exp] -> m Exp
TH.listE forall a b. (a -> b) -> a -> b
$ [JStat] -> [Q Exp]
blocks forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. JMacro a => [Char] -> a -> a
antiIdent [Char]
i) [JStat]
xs)))
                           (forall a. Data a => a -> Q Exp
jm2th Maybe JLocalType
t)
                        ]

                    blocks (JStat
x:[JStat]
xs) = forall a. Data a => a -> Q Exp
jm2th JStat
x forall a. a -> [a] -> [a]
: [JStat] -> [Q Exp]
blocks [JStat]
xs



          handleStat (ForInStat Bool
b (StrI [Char]
i) JExpr
e JStat
s) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
                 forall {t :: * -> *} {m :: * -> *}.
(Foldable t, Quote m) =>
m Exp -> t (m Exp) -> m Exp
appFun (forall (m :: * -> *). Quote m => Name -> m Exp
TH.varE forall a b. (a -> b) -> a -> b
$ Name
forFunc)
                        [forall a. Data a => a -> Q Exp
jm2th JExpr
e,
                         forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
TH.lamE [forall (m :: * -> *). Quote m => Name -> m Pat
TH.varP forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
i]
                                 (forall a. Data a => a -> Q Exp
jm2th forall a b. (a -> b) -> a -> b
$ forall a. JMacro a => [Char] -> a -> a
antiIdent [Char]
i JStat
s)
                         ]
              where forFunc :: Name
forFunc
                        | Bool
b = [Char] -> Name
mkName [Char]
"jForEachIn"
                        | Bool
otherwise = [Char] -> Name
mkName [Char]
"jForIn"

          handleStat (TryStat JStat
s (StrI [Char]
i) JStat
s1 JStat
s2)
              | JStat
s1 forall a. Eq a => a -> a -> Bool
== [JStat] -> JStat
BlockStat [] = forall a. Maybe a
Nothing
              | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
                 forall {t :: * -> *} {m :: * -> *}.
(Foldable t, Quote m) =>
m Exp -> t (m Exp) -> m Exp
appFun (forall (m :: * -> *). Quote m => Name -> m Exp
TH.varE forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"jTryCatchFinally")
                        [forall a. Data a => a -> Q Exp
jm2th JStat
s,
                         forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
TH.lamE [forall (m :: * -> *). Quote m => Name -> m Pat
TH.varP forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
i]
                                 (forall a. Data a => a -> Q Exp
jm2th forall a b. (a -> b) -> a -> b
$ forall a. JMacro a => [Char] -> a -> a
antiIdent [Char]
i JStat
s1),
                         forall a. Data a => a -> Q Exp
jm2th JStat
s2
                         ]

          handleStat (AntiStat [Char]
s) = case [Char] -> Either [Char] Exp
parseHSExp [Char]
s of
                                      Right Exp
ans -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (forall (m :: * -> *). Quote m => Name -> m Exp
TH.varE ([Char] -> Name
mkName [Char]
"toStat"))
                                                                  (forall (m :: * -> *) a. Monad m => a -> m a
return Exp
ans)
                                      Left [Char]
err -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
err

          handleStat JStat
_ = forall a. Maybe a
Nothing

          handleExpr :: JExpr -> Maybe (TH.ExpQ)
          handleExpr :: JExpr -> Maybe (Q Exp)
handleExpr (AntiExpr [Char]
s) = case [Char] -> Either [Char] Exp
parseHSExp [Char]
s of
                                      Right Exp
ans -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (forall (m :: * -> *). Quote m => Name -> m Exp
TH.varE ([Char] -> Name
mkName [Char]
"toJExpr")) (forall (m :: * -> *) a. Monad m => a -> m a
return Exp
ans)
                                      Left [Char]
err -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
err
          handleExpr (ValExpr (JFunc [Ident]
is' JStat
s)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
              forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (forall (m :: * -> *). Quote m => Name -> m Exp
TH.varE forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"jLam")
                      (forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
TH.lamE (forall a b. (a -> b) -> [a] -> [b]
map (forall (m :: * -> *). Quote m => Name -> m Pat
TH.varP forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Name
mkName forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
fixIdent) [[Char]]
is)
                               (forall a. Data a => a -> Q Exp
jm2th forall a b. (a -> b) -> a -> b
$ forall a. JMacro a => [[Char]] -> a -> a
antiIdents [[Char]]
is JStat
s))
            where is :: [[Char]]
is = forall a b. (a -> b) -> [a] -> [b]
map (\(StrI [Char]
i) -> [Char]
i) [Ident]
is'

          handleExpr JExpr
_ = forall a. Maybe a
Nothing

          handleVal :: JVal -> Maybe (TH.ExpQ)
          handleVal :: JVal -> Maybe (Q Exp)
handleVal (JHash Map [Char] JExpr
m) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
                                forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (forall (m :: * -> *). Quote m => Name -> m Exp
TH.varE forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"jhFromList") forall a b. (a -> b) -> a -> b
$
                                forall a. Data a => a -> Q Exp
jm2th (forall k a. Map k a -> [(k, a)]
M.toList Map [Char] JExpr
m)
          handleVal JVal
_ = forall a. Maybe a
Nothing

          handleStr :: String -> Maybe (TH.ExpQ)
          handleStr :: [Char] -> Maybe (Q Exp)
handleStr [Char]
x = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Lit -> m Exp
TH.litE forall a b. (a -> b) -> a -> b
$ [Char] -> Lit
TH.StringL [Char]
x

          handleTyp :: JType -> Maybe (TH.ExpQ)
          handleTyp :: JType -> Maybe (Q Exp)
handleTyp (JTRecord JType
t Map [Char] JType
mp) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
                                    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (forall (m :: * -> *). Quote m => Name -> m Exp
TH.varE forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"jtFromList") (forall a. Data a => a -> Q Exp
jm2th JType
t))
                                          (forall a. Data a => a -> Q Exp
jm2th forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map [Char] JType
mp)

          handleTyp JType
_ = forall a. Maybe a
Nothing

          appFun :: m Exp -> t (m Exp) -> m Exp
appFun m Exp
x = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE) m Exp
x
          appConstr :: [Char] -> m Exp -> m Exp
appConstr [Char]
n = forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (forall (m :: * -> *). Quote m => Name -> m Exp
TH.conE forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
n)


{--------------------------------------------------------------------
  Parsing
--------------------------------------------------------------------}

type JMParser a =  CharParser () a

lexer :: P.TokenParser ()
symbol :: String -> JMParser String
parens, braces :: JMParser a -> JMParser a
dot, colon, semi, identifier, identifierWithBang :: JMParser String
whiteSpace :: JMParser ()
reserved, reservedOp :: String -> JMParser ()
commaSep, commaSep1 :: JMParser a -> JMParser [a]

lexer :: TokenParser ()
lexer = forall s (m :: * -> *) u.
Stream s m Char =>
GenLanguageDef s u m -> GenTokenParser s u m
P.makeTokenParser LanguageDef ()
jsLang

jsLang :: P.LanguageDef ()
jsLang :: LanguageDef ()
jsLang = forall st. LanguageDef st
javaStyle {
           reservedNames :: [[Char]]
P.reservedNames = [[Char]
"var",[Char]
"return",[Char]
"if",[Char]
"else",[Char]
"while",[Char]
"for",[Char]
"in",[Char]
"break",[Char]
"continue",[Char]
"new",[Char]
"function",[Char]
"switch",[Char]
"case",[Char]
"default",[Char]
"fun",[Char]
"try",[Char]
"catch",[Char]
"finally",[Char]
"foreign",[Char]
"do"],
           reservedOpNames :: [[Char]]
P.reservedOpNames = [[Char]
"|>",[Char]
"<|",[Char]
"+=",[Char]
"-=",[Char]
"*=",[Char]
"/=",[Char]
"%=",[Char]
"<<=", [Char]
">>=", [Char]
">>>=", [Char]
"&=", [Char]
"^=", [Char]
"|=", [Char]
"--",[Char]
"*",[Char]
"/",[Char]
"+",[Char]
"-",[Char]
".",[Char]
"%",[Char]
"?",[Char]
"=",[Char]
"==",[Char]
"!=",[Char]
"<",[Char]
">",[Char]
"&&",[Char]
"||",[Char]
"&", [Char]
"^", [Char]
"|", [Char]
"++",[Char]
"===",[Char]
"!==", [Char]
">=",[Char]
"<=",[Char]
"!", [Char]
"~", [Char]
"<<", [Char]
">>", [Char]
">>>", [Char]
"->",[Char]
"::",[Char]
"::!",[Char]
":|",[Char]
"@"],
           identLetter :: ParsecT [Char] () Identity Char
P.identLetter = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"_$",
           identStart :: ParsecT [Char] () Identity Char
P.identStart  = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"_$",
           opStart :: ParsecT [Char] () Identity Char
P.opStart = forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"|+-/*%<>&^.?=!~:@",
           opLetter :: ParsecT [Char] () Identity Char
P.opLetter = forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"|+-/*%<>&^.?=!~:@",
           commentLine :: [Char]
P.commentLine = [Char]
"//",
           commentStart :: [Char]
P.commentStart = [Char]
"/*",
           commentEnd :: [Char]
P.commentEnd = [Char]
"*/",
           caseSensitive :: Bool
P.caseSensitive = Bool
True
           }

identifierWithBang :: JMParser [Char]
identifierWithBang = forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m [Char]
P.identifier forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
GenLanguageDef s u m -> GenTokenParser s u m
P.makeTokenParser forall a b. (a -> b) -> a -> b
$ LanguageDef ()
jsLang {identStart :: ParsecT [Char] () Identity Char
P.identStart = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"_$!"}

whiteSpace :: JMParser ()
whiteSpace= forall s u (m :: * -> *). GenTokenParser s u m -> ParsecT s u m ()
P.whiteSpace TokenParser ()
lexer
symbol :: [Char] -> JMParser [Char]
symbol    = forall s u (m :: * -> *).
GenTokenParser s u m -> [Char] -> ParsecT s u m [Char]
P.symbol TokenParser ()
lexer
parens :: forall a. JMParser a -> JMParser a
parens    = forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
P.parens TokenParser ()
lexer
braces :: forall a. JMParser a -> JMParser a
braces    = forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
P.braces TokenParser ()
lexer
-- brackets  = P.brackets lexer
dot :: JMParser [Char]
dot       = forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m [Char]
P.dot TokenParser ()
lexer
colon :: JMParser [Char]
colon     = forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m [Char]
P.colon TokenParser ()
lexer
semi :: JMParser [Char]
semi      = forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m [Char]
P.semi TokenParser ()
lexer
identifier :: JMParser [Char]
identifier= forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m [Char]
P.identifier TokenParser ()
lexer
reserved :: [Char] -> JMParser ()
reserved  = forall s u (m :: * -> *).
GenTokenParser s u m -> [Char] -> ParsecT s u m ()
P.reserved TokenParser ()
lexer
reservedOp :: [Char] -> JMParser ()
reservedOp= forall s u (m :: * -> *).
GenTokenParser s u m -> [Char] -> ParsecT s u m ()
P.reservedOp TokenParser ()
lexer
commaSep1 :: forall a. JMParser a -> JMParser [a]
commaSep1 = forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m [a]
P.commaSep1 TokenParser ()
lexer
commaSep :: forall a. JMParser a -> JMParser [a]
commaSep  = forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m [a]
P.commaSep  TokenParser ()
lexer

lexeme :: JMParser a -> JMParser a
lexeme :: forall a. JMParser a -> JMParser a
lexeme    = forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
P.lexeme TokenParser ()
lexer

(<<*) :: Monad m => m b -> m a -> m b
m b
x <<* :: forall (m :: * -> *) b a. Monad m => m b -> m a -> m b
<<* m a
y = do
  b
xr <- m b
x
  a
_ <- m a
y
  forall (m :: * -> *) a. Monad m => a -> m a
return b
xr

parseJM :: String -> Either ParseError JStat
parseJM :: [Char] -> Either ParseError JStat
parseJM [Char]
s = [JStat] -> JStat
BlockStat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall tok st a.
GenParser tok st a -> st -> [Char] -> [tok] -> Either ParseError a
runParser ParsecT [Char] () Identity [JStat]
jmacroParser () [Char]
"" [Char]
s
    where jmacroParser :: ParsecT [Char] () Identity [JStat]
jmacroParser = do
            [JStat]
ans <- ParsecT [Char] () Identity [JStat]
statblock
            forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
            forall (m :: * -> *) a. Monad m => a -> m a
return [JStat]
ans

parseJME :: String -> Either ParseError JExpr
parseJME :: [Char] -> Either ParseError JExpr
parseJME [Char]
s = forall tok st a.
GenParser tok st a -> st -> [Char] -> [tok] -> Either ParseError a
runParser ParsecT [Char] () Identity JExpr
jmacroParserE () [Char]
"" [Char]
s
    where jmacroParserE :: ParsecT [Char] () Identity JExpr
jmacroParserE = do
            JExpr
ans <- JMParser ()
whiteSpace forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] () Identity JExpr
expr
            forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
            forall (m :: * -> *) a. Monad m => a -> m a
return JExpr
ans

getType :: JMParser (Bool, JLocalType)
getType :: JMParser (Bool, JLocalType)
getType = do
  Bool
isForce <- ([Char] -> JMParser ()
reservedOp [Char]
"::!" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Char] -> JMParser ()
reservedOp [Char]
"::" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
  JLocalType
t <- forall a. CharParser a JLocalType
runTypeParser
  forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
isForce, JLocalType
t)

addForcedType :: Maybe (Bool, JLocalType) -> JExpr -> JExpr
addForcedType :: Maybe (Bool, JLocalType) -> JExpr -> JExpr
addForcedType (Just (Bool
True,JLocalType
t)) JExpr
e = Bool -> JExpr -> JLocalType -> JExpr
TypeExpr Bool
True JExpr
e JLocalType
t
addForcedType Maybe (Bool, JLocalType)
_ JExpr
e = JExpr
e

--function !foo or function foo or var !x or var x, with optional type
varidentdecl :: JMParser (Ident, Maybe (Bool, JLocalType))
varidentdecl :: JMParser (Ident, Maybe (Bool, JLocalType))
varidentdecl = do
  [Char]
i <- JMParser [Char]
identifierWithBang
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
"jmId_" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
i Bool -> Bool -> Bool
|| [Char]
"!jmId_" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
i) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Illegal use of reserved jmId_ prefix in variable name."
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
iforall a. Eq a => a -> a -> Bool
==[Char]
"this" Bool -> Bool -> Bool
|| [Char]
iforall a. Eq a => a -> a -> Bool
==[Char]
"!this") forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Illegal attempt to name variable 'this'."
  Maybe (Bool, JLocalType)
t <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe JMParser (Bool, JLocalType)
getType
  forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Ident
StrI [Char]
i, Maybe (Bool, JLocalType)
t)

--any other identifier decl
identdecl :: JMParser Ident
identdecl :: JMParser Ident
identdecl = do
  [Char]
i <- JMParser [Char]
identifier
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
"jmId_" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
i) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Illegal use of reserved jmId_ prefix in variable name."
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
iforall a. Eq a => a -> a -> Bool
==[Char]
"this") forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Illegal attempt to name variable 'this'."
  forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Ident
StrI [Char]
i)

cleanIdent :: Ident -> Ident
cleanIdent :: Ident -> Ident
cleanIdent (StrI (Char
'!':[Char]
x)) = [Char] -> Ident
StrI [Char]
x
cleanIdent Ident
x = Ident
x

-- Handle varident decls for type annotations?
-- Patterns
data PatternTree = PTAs Ident PatternTree
                 | PTCons PatternTree PatternTree
                 | PTList [PatternTree]
                 | PTObj [(String,PatternTree)]
                 | PTVar Ident
                   deriving Int -> PatternTree -> [Char] -> [Char]
[PatternTree] -> [Char] -> [Char]
PatternTree -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [PatternTree] -> [Char] -> [Char]
$cshowList :: [PatternTree] -> [Char] -> [Char]
show :: PatternTree -> [Char]
$cshow :: PatternTree -> [Char]
showsPrec :: Int -> PatternTree -> [Char] -> [Char]
$cshowsPrec :: Int -> PatternTree -> [Char] -> [Char]
Show
patternTree :: JMParser PatternTree
patternTree :: JMParser PatternTree
patternTree = [PatternTree] -> PatternTree
toCons forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. JMParser a -> JMParser a
parens JMParser PatternTree
patternTree forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> JMParser PatternTree
ptList forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> JMParser PatternTree
ptObj forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> JMParser PatternTree
varOrAs) forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy1` [Char] -> JMParser ()
reservedOp [Char]
":|"
    where
      toCons :: [PatternTree] -> PatternTree
toCons [] = Ident -> PatternTree
PTVar ([Char] -> Ident
StrI [Char]
"_")
      toCons [PatternTree
x] = PatternTree
x
      toCons (PatternTree
x:[PatternTree]
xs) = PatternTree -> PatternTree -> PatternTree
PTCons PatternTree
x ([PatternTree] -> PatternTree
toCons [PatternTree]
xs)
      ptList :: JMParser PatternTree
ptList  = forall a. JMParser a -> JMParser a
lexeme forall a b. (a -> b) -> a -> b
$ [PatternTree] -> PatternTree
PTList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. JMParser a -> JMParser a
brackets' (forall a. JMParser a -> JMParser [a]
commaSep JMParser PatternTree
patternTree)
      ptObj :: JMParser PatternTree
ptObj   = forall a. JMParser a -> JMParser a
lexeme forall a b. (a -> b) -> a -> b
$ [([Char], PatternTree)] -> PatternTree
PTObj  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. JMParser a -> JMParser a
oxfordBraces (forall a. JMParser a -> JMParser [a]
commaSep forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) JMParser [Char]
myIdent (JMParser [Char]
colon forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JMParser PatternTree
patternTree))
      varOrAs :: JMParser PatternTree
varOrAs = do
        Ident
i <- forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JMParser (Ident, Maybe (Bool, JLocalType))
varidentdecl
        Bool
isAs <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False ([Char] -> JMParser ()
reservedOp [Char]
"@" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
        if Bool
isAs
          then Ident -> PatternTree -> PatternTree
PTAs Ident
i forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JMParser PatternTree
patternTree
          else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Ident -> PatternTree
PTVar Ident
i

--either we have a function from any ident to the constituent parts
--OR the top level is named, and hence we have the top ident, plus decls for the constituent parts
patternBinding :: JMParser (Either (Ident -> [JStat]) (Ident,[JStat]))
patternBinding :: JMParser (Either (Ident -> [JStat]) (Ident, [JStat]))
patternBinding = do
  PatternTree
ptree <- JMParser PatternTree
patternTree
  let go :: JExpr -> PatternTree -> [JStat]
go JExpr
path (PTAs Ident
asIdent PatternTree
pt) = [Ident -> Maybe JLocalType -> JStat
DeclStat Ident
asIdent forall a. Maybe a
Nothing, JExpr -> JExpr -> JStat
AssignStat (JVal -> JExpr
ValExpr (Ident -> JVal
JVar (Ident -> Ident
cleanIdent Ident
asIdent))) JExpr
path] forall a. [a] -> [a] -> [a]
++ JExpr -> PatternTree -> [JStat]
go JExpr
path PatternTree
pt
      go JExpr
path (PTVar Ident
i)
          | Ident
i forall a. Eq a => a -> a -> Bool
== ([Char] -> Ident
StrI [Char]
"_") = []
          | Bool
otherwise = [Ident -> Maybe JLocalType -> JStat
DeclStat Ident
i forall a. Maybe a
Nothing, JExpr -> JExpr -> JStat
AssignStat (JVal -> JExpr
ValExpr (Ident -> JVal
JVar (Ident -> Ident
cleanIdent Ident
i))) (JExpr
path)]
      go JExpr
path (PTList [PatternTree]
pts) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry JExpr -> PatternTree -> [JStat]
go) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map Integer -> JExpr
addIntToPath [Integer
0..]) [PatternTree]
pts
           where addIntToPath :: Integer -> JExpr
addIntToPath Integer
i = JExpr -> JExpr -> JExpr
IdxExpr JExpr
path (JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ Integer -> JVal
JInt Integer
i)
      go JExpr
path (PTObj [([Char], PatternTree)]
xs)   = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry JExpr -> PatternTree -> [JStat]
go) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first [Char] -> JExpr
fixPath) [([Char], PatternTree)]
xs
           where fixPath :: [Char] -> JExpr
fixPath [Char]
lbl = JExpr -> JExpr -> JExpr
IdxExpr JExpr
path (JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ [Char] -> JVal
JStr [Char]
lbl)
      go JExpr
path (PTCons PatternTree
x PatternTree
xs) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [JExpr -> PatternTree -> [JStat]
go (JExpr -> JExpr -> JExpr
IdxExpr JExpr
path (JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ Integer -> JVal
JInt Integer
0)) PatternTree
x,
                                      JExpr -> PatternTree -> [JStat]
go (JExpr -> [JExpr] -> JExpr
ApplExpr (JExpr -> Ident -> JExpr
SelExpr JExpr
path ([Char] -> Ident
StrI [Char]
"slice")) [JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ Integer -> JVal
JInt Integer
1]) PatternTree
xs]
  case PatternTree
ptree of
    PTVar Ident
i -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Ident
i,[])
    PTAs  Ident
i PatternTree
pt -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Ident
i, JExpr -> PatternTree -> [JStat]
go (JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ Ident -> JVal
JVar Ident
i) PatternTree
pt)
    PatternTree
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ \Ident
i -> JExpr -> PatternTree -> [JStat]
go (JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ Ident -> JVal
JVar Ident
i) PatternTree
ptree

patternBlocks :: JMParser ([Ident],[JStat])
patternBlocks :: JMParser ([Ident], [JStat])
patternBlocks = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [(a, b)] -> ([a], [b])
unzip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Ident
i Either (Ident -> [JStat]) (Ident, [JStat])
efr -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\Ident -> [JStat]
f -> (Ident
i, Ident -> [JStat]
f Ident
i)) forall a. a -> a
id Either (Ident -> [JStat]) (Ident, [JStat])
efr) (forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Ident
StrI forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"jmId_match_" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) [(Int
1::Int)..]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many JMParser (Either (Ident -> [JStat]) (Ident, [JStat]))
patternBinding

destructuringDecl :: JMParser [JStat]
destructuringDecl :: ParsecT [Char] () Identity [JStat]
destructuringDecl = do
    (Ident
i,[JStat]
patDecls) <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\Ident -> [JStat]
f -> (Ident
matchVar, Ident -> [JStat]
f Ident
matchVar)) forall a. a -> a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JMParser (Either (Ident -> [JStat]) (Ident, [JStat]))
patternBinding
    Maybe [JStat]
optAssignStat <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe forall a b. (a -> b) -> a -> b
$ do
       [Char] -> JMParser ()
reservedOp [Char]
"="
       JExpr
e <- ParsecT [Char] () Identity JExpr
expr
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$  JExpr -> JExpr -> JStat
AssignStat (JVal -> JExpr
ValExpr (Ident -> JVal
JVar (Ident -> Ident
cleanIdent Ident
i))) JExpr
e forall a. a -> [a] -> [a]
: [JStat]
patDecls
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Ident -> Maybe JLocalType -> JStat
DeclStat Ident
i forall a. Maybe a
Nothing forall a. a -> [a] -> [a]
: forall a. a -> Maybe a -> a
fromMaybe [] Maybe [JStat]
optAssignStat
  where matchVar :: Ident
matchVar = [Char] -> Ident
StrI [Char]
"jmId_match_var"

statblock :: JMParser [JStat]
statblock :: ParsecT [Char] () Identity [JStat]
statblock = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepEndBy1 (JMParser ()
whiteSpace forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] () Identity [JStat]
statement) (JMParser [Char]
semi forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
""))

statblock0 :: JMParser [JStat]
statblock0 :: ParsecT [Char] () Identity [JStat]
statblock0 = forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT [Char] () Identity [JStat]
statblock forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (JMParser ()
whiteSpace forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return [])

l2s :: [JStat] -> JStat
l2s :: [JStat] -> JStat
l2s [JStat]
xs = [JStat] -> JStat
BlockStat [JStat]
xs

statementOrEmpty :: JMParser [JStat]
statementOrEmpty :: ParsecT [Char] () Identity [JStat]
statementOrEmpty = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall {a}. JMParser [a]
emptyStat forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity [JStat]
statement
    where emptyStat :: JMParser [a]
emptyStat = forall a. JMParser a -> JMParser a
braces (JMParser ()
whiteSpace forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return [])

-- return either an expression or a statement
statement :: JMParser [JStat]
statement :: ParsecT [Char] () Identity [JStat]
statement = ParsecT [Char] () Identity [JStat]
declStat
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity [JStat]
funDecl
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity [JStat]
functionDecl
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity [JStat]
foreignStat
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity [JStat]
returnStat
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity [JStat]
labelStat
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity [JStat]
ifStat
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity [JStat]
whileStat
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity [JStat]
switchStat
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity [JStat]
forStat
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity [JStat]
doWhileStat
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. JMParser a -> JMParser a
braces ParsecT [Char] () Identity [JStat]
statblock
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity [JStat]
assignOpStat
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity [JStat]
tryStat
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity [JStat]
applStat
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity [JStat]
breakStat
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity [JStat]
continueStat
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity [JStat]
antiStat
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity [JStat]
antiStatSimple
          forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"statement"
    where
      declStat :: ParsecT [Char] () Identity [JStat]
declStat = do
        [Char] -> JMParser ()
reserved [Char]
"var"
        [JStat]
res <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. JMParser a -> JMParser [a]
commaSep1 ParsecT [Char] () Identity [JStat]
destructuringDecl
        [Char]
_ <- JMParser [Char]
semi
        forall (m :: * -> *) a. Monad m => a -> m a
return [JStat]
res

      functionDecl :: ParsecT [Char] () Identity [JStat]
functionDecl = do
        [Char] -> JMParser ()
reserved [Char]
"function"

        (Ident
i,Maybe (Bool, JLocalType)
mbTyp) <- JMParser (Ident, Maybe (Bool, JLocalType))
varidentdecl
        ([Ident]
as,[JStat]
patDecls) <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Ident]
x -> ([Ident]
x,[])) (forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall a. JMParser a -> JMParser a
parens (forall a. JMParser a -> JMParser [a]
commaSep JMParser Ident
identdecl)) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> JMParser ([Ident], [JStat])
patternBlocks
        JStat
b' <- forall tok st a. GenParser tok st a -> GenParser tok st a
try (JExpr -> JStat
ReturnStat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. JMParser a -> JMParser a
braces ParsecT [Char] () Identity JExpr
expr) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([JStat] -> JStat
l2s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] () Identity [JStat]
statement)
        let b :: JStat
b = [JStat] -> JStat
BlockStat [JStat]
patDecls forall a. Monoid a => a -> a -> a
`mappend` JStat
b'
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Ident -> Maybe JLocalType -> JStat
DeclStat Ident
i (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd Maybe (Bool, JLocalType)
mbTyp),
                  JExpr -> JExpr -> JStat
AssignStat (JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ Ident -> JVal
JVar (Ident -> Ident
cleanIdent Ident
i)) (Maybe (Bool, JLocalType) -> JExpr -> JExpr
addForcedType Maybe (Bool, JLocalType)
mbTyp forall a b. (a -> b) -> a -> b
$ JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ [Ident] -> JStat -> JVal
JFunc [Ident]
as JStat
b)]

      funDecl :: ParsecT [Char] () Identity [JStat]
funDecl = do
        [Char] -> JMParser ()
reserved [Char]
"fun"
        Ident
n <- JMParser Ident
identdecl
        Maybe (Bool, JLocalType)
mbTyp <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe JMParser (Bool, JLocalType)
getType
        ([Ident]
as, [JStat]
patDecls) <- JMParser ([Ident], [JStat])
patternBlocks
        JStat
b' <- forall tok st a. GenParser tok st a -> GenParser tok st a
try (JExpr -> JStat
ReturnStat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. JMParser a -> JMParser a
braces ParsecT [Char] () Identity JExpr
expr) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([JStat] -> JStat
l2s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] () Identity [JStat]
statement) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Char] -> JMParser [Char]
symbol [Char]
"->" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JExpr -> JStat
ReturnStat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] () Identity JExpr
expr)
        let b :: JStat
b = [JStat] -> JStat
BlockStat [JStat]
patDecls forall a. Monoid a => a -> a -> a
`mappend` JStat
b'
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Ident -> Maybe JLocalType -> JStat
DeclStat (Ident -> Ident
addBang Ident
n) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd Maybe (Bool, JLocalType)
mbTyp),
                  JExpr -> JExpr -> JStat
AssignStat (JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ Ident -> JVal
JVar Ident
n) (Maybe (Bool, JLocalType) -> JExpr -> JExpr
addForcedType Maybe (Bool, JLocalType)
mbTyp forall a b. (a -> b) -> a -> b
$ JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ [Ident] -> JStat -> JVal
JFunc [Ident]
as JStat
b)]
            where addBang :: Ident -> Ident
addBang (StrI [Char]
x) = [Char] -> Ident
StrI (Char
'!'forall a. a -> [a] -> [a]
:Char
'!'forall a. a -> [a] -> [a]
:[Char]
x)

      foreignStat :: ParsecT [Char] () Identity [JStat]
foreignStat = do
          [Char] -> JMParser ()
reserved [Char]
"foreign"
          Ident
i <- forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ JMParser Ident
identdecl forall (m :: * -> *) b a. Monad m => m b -> m a -> m b
<<* [Char] -> JMParser ()
reservedOp [Char]
"::"
          JLocalType
t <- forall a. CharParser a JLocalType
runTypeParser
          forall (m :: * -> *) a. Monad m => a -> m a
return [Ident -> JLocalType -> JStat
ForeignStat Ident
i JLocalType
t]

      returnStat :: ParsecT [Char] () Identity [JStat]
returnStat =
        [Char] -> JMParser ()
reserved [Char]
"return" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. JExpr -> JStat
ReturnStat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ Ident -> JVal
JVar forall a b. (a -> b) -> a -> b
$ [Char] -> Ident
StrI [Char]
"undefined") ParsecT [Char] () Identity JExpr
expr

      ifStat :: ParsecT [Char] () Identity [JStat]
ifStat = do
        [Char] -> JMParser ()
reserved [Char]
"if"
        JExpr
p <- forall a. JMParser a -> JMParser a
parens ParsecT [Char] () Identity JExpr
expr
        JStat
b <- [JStat] -> JStat
l2s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] () Identity [JStat]
statementOrEmpty
        Bool
isElse <- (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ([Char] -> JMParser ()
reserved [Char]
"else") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
                  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        if Bool
isElse
          then do
            [Char] -> JMParser ()
reserved [Char]
"else"
            forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. JExpr -> JStat -> JStat -> JStat
IfStat JExpr
p JStat
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JStat] -> JStat
l2s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] () Identity [JStat]
statementOrEmpty
          else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [JExpr -> JStat -> JStat -> JStat
IfStat JExpr
p JStat
b JStat
nullStat]

      whileStat :: ParsecT [Char] () Identity [JStat]
whileStat =
          [Char] -> JMParser ()
reserved [Char]
"while" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\JExpr
e [JStat]
b -> [Bool -> JExpr -> JStat -> JStat
WhileStat Bool
False JExpr
e ([JStat] -> JStat
l2s [JStat]
b)])
                              (forall a. JMParser a -> JMParser a
parens ParsecT [Char] () Identity JExpr
expr) ParsecT [Char] () Identity [JStat]
statementOrEmpty

      doWhileStat :: ParsecT [Char] () Identity [JStat]
doWhileStat = [Char] -> JMParser ()
reserved [Char]
"do" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\[JStat]
b JExpr
e -> [Bool -> JExpr -> JStat -> JStat
WhileStat Bool
True JExpr
e ([JStat] -> JStat
l2s [JStat]
b)])
                    ParsecT [Char] () Identity [JStat]
statementOrEmpty ([Char] -> JMParser ()
reserved [Char]
"while" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. JMParser a -> JMParser a
parens ParsecT [Char] () Identity JExpr
expr)

      switchStat :: ParsecT [Char] () Identity [JStat]
switchStat = do
        [Char] -> JMParser ()
reserved [Char]
"switch"
        JExpr
e <- forall a. JMParser a -> JMParser a
parens forall a b. (a -> b) -> a -> b
$ ParsecT [Char] () Identity JExpr
expr
        ([(JExpr, JStat)]
l,[JStat]
d) <- forall a. JMParser a -> JMParser a
braces (forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [Char] () Identity (JExpr, JStat)
caseStat) (forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option ([]) ParsecT [Char] () Identity [JStat]
dfltStat))
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [JExpr -> [(JExpr, JStat)] -> JStat -> JStat
SwitchStat JExpr
e [(JExpr, JStat)]
l ([JStat] -> JStat
l2s [JStat]
d)]

      caseStat :: ParsecT [Char] () Identity (JExpr, JStat)
caseStat =
        [Char] -> JMParser ()
reserved [Char]
"case" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) ParsecT [Char] () Identity JExpr
expr (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [JStat] -> JStat
l2s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] () Identity [JStat]
statblock)

      tryStat :: ParsecT [Char] () Identity [JStat]
tryStat = do
        [Char] -> JMParser ()
reserved [Char]
"try"
        [JStat]
s <- ParsecT [Char] () Identity [JStat]
statement
        Bool
isCatch <- (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ([Char] -> JMParser ()
reserved [Char]
"catch") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
                  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        (Ident
i,[JStat]
s1) <- if Bool
isCatch
                  then do
                    [Char] -> JMParser ()
reserved [Char]
"catch"
                    forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (forall a. JMParser a -> JMParser a
parens JMParser Ident
identdecl) ParsecT [Char] () Identity [JStat]
statement
                  else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ([Char] -> Ident
StrI [Char]
"", [])
        Bool
isFinally <- (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ([Char] -> JMParser ()
reserved [Char]
"finally") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
                  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        [JStat]
s2 <- if Bool
isFinally
                then [Char] -> JMParser ()
reserved [Char]
"finally" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] () Identity [JStat]
statement
                else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ []
        forall (m :: * -> *) a. Monad m => a -> m a
return [JStat -> Ident -> JStat -> JStat -> JStat
TryStat ([JStat] -> JStat
BlockStat [JStat]
s) Ident
i ([JStat] -> JStat
BlockStat [JStat]
s1) ([JStat] -> JStat
BlockStat [JStat]
s2)]


      dfltStat :: ParsecT [Char] () Identity [JStat]
dfltStat =
        [Char] -> JMParser ()
reserved [Char]
"default" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JMParser ()
whiteSpace forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] () Identity [JStat]
statblock

      forStat :: ParsecT [Char] () Identity [JStat]
forStat =
        [Char] -> JMParser ()
reserved [Char]
"for" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (([Char] -> JMParser ()
reserved [Char]
"each" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT [Char] () Identity [JStat]
inBlock Bool
True)
                           forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall tok st a. GenParser tok st a -> GenParser tok st a
try (Bool -> ParsecT [Char] () Identity [JStat]
inBlock Bool
False)
                           forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity [JStat]
simpleForStat)

      inBlock :: Bool -> ParsecT [Char] () Identity [JStat]
inBlock Bool
isEach = do
        forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JMParser ()
whiteSpace forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ([Char] -> JMParser ()
reserved [Char]
"var")
        Ident
i <- JMParser Ident
identdecl
        [Char] -> JMParser ()
reserved [Char]
"in"
        JExpr
e <- ParsecT [Char] () Identity JExpr
expr
        forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JMParser ()
whiteSpace
        JStat
s <- [JStat] -> JStat
l2s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] () Identity [JStat]
statement
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Bool -> Ident -> JExpr -> JStat -> JStat
ForInStat Bool
isEach Ident
i JExpr
e JStat
s]

      simpleForStat :: ParsecT [Char] () Identity [JStat]
simpleForStat = do
        ([JStat]
before,Maybe JExpr
after,[JStat]
p) <- forall a. JMParser a -> JMParser a
parens ParsecT [Char] () Identity ([JStat], Maybe JExpr, [JStat])
threeStat
        [JStat]
b <- ParsecT [Char] () Identity [JStat]
statement
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [JStat] -> Maybe JExpr -> [JStat] -> [JStat] -> [JStat]
jFor' [JStat]
before Maybe JExpr
after [JStat]
p [JStat]
b
          where threeStat :: ParsecT [Char] () Identity ([JStat], Maybe JExpr, [JStat])
threeStat =
                    forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 (,,) (forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT [Char] () Identity [JStat]
statement forall (m :: * -> *) b a. Monad m => m b -> m a -> m b
<<* forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional JMParser [Char]
semi)
                                (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ParsecT [Char] () Identity JExpr
expr forall (m :: * -> *) b a. Monad m => m b -> m a -> m b
<<* JMParser [Char]
semi)
                                (forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT [Char] () Identity [JStat]
statement)
                jFor' :: [JStat] -> Maybe JExpr -> [JStat]-> [JStat] -> [JStat]
                jFor' :: [JStat] -> Maybe JExpr -> [JStat] -> [JStat] -> [JStat]
jFor' [JStat]
before Maybe JExpr
p [JStat]
after [JStat]
bs = [JStat]
before forall a. [a] -> [a] -> [a]
++ [Bool -> JExpr -> JStat -> JStat
WhileStat Bool
False (forall a. a -> Maybe a -> a
fromMaybe ([Char] -> JExpr
jsv [Char]
"true") Maybe JExpr
p) JStat
b']
                    where b' :: JStat
b' = [JStat] -> JStat
BlockStat forall a b. (a -> b) -> a -> b
$ [JStat]
bs forall a. [a] -> [a] -> [a]
++ [JStat]
after

      assignOpStat :: ParsecT [Char] () Identity [JStat]
assignOpStat = do
          let rop :: [Char] -> JMParser [Char]
rop [Char]
x = [Char] -> JMParser ()
reservedOp [Char]
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
x
          (JExpr
e1,[Char]
op) <- forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) ParsecT [Char] () Identity JExpr
dotExpr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Int -> [a] -> [a]
take Int
1) forall a b. (a -> b) -> a -> b
$
                                                   [Char] -> JMParser [Char]
rop [Char]
"="
                                               forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> JMParser [Char]
rop [Char]
"+="
                                               forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> JMParser [Char]
rop [Char]
"-="
                                               forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> JMParser [Char]
rop [Char]
"*="
                                               forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> JMParser [Char]
rop [Char]
"/="
                                               forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> JMParser [Char]
rop [Char]
"%="
                                               forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> JMParser [Char]
rop [Char]
"<<="
                                               forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> JMParser [Char]
rop [Char]
">>="
                                               forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> JMParser [Char]
rop [Char]
">>>="
                                               forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> JMParser [Char]
rop [Char]
"&="
                                               forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> JMParser [Char]
rop [Char]
"^="
                                               forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> JMParser [Char]
rop [Char]
"|="
                                              )
          let gofail :: ParsecT [Char] () Identity a
gofail  = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Invalid assignment.")
              badList :: [[Char]]
badList = [[Char]
"this",[Char]
"true",[Char]
"false",[Char]
"undefined",[Char]
"null"]
          case JExpr
e1 of
            ValExpr (JVar (StrI [Char]
s)) -> if [Char]
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
badList then forall {a}. ParsecT [Char] () Identity a
gofail else forall (m :: * -> *) a. Monad m => a -> m a
return ()
            ApplExpr JExpr
_ [JExpr]
_ -> forall {a}. ParsecT [Char] () Identity a
gofail
            ValExpr JVal
_ -> forall {a}. ParsecT [Char] () Identity a
gofail
            JExpr
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
          JExpr
e2 <- ParsecT [Char] () Identity JExpr
expr
          forall (m :: * -> *) a. Monad m => a -> m a
return [JExpr -> JExpr -> JStat
AssignStat JExpr
e1 (if [Char]
op forall a. Eq a => a -> a -> Bool
== [Char]
"=" then JExpr
e2 else [Char] -> JExpr -> JExpr -> JExpr
InfixExpr [Char]
op JExpr
e1 JExpr
e2)]


      applStat :: ParsecT [Char] () Identity [JStat]
applStat = forall {tok} {st}. JExpr -> GenParser tok st [JStat]
expr2stat' forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ParsecT [Char] () Identity JExpr
expr

--fixme: don't handle ifstats
      expr2stat' :: JExpr -> GenParser tok st [JStat]
expr2stat' JExpr
e = case JExpr -> JStat
expr2stat JExpr
e of
                       BlockStat [] -> forall tok st a. GenParser tok st a
pzero
                       JStat
x -> forall (m :: * -> *) a. Monad m => a -> m a
return [JStat
x]
{-
      expr2stat' :: JExpr -> JStat
      expr2stat' (ApplExpr x y) = return $ (ApplStat x y)
      expr2stat' (IfExpr x y z) = liftM2 (IfStat x) (expr2stat' y) (expr2stat' z)
      expr2stat' (PostExpr s x) = return $ PostStat s x
      expr2stat' (AntiExpr x)   = return $ AntiStat x
      expr2stat' _ = fail "Value expression used as statement"
-}

      breakStat :: ParsecT [Char] () Identity [JStat]
breakStat = do
        [Char] -> JMParser ()
reserved [Char]
"break"
        Maybe [Char]
l <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe JMParser [Char]
myIdent
        forall (m :: * -> *) a. Monad m => a -> m a
return [Maybe [Char] -> JStat
BreakStat Maybe [Char]
l]

      continueStat :: ParsecT [Char] () Identity [JStat]
continueStat = do
        [Char] -> JMParser ()
reserved [Char]
"continue"
        Maybe [Char]
l <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe JMParser [Char]
myIdent
        forall (m :: * -> *) a. Monad m => a -> m a
return [Maybe [Char] -> JStat
ContinueStat Maybe [Char]
l]

      labelStat :: ParsecT [Char] () Identity [JStat]
labelStat = do
        [Char]
lbl <- forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do
                    [Char]
l <- JMParser [Char]
myIdent forall (m :: * -> *) b a. Monad m => m b -> m a -> m b
<<* forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
                    forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([Char]
l forall a. Eq a => a -> a -> Bool
/= [Char]
"default")
                    forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
l
        JStat
s <- [JStat] -> JStat
l2s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] () Identity [JStat]
statblock0
        forall (m :: * -> *) a. Monad m => a -> m a
return [[Char] -> JStat -> JStat
LabelStat [Char]
lbl JStat
s]

      antiStat :: ParsecT [Char] () Identity [JStat]
antiStat  = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> JStat
AntiStat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        [Char]
x <- (forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> JMParser [Char]
symbol [Char]
"`(") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`manyTill` forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> JMParser [Char]
symbol [Char]
")`"))
        forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"Bad AntiQuotation: \n" forall a. [a] -> [a] -> [a]
++))
               (forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
x))
               ([Char] -> Either [Char] Exp
parseHSExp [Char]
x)

      antiStatSimple :: ParsecT [Char] () Identity [JStat]
antiStatSimple  = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> JStat
AntiStat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        [Char]
x <- ([Char] -> JMParser [Char]
symbol [Char]
"`" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`manyTill` [Char] -> JMParser [Char]
symbol [Char]
"`")
        forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"Bad AntiQuotation: \n" forall a. [a] -> [a] -> [a]
++))
               (forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
x))
               ([Char] -> Either [Char] Exp
parseHSExp [Char]
x)

--args :: JMParser [JExpr]
--args = parens $ commaSep expr

compileRegex :: String -> Either WrapError Regex
compileRegex :: [Char] -> Either WrapError Regex
compileRegex [Char]
s = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ CompOption -> ExecOption -> [Char] -> IO (Either WrapError Regex)
compile CompOption
co ExecOption
eo [Char]
s
    where co :: CompOption
co = CompOption
compExtended
          eo :: ExecOption
eo = ExecOption
execBlank

expr :: JMParser JExpr
expr :: ParsecT [Char] () Identity JExpr
expr = do
  JExpr
e <- ParsecT [Char] () Identity JExpr
exprWithIf
  JExpr -> ParsecT [Char] () Identity JExpr
addType JExpr
e
  where
    addType :: JExpr -> ParsecT [Char] () Identity JExpr
addType JExpr
e = do
         Maybe (Bool, JLocalType)
optTyp <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe JMParser (Bool, JLocalType)
getType
         case Maybe (Bool, JLocalType)
optTyp of
           (Just (Bool
b,JLocalType
t)) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> JExpr -> JLocalType -> JExpr
TypeExpr Bool
b JExpr
e JLocalType
t
           Maybe (Bool, JLocalType)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return JExpr
e
    exprWithIf :: ParsecT [Char] () Identity JExpr
exprWithIf = do
         JExpr
e <- ParsecT [Char] () Identity JExpr
rawExpr
         JExpr -> ParsecT [Char] () Identity JExpr
addIf JExpr
e forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return JExpr
e
    addIf :: JExpr -> ParsecT [Char] () Identity JExpr
addIf JExpr
e = do
          [Char] -> JMParser ()
reservedOp [Char]
"?"
          JExpr
t <- ParsecT [Char] () Identity JExpr
exprWithIf
          [Char]
_ <- JMParser [Char]
colon
          JExpr
el <- ParsecT [Char] () Identity JExpr
exprWithIf
          let ans :: JExpr
ans = (JExpr -> JExpr -> JExpr -> JExpr
IfExpr JExpr
e JExpr
t JExpr
el)
          JExpr -> ParsecT [Char] () Identity JExpr
addIf JExpr
ans forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return JExpr
ans
    rawExpr :: ParsecT [Char] () Identity JExpr
rawExpr = forall tok st a.
OperatorTable tok st a -> GenParser tok st a -> GenParser tok st a
buildExpressionParser [[Operator Char () JExpr]]
table ParsecT [Char] () Identity JExpr
dotExpr forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"expression"
    table :: [[Operator Char () JExpr]]
table = [[[Char] -> Operator Char () JExpr
pop [Char]
"~", [Char] -> Operator Char () JExpr
pop [Char]
"!", Operator Char () JExpr
negop],
             [[Char] -> Operator Char () JExpr
iop [Char]
"*", [Char] -> Operator Char () JExpr
iop [Char]
"/", [Char] -> Operator Char () JExpr
iop [Char]
"%"],
             [[Char] -> Operator Char () JExpr
pop [Char]
"++", [Char] -> Operator Char () JExpr
pop [Char]
"--"],
             [[Char] -> Operator Char () JExpr
iop [Char]
"++", [Char] -> Operator Char () JExpr
iop [Char]
"+", [Char] -> Operator Char () JExpr
iop [Char]
"-", [Char] -> Operator Char () JExpr
iop [Char]
"--"],
             [[Char] -> Operator Char () JExpr
iop [Char]
"<<", [Char] -> Operator Char () JExpr
iop [Char]
">>", [Char] -> Operator Char () JExpr
iop [Char]
">>>"],
             [Operator Char () JExpr
consOp],
             [[Char] -> Operator Char () JExpr
iope [Char]
"==", [Char] -> Operator Char () JExpr
iope [Char]
"!=", [Char] -> Operator Char () JExpr
iope [Char]
"<", [Char] -> Operator Char () JExpr
iope [Char]
">",
              [Char] -> Operator Char () JExpr
iope [Char]
">=", [Char] -> Operator Char () JExpr
iope [Char]
"<=", [Char] -> Operator Char () JExpr
iope [Char]
"===", [Char] -> Operator Char () JExpr
iope [Char]
"!=="],
             [[Char] -> Operator Char () JExpr
iop [Char]
"&"],
             [[Char] -> Operator Char () JExpr
iop [Char]
"^"],
             [[Char] -> Operator Char () JExpr
iop [Char]
"|"],
             [[Char] -> Operator Char () JExpr
iop [Char]
"&&"],
             [[Char] -> Operator Char () JExpr
iop [Char]
"||"],
             [Operator Char () JExpr
applOp, Operator Char () JExpr
applOpRev]
            ]
    pop :: [Char] -> Operator Char () JExpr
pop  [Char]
s  = forall tok st a. GenParser tok st (a -> a) -> Operator tok st a
Prefix ([Char] -> JMParser ()
reservedOp [Char]
s forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> [Char] -> JExpr -> JExpr
PPostExpr Bool
True [Char]
s))
    iop :: [Char] -> Operator Char () JExpr
iop  [Char]
s  = forall tok st a.
GenParser tok st (a -> a -> a) -> Assoc -> Operator tok st a
Infix ([Char] -> JMParser ()
reservedOp [Char]
s forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> JExpr -> JExpr -> JExpr
InfixExpr [Char]
s)) Assoc
AssocLeft
    iope :: [Char] -> Operator Char () JExpr
iope [Char]
s  = forall tok st a.
GenParser tok st (a -> a -> a) -> Assoc -> Operator tok st a
Infix ([Char] -> JMParser ()
reservedOp [Char]
s forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> JExpr -> JExpr -> JExpr
InfixExpr [Char]
s)) Assoc
AssocNone
    applOp :: Operator Char () JExpr
applOp  = forall tok st a.
GenParser tok st (a -> a -> a) -> Assoc -> Operator tok st a
Infix ([Char] -> JMParser ()
reservedOp [Char]
"<|" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (\JExpr
x JExpr
y -> JExpr -> [JExpr] -> JExpr
ApplExpr JExpr
x [JExpr
y])) Assoc
AssocRight
    applOpRev :: Operator Char () JExpr
applOpRev = forall tok st a.
GenParser tok st (a -> a -> a) -> Assoc -> Operator tok st a
Infix ([Char] -> JMParser ()
reservedOp [Char]
"|>" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (\JExpr
x JExpr
y -> JExpr -> [JExpr] -> JExpr
ApplExpr JExpr
y [JExpr
x])) Assoc
AssocLeft
    consOp :: Operator Char () JExpr
consOp  = forall tok st a.
GenParser tok st (a -> a -> a) -> Assoc -> Operator tok st a
Infix ([Char] -> JMParser ()
reservedOp [Char]
":|" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return JExpr -> JExpr -> JExpr
consAct) Assoc
AssocRight
    consAct :: JExpr -> JExpr -> JExpr
consAct JExpr
x JExpr
y = JExpr -> [JExpr] -> JExpr
ApplExpr (JVal -> JExpr
ValExpr ([Ident] -> JStat -> JVal
JFunc [[Char] -> Ident
StrI [Char]
"x",[Char] -> Ident
StrI [Char]
"y"] ([JStat] -> JStat
BlockStat [[JStat] -> JStat
BlockStat [Ident -> Maybe JLocalType -> JStat
DeclStat ([Char] -> Ident
StrI [Char]
"tmp") forall a. Maybe a
Nothing, JExpr -> JExpr -> JStat
AssignStat JExpr
tmpVar (JExpr -> [JExpr] -> JExpr
ApplExpr (JExpr -> Ident -> JExpr
SelExpr (JVal -> JExpr
ValExpr (Ident -> JVal
JVar ([Char] -> Ident
StrI [Char]
"x"))) ([Char] -> Ident
StrI [Char]
"slice")) [JVal -> JExpr
ValExpr (Integer -> JVal
JInt Integer
0)]),JExpr -> [JExpr] -> JStat
ApplStat (JExpr -> Ident -> JExpr
SelExpr JExpr
tmpVar ([Char] -> Ident
StrI [Char]
"unshift")) [JVal -> JExpr
ValExpr (Ident -> JVal
JVar ([Char] -> Ident
StrI [Char]
"y"))],JExpr -> JStat
ReturnStat JExpr
tmpVar]]))) [JExpr
x,JExpr
y]
        where tmpVar :: JExpr
tmpVar = JVal -> JExpr
ValExpr (Ident -> JVal
JVar ([Char] -> Ident
StrI [Char]
"tmp"))
    negop :: Operator Char () JExpr
negop   = forall tok st a. GenParser tok st (a -> a) -> Operator tok st a
Prefix ([Char] -> JMParser ()
reservedOp [Char]
"-" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return JExpr -> JExpr
negexp)
    negexp :: JExpr -> JExpr
negexp (ValExpr (JDouble SaneDouble
n)) = JVal -> JExpr
ValExpr (SaneDouble -> JVal
JDouble (-SaneDouble
n))
    negexp (ValExpr (JInt    Integer
n)) = JVal -> JExpr
ValExpr (Integer -> JVal
JInt    (-Integer
n))
    negexp JExpr
x                     = Bool -> [Char] -> JExpr -> JExpr
PPostExpr Bool
True [Char]
"-" JExpr
x

dotExpr :: JMParser JExpr
dotExpr :: ParsecT [Char] () Identity JExpr
dotExpr = do
  [JExpr]
e <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall a. JMParser a -> JMParser a
lexeme ParsecT [Char] () Identity JExpr
dotExprOne) forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"simple expression"
  case [JExpr]
e of
    [JExpr
e'] -> forall (m :: * -> *) a. Monad m => a -> m a
return JExpr
e'
    (JExpr
e':[JExpr]
es) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ JExpr -> [JExpr] -> JExpr
ApplExpr JExpr
e' [JExpr]
es
    [JExpr]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"exprApp"

dotExprOne :: JMParser JExpr
dotExprOne :: ParsecT [Char] () Identity JExpr
dotExprOne = JExpr -> ParsecT [Char] () Identity JExpr
addNxt forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ParsecT [Char] () Identity JExpr
valExpr forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity JExpr
antiExpr forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity JExpr
antiExprSimple forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. JMParser a -> JMParser a
parens' ParsecT [Char] () Identity JExpr
expr forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity JExpr
notExpr forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity JExpr
newExpr
  where
    addNxt :: JExpr -> ParsecT [Char] () Identity JExpr
addNxt JExpr
e = do
            Maybe Char
nxt <- (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
            case Maybe Char
nxt of
              Just Char
'.' -> JExpr -> ParsecT [Char] () Identity JExpr
addNxt forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (JMParser [Char]
dot forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (JExpr -> Ident -> JExpr
SelExpr JExpr
e forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JMParser Ident
ident' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {u}. ParsecT [Char] u Identity Ident
numIdent)))
              Just Char
'[' -> JExpr -> ParsecT [Char] () Identity JExpr
addNxt forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (JExpr -> JExpr -> JExpr
IdxExpr JExpr
e forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. JMParser a -> JMParser a
brackets' ParsecT [Char] () Identity JExpr
expr)
              Just Char
'(' -> JExpr -> ParsecT [Char] () Identity JExpr
addNxt forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (JExpr -> [JExpr] -> JExpr
ApplExpr JExpr
e forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. JMParser a -> JMParser a
parens' (forall a. JMParser a -> JMParser [a]
commaSep ParsecT [Char] () Identity JExpr
expr))
              Just Char
'-' -> forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> JMParser ()
reservedOp [Char]
"--" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> [Char] -> JExpr -> JExpr
PPostExpr Bool
False [Char]
"--" JExpr
e)) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return JExpr
e
              Just Char
'+' -> forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> JMParser ()
reservedOp [Char]
"++" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> [Char] -> JExpr -> JExpr
PPostExpr Bool
False [Char]
"++" JExpr
e)) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return JExpr
e
              Maybe Char
_   -> forall (m :: * -> *) a. Monad m => a -> m a
return JExpr
e

    numIdent :: ParsecT [Char] u Identity Ident
numIdent = [Char] -> Ident
StrI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit

    notExpr :: ParsecT [Char] () Identity JExpr
notExpr = forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> JMParser [Char]
symbol [Char]
"!" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] () Identity JExpr
dotExpr) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \JExpr
e ->
              forall (m :: * -> *) a. Monad m => a -> m a
return (JExpr -> [JExpr] -> JExpr
ApplExpr (JVal -> JExpr
ValExpr (Ident -> JVal
JVar ([Char] -> Ident
StrI [Char]
"!"))) [JExpr
e])

    newExpr :: ParsecT [Char] () Identity JExpr
newExpr = JExpr -> JExpr
NewExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> JMParser ()
reserved [Char]
"new" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] () Identity JExpr
dotExpr)

    antiExpr :: ParsecT [Char] () Identity JExpr
antiExpr  = [Char] -> JExpr
AntiExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
         [Char]
x <- (forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> JMParser [Char]
symbol [Char]
"`(") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`manyTill` forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
")`"))
         forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"Bad AntiQuotation: \n" forall a. [a] -> [a] -> [a]
++))
                (forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
x))
                ([Char] -> Either [Char] Exp
parseHSExp [Char]
x)

    antiExprSimple :: ParsecT [Char] () Identity JExpr
antiExprSimple  = [Char] -> JExpr
AntiExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
         [Char]
x <- ([Char] -> JMParser [Char]
symbol [Char]
"`" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`manyTill` forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"`")
         forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"Bad AntiQuotation: \n" forall a. [a] -> [a] -> [a]
++))
                (forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
x))
                ([Char] -> Either [Char] Exp
parseHSExp [Char]
x)

    valExpr :: ParsecT [Char] () Identity JExpr
valExpr = JVal -> JExpr
ValExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT [Char] () Identity JVal
num forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity JVal
str forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT [Char] () Identity JVal
regex forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity JVal
list forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity JVal
hash forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity JVal
func forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity JVal
var) forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"value"
        where num :: ParsecT [Char] () Identity JVal
num = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Integer -> JVal
JInt SaneDouble -> JVal
JDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a. Fractional a => JMParser (Either Integer a)
natFloat
              str :: ParsecT [Char] () Identity JVal
str   = [Char] -> JVal
JStr   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> JMParser [Char]
myStringLiteral Char
'"' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> JMParser [Char]
myStringLiteral Char
'\'')
              regex :: ParsecT [Char] () Identity JVal
regex = do
                [Char]
s <- JMParser [Char]
regexLiteral --myStringLiteralNoBr '/'
                case [Char] -> Either WrapError Regex
compileRegex [Char]
s of
                  Right Regex
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> JVal
JRegEx [Char]
s)
                  Left WrapError
err -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Parse error in regexp: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show WrapError
err)
              list :: ParsecT [Char] () Identity JVal
list  = [JExpr] -> JVal
JList  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. JMParser a -> JMParser a
brackets' (forall a. JMParser a -> JMParser [a]
commaSep ParsecT [Char] () Identity JExpr
expr)
              hash :: ParsecT [Char] () Identity JVal
hash  = Map [Char] JExpr -> JVal
JHash  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. JMParser a -> JMParser a
braces' (forall a. JMParser a -> JMParser [a]
commaSep ParsecT [Char] () Identity ([Char], JExpr)
propPair)
              var :: ParsecT [Char] () Identity JVal
var = Ident -> JVal
JVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JMParser Ident
ident'
              func :: ParsecT [Char] () Identity JVal
func = do
                ([Char] -> JMParser [Char]
symbol [Char]
"\\" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> JMParser ()
reserved [Char]
"function"
                ([Ident]
as,[JStat]
patDecls) <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Ident]
x -> ([Ident]
x,[])) (forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall a. JMParser a -> JMParser a
parens (forall a. JMParser a -> JMParser [a]
commaSep JMParser Ident
identdecl)) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> JMParser ([Ident], [JStat])
patternBlocks
                JStat
b' <- (forall a. JMParser a -> JMParser a
braces' ParsecT [Char] () Identity JStat
statOrEblock forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Char] -> JMParser [Char]
symbol [Char]
"->" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (JExpr -> JStat
ReturnStat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] () Identity JExpr
expr)))
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Ident] -> JStat -> JVal
JFunc [Ident]
as ([JStat] -> JStat
BlockStat [JStat]
patDecls forall a. Monoid a => a -> a -> a
`mappend` JStat
b')
              statOrEblock :: ParsecT [Char] () Identity JStat
statOrEblock  = forall tok st a. GenParser tok st a -> GenParser tok st a
try (JExpr -> JStat
ReturnStat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] () Identity JExpr
expr forall a. JMParser a -> Char -> JMParser a
`folBy` Char
'}') forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([JStat] -> JStat
l2s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] () Identity [JStat]
statblock)
              propPair :: ParsecT [Char] () Identity ([Char], JExpr)
propPair = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) JMParser [Char]
myIdent (JMParser [Char]
colon forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] () Identity JExpr
expr)

--notFolBy a b = a <<* notFollowedBy (char b)
folBy :: JMParser a -> Char -> JMParser a
folBy :: forall a. JMParser a -> Char -> JMParser a
folBy JMParser a
a Char
b = JMParser a
a forall (m :: * -> *) b a. Monad m => m b -> m a -> m b
<<* (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
b) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return ()))

--Parsers without Lexeme
braces', brackets', parens', oxfordBraces :: JMParser a -> JMParser a
brackets' :: forall a. JMParser a -> JMParser a
brackets' = forall a. Char -> Char -> JMParser a -> JMParser a
around' Char
'[' Char
']'
braces' :: forall a. JMParser a -> JMParser a
braces' = forall a. Char -> Char -> JMParser a -> JMParser a
around' Char
'{' Char
'}'
parens' :: forall a. JMParser a -> JMParser a
parens' = forall a. Char -> Char -> JMParser a -> JMParser a
around' Char
'(' Char
')'
oxfordBraces :: forall a. JMParser a -> JMParser a
oxfordBraces JMParser a
x = forall a. JMParser a -> JMParser a
lexeme ([Char] -> JMParser ()
reservedOp [Char]
"{|") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (forall a. JMParser a -> JMParser a
lexeme JMParser a
x forall (m :: * -> *) b a. Monad m => m b -> m a -> m b
<<* [Char] -> JMParser ()
reservedOp [Char]
"|}")

around' :: Char -> Char -> JMParser a -> JMParser a
around' :: forall a. Char -> Char -> JMParser a -> JMParser a
around' Char
a Char
b JMParser a
x = forall a. JMParser a -> JMParser a
lexeme (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
a) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (forall a. JMParser a -> JMParser a
lexeme JMParser a
x forall (m :: * -> *) b a. Monad m => m b -> m a -> m b
<<* forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
b)

myIdent :: JMParser String
myIdent :: JMParser [Char]
myIdent = forall a. JMParser a -> JMParser a
lexeme forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"_-!@#$%^&*()") forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> JMParser [Char]
myStringLiteral Char
'\''

ident' :: JMParser Ident
ident' :: JMParser Ident
ident' = do
    [Char]
i <- JMParser [Char]
identifier'
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
"jmId_" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
i) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Illegal use of reserved jmId_ prefix in variable name."
    forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Ident
StrI [Char]
i)
  where
    identifier' :: JMParser [Char]
identifier' =
        forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$
        do{ [Char]
name <- JMParser [Char]
ident''
          ; if [Char] -> Bool
isReservedName [Char]
name
             then forall s (m :: * -> *) t u a.
Stream s m t =>
[Char] -> ParsecT s u m a
unexpected ([Char]
"reserved word " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
name)
             else forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
name
          }
    ident'' :: JMParser [Char]
ident''
        = do{ Char
c <- forall s u (m :: * -> *).
GenLanguageDef s u m -> ParsecT s u m Char
P.identStart LanguageDef ()
jsLang
            ; [Char]
cs <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s u (m :: * -> *).
GenLanguageDef s u m -> ParsecT s u m Char
P.identLetter LanguageDef ()
jsLang)
            ; forall (m :: * -> *) a. Monad m => a -> m a
return (Char
cforall a. a -> [a] -> [a]
:[Char]
cs)
            }
        forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"identifier"
    isReservedName :: [Char] -> Bool
isReservedName [Char]
name
        = forall {a}. Ord a => [a] -> a -> Bool
isReserved [[Char]]
theReservedNames [Char]
caseName
        where
          caseName :: [Char]
caseName      | forall s u (m :: * -> *). GenLanguageDef s u m -> Bool
P.caseSensitive LanguageDef ()
jsLang  = [Char]
name
                        | Bool
otherwise               = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
name
    isReserved :: [a] -> a -> Bool
isReserved [a]
names a
name
        = [a] -> Bool
scan [a]
names
        where
          scan :: [a] -> Bool
scan []       = Bool
False
          scan (a
r:[a]
rs)   = case (forall a. Ord a => a -> a -> Ordering
compare a
r a
name) of
                            Ordering
LT  -> [a] -> Bool
scan [a]
rs
                            Ordering
EQ  -> Bool
True
                            Ordering
GT  -> Bool
False
    theReservedNames :: [[Char]]
theReservedNames
        | forall s u (m :: * -> *). GenLanguageDef s u m -> Bool
P.caseSensitive LanguageDef ()
jsLang  = [[Char]]
sortedNames
        | Bool
otherwise               = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower) [[Char]]
sortedNames
        where
          sortedNames :: [[Char]]
sortedNames   = forall a. Ord a => [a] -> [a]
sort (forall s u (m :: * -> *). GenLanguageDef s u m -> [[Char]]
P.reservedNames LanguageDef ()
jsLang)


natFloat :: Fractional a => JMParser (Either Integer a)
natFloat :: forall a. Fractional a => JMParser (Either Integer a)
natFloat = (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'0' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] () Identity (Either Integer a)
zeroNumFloat)
           forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity (Either Integer a)
decimalFloat forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"number"
 where
    zeroNumFloat :: ParsecT [Char] () Identity (Either Integer a)
zeroNumFloat    =  (forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall {u}. ParsecT [Char] u Identity Integer
hexadecimal forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {u}. ParsecT [Char] u Identity Integer
octal))
                       forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity (Either Integer a)
decimalFloat
                       forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Integer -> ParsecT [Char] () Identity (Either Integer a)
fractFloat Integer
0
                       forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left Integer
0)

    decimalFloat :: ParsecT [Char] () Identity (Either Integer a)
decimalFloat    = do Integer
n <- forall {u}. ParsecT [Char] u Identity Integer
decimal
                         forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (forall a b. a -> Either a b
Left Integer
n)(Integer -> ParsecT [Char] () Identity (Either Integer a)
fractFloat Integer
n)
    fractFloat :: Integer -> ParsecT [Char] () Identity (Either Integer a)
fractFloat Integer
n    = forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> ParsecT [Char] () Identity a
fractExponent Integer
n
    fractExponent :: Integer -> ParsecT [Char] () Identity a
fractExponent Integer
n = (do a
fract <- forall {u}. ParsecT [Char] u Identity a
fraction
                          a
expo  <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option a
1.0 ParsecT [Char] () Identity a
exponent'
                          forall (m :: * -> *) a. Monad m => a -> m a
return ((forall a. Num a => Integer -> a
fromInteger Integer
n forall a. Num a => a -> a -> a
+ a
fract)forall a. Num a => a -> a -> a
*a
expo)
                      )
                      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((forall a. Num a => Integer -> a
fromInteger Integer
n forall a. Num a => a -> a -> a
*) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] () Identity a
exponent')
    fraction :: ParsecT [Char] u Identity a
fraction        = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a}. Fractional a => Char -> a -> a
op a
0.0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"fraction")
                    where
                      op :: Char -> a -> a
op Char
d a
f    = (a
f forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
digitToInt Char
d))forall a. Fractional a => a -> a -> a
/a
10.0
    exponent' :: ParsecT [Char] () Identity a
exponent'       = do Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"eE"
                         Integer -> Integer
f <- forall {u}. ParsecT [Char] u Identity (Integer -> Integer)
sign
                         forall {b} {a}. (Fractional a, Integral b) => b -> a
power forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {u}. ParsecT [Char] u Identity Integer
decimal
                    where
                       power :: b -> a
power b
e  | b
e forall a. Ord a => a -> a -> Bool
< b
0      = a
1.0forall a. Fractional a => a -> a -> a
/b -> a
power(-b
e)
                                | Bool
otherwise  = forall a. Num a => Integer -> a
fromInteger (Integer
10forall a b. (Num a, Integral b) => a -> b -> a
^b
e)

    sign :: ParsecT [Char] u Identity (Integer -> Integer)
sign            =   (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Num a => a -> a
negate)
                    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. a -> a
id)
                    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. a -> a
id

    decimal :: ParsecT [Char] u Identity Integer
decimal         = forall {s} {m :: * -> *} {t} {u}.
Stream s m t =>
Integer -> ParsecT s u m Char -> ParsecT s u m Integer
number Integer
10 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
    hexadecimal :: ParsecT [Char] u Identity Integer
hexadecimal     = forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"xX" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {s} {m :: * -> *} {t} {u}.
Stream s m t =>
Integer -> ParsecT s u m Char -> ParsecT s u m Integer
number Integer
16 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
    octal :: ParsecT [Char] u Identity Integer
octal           = forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"oO" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {s} {m :: * -> *} {t} {u}.
Stream s m t =>
Integer -> ParsecT s u m Char -> ParsecT s u m Integer
number Integer
8 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
octDigit

    number :: Integer -> ParsecT s u m Char -> ParsecT s u m Integer
number Integer
base ParsecT s u m Char
baseDig = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Integer
x Char
d -> Integer
baseforall a. Num a => a -> a -> a
*Integer
x forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> Integer
toInteger (Char -> Int
digitToInt Char
d)) Integer
0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s u m Char
baseDig

myStringLiteral :: Char -> JMParser String
myStringLiteral :: Char -> JMParser [Char]
myStringLiteral Char
t = do
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
t
    [Char]
x <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many JMParser [Char]
myChar
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
t
    [Char] -> JMParser [Char]
decodeJson [Char]
x
 where myChar :: JMParser [Char]
myChar = do
         Char
c <- forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char
t]
         case Char
c of
           Char
'\\' -> do
                  Char
c2 <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
                  forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c,Char
c2]
           Char
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c]

-- Taken from json package by Sigbjorn Finne.
decodeJson :: String -> JMParser String
decodeJson :: [Char] -> JMParser [Char]
decodeJson [Char]
x = [Char] -> [Char] -> JMParser [Char]
parseIt [] [Char]
x
 where
  parseIt :: [Char] -> [Char] -> JMParser [Char]
parseIt [Char]
rs [Char]
cs =
    case [Char]
cs of
      Char
'\\' : Char
c : [Char]
ds -> [Char] -> Char -> [Char] -> JMParser [Char]
esc [Char]
rs Char
c [Char]
ds
      Char
c    : [Char]
ds
       | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\x20' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\xff'    -> [Char] -> [Char] -> JMParser [Char]
parseIt (Char
cforall a. a -> [a] -> [a]
:[Char]
rs) [Char]
ds
       | Char
c forall a. Ord a => a -> a -> Bool
< Char
'\x20'     -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Illegal unescaped character in string: " forall a. [a] -> [a] -> [a]
++ [Char]
x
       | Integer
i forall a. Ord a => a -> a -> Bool
<= Integer
0x10ffff  -> [Char] -> [Char] -> JMParser [Char]
parseIt (Char
cforall a. a -> [a] -> [a]
:[Char]
rs) [Char]
ds
       | Bool
otherwise -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Illegal unescaped character in string: " forall a. [a] -> [a] -> [a]
++ [Char]
x
       where
        i :: Integer
i = (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum Char
c) :: Integer)
      [] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Char]
rs

  esc :: [Char] -> Char -> [Char] -> JMParser [Char]
esc [Char]
rs Char
c [Char]
cs = case Char
c of
   Char
'\\' -> [Char] -> [Char] -> JMParser [Char]
parseIt (Char
'\\' forall a. a -> [a] -> [a]
: [Char]
rs) [Char]
cs
   Char
'"'  -> [Char] -> [Char] -> JMParser [Char]
parseIt (Char
'"'  forall a. a -> [a] -> [a]
: [Char]
rs) [Char]
cs
   Char
'n'  -> [Char] -> [Char] -> JMParser [Char]
parseIt (Char
'\n' forall a. a -> [a] -> [a]
: [Char]
rs) [Char]
cs
   Char
'r'  -> [Char] -> [Char] -> JMParser [Char]
parseIt (Char
'\r' forall a. a -> [a] -> [a]
: [Char]
rs) [Char]
cs
   Char
't'  -> [Char] -> [Char] -> JMParser [Char]
parseIt (Char
'\t' forall a. a -> [a] -> [a]
: [Char]
rs) [Char]
cs
   Char
'f'  -> [Char] -> [Char] -> JMParser [Char]
parseIt (Char
'\f' forall a. a -> [a] -> [a]
: [Char]
rs) [Char]
cs
   Char
'b'  -> [Char] -> [Char] -> JMParser [Char]
parseIt (Char
'\b' forall a. a -> [a] -> [a]
: [Char]
rs) [Char]
cs
   Char
'/'  -> [Char] -> [Char] -> JMParser [Char]
parseIt (Char
'/'  forall a. a -> [a] -> [a]
: [Char]
rs) [Char]
cs
   Char
'u'  -> case [Char]
cs of
             Char
d1 : Char
d2 : Char
d3 : Char
d4 : [Char]
cs' ->
               case forall a. (Eq a, Num a) => ReadS a
readHex [Char
d1,Char
d2,Char
d3,Char
d4] of
                 [(Int
n,[Char]
"")] -> [Char] -> [Char] -> JMParser [Char]
parseIt (forall a. Enum a => Int -> a
toEnum Int
n forall a. a -> [a] -> [a]
: [Char]
rs) [Char]
cs'

                 [(Int, [Char])]
badHex -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Unable to parse JSON String: invalid hex: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [(Int, [Char])]
badHex
             [Char]
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Unable to parse JSON String: invalid hex: " forall a. [a] -> [a] -> [a]
++ [Char]
cs
   Char
_ ->  forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Unable to parse JSON String: invalid escape char: " forall a. [a] -> [a] -> [a]
++ [Char
c]

--tricky bit to deal with regex literals and comments / / -- if we hit // inside, then we fail, since that isn't ending the regex but introducing a comment, and thus the initial / could not have introduced a regex.
regexLiteral :: JMParser String
regexLiteral :: JMParser [Char]
regexLiteral = do
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/'
    [Char]
x <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall {u}. ParsecT [Char] u Identity [Char]
myChar
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/'
    Bool
b <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
    if Bool
b
       then forall (m :: * -> *) a. MonadPlus m => m a
mzero
       else forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
x
 where myChar :: ParsecT [Char] u Identity [Char]
myChar = do
         Char
c <- forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char
'/',Char
'\n']
         case Char
c of
           Char
'\\' -> do
                  Char
c2 <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
                  forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c,Char
c2]
           Char
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c]