{-# LANGUAGE FlexibleInstances, UndecidableInstances, OverlappingInstances, TypeFamilies, TemplateHaskell, QuasiQuotes, RankNTypes, GADTs #-}
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 qualified Language.Haskell.TH as TH
import Language.Haskell.TH(mkName)
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)
jmacro :: QuasiQuoter
jmacro :: QuasiQuoter
jmacro = QuasiQuoter {quoteExp :: [Char] -> Q Exp
quoteExp = [Char] -> Q Exp
quoteJMExp, quotePat :: [Char] -> Q Pat
quotePat = [Char] -> Q Pat
quoteJMPat}
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)
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)
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
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
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)
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
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
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 [])
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
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]
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)
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
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)
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 ()))
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]
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]
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]