{-# 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 b. Data b => b -> Maybe (Q Pat)) -> JStat -> Q Pat
forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ (Maybe (Q Pat) -> b -> Maybe (Q Pat)
forall a b. a -> b -> a
const Maybe (Q Pat)
forall a. Maybe a
Nothing) JStat
x
Left ParseError
err -> [Char] -> Q Pat
forall a. [Char] -> Q a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (ParseError -> [Char]
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 -> JStat -> Q Exp
forall a. Data a => a -> Q Exp
jm2th JStat
x
Left ParseError
err -> do
(Int
line,Int
_) <- Loc -> (Int, Int)
TH.loc_start (Loc -> (Int, Int)) -> Q Loc -> Q (Int, Int)
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 (Int -> SourcePos) -> Int -> SourcePos
forall a b. (a -> b) -> a -> b
$ Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SourcePos -> Int
sourceLine SourcePos
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
[Char] -> Q Exp
forall a. [Char] -> Q a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (ParseError -> [Char]
forall a. Show a => a -> [Char]
show (ParseError -> [Char]) -> ParseError -> [Char]
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 b. Data b => b -> Maybe (Q Pat)) -> JExpr -> Q Pat
forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ (Maybe (Q Pat) -> b -> Maybe (Q Pat)
forall a b. a -> b -> a
const Maybe (Q Pat)
forall a. Maybe a
Nothing) JExpr
x
Left ParseError
err -> [Char] -> Q Pat
forall a. [Char] -> Q a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (ParseError -> [Char]
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 -> JExpr -> Q Exp
forall a. Data a => a -> Q Exp
jm2th JExpr
x
Left ParseError
err -> do
(Int
line,Int
_) <- Loc -> (Int, Int)
TH.loc_start (Loc -> (Int, Int)) -> Q Loc -> Q (Int, Int)
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 (Int -> SourcePos) -> Int -> SourcePos
forall a b. (a -> b) -> a -> b
$ Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SourcePos -> Int
sourceLine SourcePos
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
[Char] -> Q Exp
forall a. [Char] -> Q a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (ParseError -> [Char]
forall a. Show a => a -> [Char]
show (ParseError -> [Char]) -> ParseError -> [Char]
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 = JMGadt a -> a
forall a. JMacro a => JMGadt a -> a
jfromGADT (JMGadt a -> a) -> JMGadt a -> a
forall a b. (a -> b) -> a -> b
$ JMGadt a -> JMGadt a
forall a. JMGadt a -> JMGadt a
go (a -> JMGadt a
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 [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
s' = JExpr -> JMGadt JExpr
JMGExpr ([Char] -> JExpr
AntiExpr ([Char] -> JExpr) -> [Char] -> JExpr
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 ([Char] -> JExpr -> JExpr
forall a. JMacro a => [Char] -> a -> a
antiIdent [Char]
s JExpr
x) Ident
i)
go JMGadt a
x = (forall a. JMGadt a -> JMGadt a) -> JMGadt a -> JMGadt a
forall (t :: * -> *) b.
Compos t =>
(forall a. t a -> t a) -> t b -> t b
composOp JMGadt a -> JMGadt a
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 = ([Char] -> a -> a) -> a -> [[Char]] -> a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [Char] -> a -> a
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
'_' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
escapeDollar [Char]
css
| Bool
otherwise = [Char] -> [Char]
escapeDollar [Char]
css
where
escapeDollar :: [Char] -> [Char]
escapeDollar = (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char
x Char -> Char -> Bool
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 b. Data b => b -> Maybe (Q Exp)) -> a -> Q Exp
forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Exp)) -> a -> m Exp
dataToExpQ (Maybe (Q Exp) -> b -> Maybe (Q Exp)
forall a b. a -> b -> a
const Maybe (Q Exp)
forall a. Maybe a
Nothing
(b -> Maybe (Q Exp))
-> (JStat -> Maybe (Q Exp)) -> b -> Maybe (Q Exp)
forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` JStat -> Maybe (Q Exp)
handleStat
(b -> Maybe (Q Exp))
-> (JExpr -> Maybe (Q Exp)) -> b -> Maybe (Q Exp)
forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` JExpr -> Maybe (Q Exp)
handleExpr
(b -> Maybe (Q Exp))
-> (JVal -> Maybe (Q Exp)) -> b -> Maybe (Q Exp)
forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` JVal -> Maybe (Q Exp)
handleVal
(b -> Maybe (Q Exp))
-> ([Char] -> Maybe (Q Exp)) -> b -> Maybe (Q Exp)
forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` [Char] -> Maybe (Q Exp)
handleStr
(b -> Maybe (Q Exp))
-> (JType -> Maybe (Q Exp)) -> b -> Maybe (Q Exp)
forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` JType -> Maybe (Q Exp)
handleTyp
) a
v
where handleStat :: JStat -> Maybe (TH.ExpQ)
handleStat :: JStat -> Maybe (Q Exp)
handleStat (BlockStat [JStat]
ss) = Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp)) -> Q Exp -> Maybe (Q Exp)
forall a b. (a -> b) -> a -> b
$
[Char] -> Q Exp -> Q Exp
forall {m :: * -> *}. Quote m => [Char] -> m Exp -> m Exp
appConstr [Char]
"BlockStat" (Q Exp -> Q Exp) -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$
[Q Exp] -> Q Exp
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') -> JStat -> Q Exp
forall a. Data a => a -> Q Exp
jm2th (Ident -> Maybe JLocalType -> JStat
DeclStat ([Char] -> Ident
StrI [Char]
i') Maybe JLocalType
t) Q Exp -> [Q Exp] -> [Q Exp]
forall a. a -> [a] -> [a]
: [JStat] -> [Q Exp]
blocks [JStat]
xs
(Char
'!':[Char]
i') ->
[Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE ([Q Pat] -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
TH.lamE [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
TH.varP (Name -> Q Pat) -> ([Char] -> Name) -> [Char] -> Q Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Name
mkName ([Char] -> Name) -> ([Char] -> [Char]) -> [Char] -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
fixIdent ([Char] -> Q Pat) -> [Char] -> Q Pat
forall a b. (a -> b) -> a -> b
$ [Char]
i'] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$
[Char] -> Q Exp -> Q Exp
forall {m :: * -> *}. Quote m => [Char] -> m Exp -> m Exp
appConstr [Char]
"BlockStat"
([Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
TH.listE ([Q Exp] -> Q Exp) -> ([JStat] -> [Q Exp]) -> [JStat] -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Q Exp
dsQ Exp -> [Q Exp] -> [Q Exp]
forall a. a -> [a] -> [a]
:) ([Q Exp] -> [Q Exp]) -> ([JStat] -> [Q Exp]) -> [JStat] -> [Q Exp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JStat] -> [Q Exp]
blocks ([JStat] -> Q Exp) -> [JStat] -> Q Exp
forall a b. (a -> b) -> a -> b
$ [JStat]
xs)) (Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
TH.varE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"jsv")
(Lit -> Q Exp
forall (m :: * -> *). Quote m => Lit -> m Exp
TH.litE (Lit -> Q Exp) -> Lit -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Lit
TH.StringL [Char]
i'))]
where ds :: Q Exp
ds =
Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE
(Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
TH.conE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"DeclStat")
(Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
TH.conE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"StrI")
(Lit -> Q Exp
forall (m :: * -> *). Quote m => Lit -> m Exp
TH.litE (Lit -> Q Exp) -> Lit -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Lit
TH.StringL [Char]
i')))
(Maybe JLocalType -> Q Exp
forall a. Data a => a -> Q Exp
jm2th Maybe JLocalType
t)
[Char]
_ ->
[Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE
(Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
TH.varE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"jVarTy")
([Q Pat] -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
TH.lamE [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
TH.varP (Name -> Q Pat) -> ([Char] -> Name) -> [Char] -> Q Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Name
mkName ([Char] -> Name) -> ([Char] -> [Char]) -> [Char] -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
fixIdent ([Char] -> Q Pat) -> [Char] -> Q Pat
forall a b. (a -> b) -> a -> b
$ [Char]
i] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$
[Char] -> Q Exp -> Q Exp
forall {m :: * -> *}. Quote m => [Char] -> m Exp -> m Exp
appConstr [Char]
"BlockStat"
([Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
TH.listE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
forall a b. (a -> b) -> a -> b
$ [JStat] -> [Q Exp]
blocks ([JStat] -> [Q Exp]) -> [JStat] -> [Q Exp]
forall a b. (a -> b) -> a -> b
$ (JStat -> JStat) -> [JStat] -> [JStat]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> JStat -> JStat
forall a. JMacro a => [Char] -> a -> a
antiIdent [Char]
i) [JStat]
xs)))
(Maybe JLocalType -> Q Exp
forall a. Data a => a -> Q Exp
jm2th Maybe JLocalType
t)
]
blocks (JStat
x:[JStat]
xs) = JStat -> Q Exp
forall a. Data a => a -> Q Exp
jm2th JStat
x Q Exp -> [Q Exp] -> [Q Exp]
forall a. a -> [a] -> [a]
: [JStat] -> [Q Exp]
blocks [JStat]
xs
handleStat (ForInStat Bool
b (StrI [Char]
i) JExpr
e JStat
s) = Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp)) -> Q Exp -> Maybe (Q Exp)
forall a b. (a -> b) -> a -> b
$
Q Exp -> [Q Exp] -> Q Exp
forall {t :: * -> *} {m :: * -> *}.
(Foldable t, Quote m) =>
m Exp -> t (m Exp) -> m Exp
appFun (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
TH.varE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name
forFunc)
[JExpr -> Q Exp
forall a. Data a => a -> Q Exp
jm2th JExpr
e,
[Q Pat] -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
TH.lamE [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
TH.varP (Name -> Q Pat) -> Name -> Q Pat
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
i]
(JStat -> Q Exp
forall a. Data a => a -> Q Exp
jm2th (JStat -> Q Exp) -> JStat -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> JStat -> JStat
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 JStat -> JStat -> Bool
forall a. Eq a => a -> a -> Bool
== [JStat] -> JStat
BlockStat [] = Maybe (Q Exp)
forall a. Maybe a
Nothing
| Bool
otherwise = Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp)) -> Q Exp -> Maybe (Q Exp)
forall a b. (a -> b) -> a -> b
$
Q Exp -> [Q Exp] -> Q Exp
forall {t :: * -> *} {m :: * -> *}.
(Foldable t, Quote m) =>
m Exp -> t (m Exp) -> m Exp
appFun (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
TH.varE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"jTryCatchFinally")
[JStat -> Q Exp
forall a. Data a => a -> Q Exp
jm2th JStat
s,
[Q Pat] -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
TH.lamE [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
TH.varP (Name -> Q Pat) -> Name -> Q Pat
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
i]
(JStat -> Q Exp
forall a. Data a => a -> Q Exp
jm2th (JStat -> Q Exp) -> JStat -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> JStat -> JStat
forall a. JMacro a => [Char] -> a -> a
antiIdent [Char]
i JStat
s1),
JStat -> Q Exp
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 -> Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp)) -> Q Exp -> Maybe (Q Exp)
forall a b. (a -> b) -> a -> b
$ Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
TH.varE ([Char] -> Name
mkName [Char]
"toStat"))
(Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
ans)
Left [Char]
err -> Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp)) -> Q Exp -> Maybe (Q Exp)
forall a b. (a -> b) -> a -> b
$ [Char] -> Q Exp
forall a. [Char] -> Q a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
err
handleStat JStat
_ = Maybe (Q Exp)
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 -> Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp)) -> Q Exp -> Maybe (Q Exp)
forall a b. (a -> b) -> a -> b
$ Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
TH.varE ([Char] -> Name
mkName [Char]
"toJExpr")) (Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
ans)
Left [Char]
err -> Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp)) -> Q Exp -> Maybe (Q Exp)
forall a b. (a -> b) -> a -> b
$ [Char] -> Q Exp
forall a. [Char] -> Q a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
err
handleExpr (ValExpr (JFunc [Ident]
is' JStat
s)) = Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp)) -> Q Exp -> Maybe (Q Exp)
forall a b. (a -> b) -> a -> b
$
Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
TH.varE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"jLam")
([Q Pat] -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
TH.lamE (([Char] -> Q Pat) -> [[Char]] -> [Q Pat]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
TH.varP (Name -> Q Pat) -> ([Char] -> Name) -> [Char] -> Q Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Name
mkName ([Char] -> Name) -> ([Char] -> [Char]) -> [Char] -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
fixIdent) [[Char]]
is)
(JStat -> Q Exp
forall a. Data a => a -> Q Exp
jm2th (JStat -> Q Exp) -> JStat -> Q Exp
forall a b. (a -> b) -> a -> b
$ [[Char]] -> JStat -> JStat
forall a. JMacro a => [[Char]] -> a -> a
antiIdents [[Char]]
is JStat
s))
where is :: [[Char]]
is = (Ident -> [Char]) -> [Ident] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\(StrI [Char]
i) -> [Char]
i) [Ident]
is'
handleExpr JExpr
_ = Maybe (Q Exp)
forall a. Maybe a
Nothing
handleVal :: JVal -> Maybe (TH.ExpQ)
handleVal :: JVal -> Maybe (Q Exp)
handleVal (JHash Map [Char] JExpr
m) = Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp)) -> Q Exp -> Maybe (Q Exp)
forall a b. (a -> b) -> a -> b
$
Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
TH.varE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"jhFromList") (Q Exp -> Q Exp) -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$
[([Char], JExpr)] -> Q Exp
forall a. Data a => a -> Q Exp
jm2th (Map [Char] JExpr -> [([Char], JExpr)]
forall k a. Map k a -> [(k, a)]
M.toList Map [Char] JExpr
m)
handleVal JVal
_ = Maybe (Q Exp)
forall a. Maybe a
Nothing
handleStr :: String -> Maybe (TH.ExpQ)
handleStr :: [Char] -> Maybe (Q Exp)
handleStr [Char]
x = Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp)) -> Q Exp -> Maybe (Q Exp)
forall a b. (a -> b) -> a -> b
$ Lit -> Q Exp
forall (m :: * -> *). Quote m => Lit -> m Exp
TH.litE (Lit -> Q Exp) -> Lit -> Q Exp
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) = Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp)) -> Q Exp -> Maybe (Q Exp)
forall a b. (a -> b) -> a -> b
$
Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
TH.varE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"jtFromList") (JType -> Q Exp
forall a. Data a => a -> Q Exp
jm2th JType
t))
([([Char], JType)] -> Q Exp
forall a. Data a => a -> Q Exp
jm2th ([([Char], JType)] -> Q Exp) -> [([Char], JType)] -> Q Exp
forall a b. (a -> b) -> a -> b
$ Map [Char] JType -> [([Char], JType)]
forall k a. Map k a -> [(k, a)]
M.toList Map [Char] JType
mp)
handleTyp JType
_ = Maybe (Q Exp)
forall a. Maybe a
Nothing
appFun :: m Exp -> t (m Exp) -> m Exp
appFun m Exp
x = (m Exp -> m Exp -> m Exp) -> m Exp -> t (m Exp) -> m Exp
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (m Exp -> m Exp -> m Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE) m Exp
x
appConstr :: [Char] -> m Exp -> m Exp
appConstr [Char]
n = m Exp -> m Exp -> m Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE (Name -> m Exp
forall (m :: * -> *). Quote m => Name -> m Exp
TH.conE (Name -> m Exp) -> Name -> m Exp
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 = GenLanguageDef [Char] () Identity -> TokenParser ()
forall s (m :: * -> *) u.
Stream s m Char =>
GenLanguageDef s u m -> GenTokenParser s u m
P.makeTokenParser GenLanguageDef [Char] () Identity
jsLang
jsLang :: P.LanguageDef ()
jsLang :: GenLanguageDef [Char] () Identity
jsLang = LanguageDef Any
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 = ParsecT [Char] () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"_$",
identStart :: ParsecT [Char] () Identity Char
P.identStart = ParsecT [Char] () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"_$",
opStart :: ParsecT [Char] () Identity Char
P.opStart = [Char] -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"|+-/*%<>&^.?=!~:@",
opLetter :: ParsecT [Char] () Identity Char
P.opLetter = [Char] -> ParsecT [Char] () Identity Char
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 = TokenParser () -> JMParser [Char]
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m [Char]
P.identifier (TokenParser () -> JMParser [Char])
-> TokenParser () -> JMParser [Char]
forall a b. (a -> b) -> a -> b
$ GenLanguageDef [Char] () Identity -> TokenParser ()
forall s (m :: * -> *) u.
Stream s m Char =>
GenLanguageDef s u m -> GenTokenParser s u m
P.makeTokenParser (GenLanguageDef [Char] () Identity -> TokenParser ())
-> GenLanguageDef [Char] () Identity -> TokenParser ()
forall a b. (a -> b) -> a -> b
$ GenLanguageDef [Char] () Identity
jsLang {identStart :: ParsecT [Char] () Identity Char
P.identStart = ParsecT [Char] () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"_$!"}
whiteSpace :: JMParser ()
whiteSpace= TokenParser () -> JMParser ()
forall s u (m :: * -> *). GenTokenParser s u m -> ParsecT s u m ()
P.whiteSpace TokenParser ()
lexer
symbol :: [Char] -> JMParser [Char]
symbol = TokenParser () -> [Char] -> JMParser [Char]
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 = TokenParser () -> forall a. JMParser a -> JMParser a
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 = TokenParser () -> forall a. JMParser a -> JMParser a
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 = TokenParser () -> JMParser [Char]
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m [Char]
P.dot TokenParser ()
lexer
colon :: JMParser [Char]
colon = TokenParser () -> JMParser [Char]
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m [Char]
P.colon TokenParser ()
lexer
semi :: JMParser [Char]
semi = TokenParser () -> JMParser [Char]
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m [Char]
P.semi TokenParser ()
lexer
identifier :: JMParser [Char]
identifier= TokenParser () -> JMParser [Char]
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m [Char]
P.identifier TokenParser ()
lexer
reserved :: [Char] -> JMParser ()
reserved = TokenParser () -> [Char] -> JMParser ()
forall s u (m :: * -> *).
GenTokenParser s u m -> [Char] -> ParsecT s u m ()
P.reserved TokenParser ()
lexer
reservedOp :: [Char] -> JMParser ()
reservedOp= TokenParser () -> [Char] -> JMParser ()
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 = TokenParser () -> forall a. JMParser a -> JMParser [a]
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 = TokenParser () -> forall a. JMParser a -> JMParser [a]
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 = TokenParser () -> forall a. JMParser a -> JMParser a
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
b -> m b
forall a. a -> m a
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 ([JStat] -> JStat)
-> Either ParseError [JStat] -> Either ParseError JStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenParser Char () [JStat]
-> () -> [Char] -> [Char] -> Either ParseError [JStat]
forall tok st a.
GenParser tok st a -> st -> [Char] -> [tok] -> Either ParseError a
runParser GenParser Char () [JStat]
jmacroParser () [Char]
"" [Char]
s
where jmacroParser :: GenParser Char () [JStat]
jmacroParser = do
[JStat]
ans <- GenParser Char () [JStat]
statblock
JMParser ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
[JStat] -> GenParser Char () [JStat]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [JStat]
ans
parseJME :: String -> Either ParseError JExpr
parseJME :: [Char] -> Either ParseError JExpr
parseJME [Char]
s = GenParser Char () JExpr
-> () -> [Char] -> [Char] -> Either ParseError JExpr
forall tok st a.
GenParser tok st a -> st -> [Char] -> [tok] -> Either ParseError a
runParser GenParser Char () JExpr
jmacroParserE () [Char]
"" [Char]
s
where jmacroParserE :: GenParser Char () JExpr
jmacroParserE = do
JExpr
ans <- JMParser ()
whiteSpace JMParser () -> GenParser Char () JExpr -> GenParser Char () JExpr
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Char () JExpr
expr
JMParser ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
JExpr -> GenParser Char () JExpr
forall a. a -> ParsecT [Char] () Identity a
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]
"::!" JMParser ()
-> ParsecT [Char] () Identity Bool
-> ParsecT [Char] () Identity Bool
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT [Char] () Identity Bool
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) ParsecT [Char] () Identity Bool
-> ParsecT [Char] () Identity Bool
-> ParsecT [Char] () Identity Bool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Char] -> JMParser ()
reservedOp [Char]
"::" JMParser ()
-> ParsecT [Char] () Identity Bool
-> ParsecT [Char] () Identity Bool
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT [Char] () Identity Bool
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
JLocalType
t <- CharParser () JLocalType
forall a. CharParser a JLocalType
runTypeParser
(Bool, JLocalType) -> JMParser (Bool, JLocalType)
forall a. a -> ParsecT [Char] () Identity a
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
Bool -> JMParser () -> JMParser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
"jmId_" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
i Bool -> Bool -> Bool
|| [Char]
"!jmId_" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
i) (JMParser () -> JMParser ()) -> JMParser () -> JMParser ()
forall a b. (a -> b) -> a -> b
$ [Char] -> JMParser ()
forall a. [Char] -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Illegal use of reserved jmId_ prefix in variable name."
Bool -> JMParser () -> JMParser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
i[Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
==[Char]
"this" Bool -> Bool -> Bool
|| [Char]
i[Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
==[Char]
"!this") (JMParser () -> JMParser ()) -> JMParser () -> JMParser ()
forall a b. (a -> b) -> a -> b
$ [Char] -> JMParser ()
forall a. [Char] -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Illegal attempt to name variable 'this'."
Maybe (Bool, JLocalType)
t <- JMParser (Bool, JLocalType)
-> ParsecT [Char] () Identity (Maybe (Bool, JLocalType))
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, Maybe (Bool, JLocalType))
-> JMParser (Ident, Maybe (Bool, JLocalType))
forall a. a -> ParsecT [Char] () Identity a
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
Bool -> JMParser () -> JMParser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
"jmId_" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
i) (JMParser () -> JMParser ()) -> JMParser () -> JMParser ()
forall a b. (a -> b) -> a -> b
$ [Char] -> JMParser ()
forall a. [Char] -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Illegal use of reserved jmId_ prefix in variable name."
Bool -> JMParser () -> JMParser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
i[Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
==[Char]
"this") (JMParser () -> JMParser ()) -> JMParser () -> JMParser ()
forall a b. (a -> b) -> a -> b
$ [Char] -> JMParser ()
forall a. [Char] -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Illegal attempt to name variable 'this'."
Ident -> JMParser Ident
forall a. a -> ParsecT [Char] () Identity a
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]
(Int -> PatternTree -> [Char] -> [Char])
-> (PatternTree -> [Char])
-> ([PatternTree] -> [Char] -> [Char])
-> Show PatternTree
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> PatternTree -> [Char] -> [Char]
showsPrec :: Int -> PatternTree -> [Char] -> [Char]
$cshow :: PatternTree -> [Char]
show :: PatternTree -> [Char]
$cshowList :: [PatternTree] -> [Char] -> [Char]
showList :: [PatternTree] -> [Char] -> [Char]
Show
patternTree :: JMParser PatternTree
patternTree :: JMParser PatternTree
patternTree = [PatternTree] -> PatternTree
toCons ([PatternTree] -> PatternTree)
-> ParsecT [Char] () Identity [PatternTree] -> JMParser PatternTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JMParser PatternTree -> JMParser PatternTree
forall a. JMParser a -> JMParser a
parens JMParser PatternTree
patternTree JMParser PatternTree
-> JMParser PatternTree -> JMParser PatternTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> JMParser PatternTree
ptList JMParser PatternTree
-> JMParser PatternTree -> JMParser PatternTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> JMParser PatternTree
ptObj JMParser PatternTree
-> JMParser PatternTree -> JMParser PatternTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> JMParser PatternTree
varOrAs) JMParser PatternTree
-> JMParser () -> ParsecT [Char] () Identity [PatternTree]
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 = JMParser PatternTree -> JMParser PatternTree
forall a. JMParser a -> JMParser a
lexeme (JMParser PatternTree -> JMParser PatternTree)
-> JMParser PatternTree -> JMParser PatternTree
forall a b. (a -> b) -> a -> b
$ [PatternTree] -> PatternTree
PTList ([PatternTree] -> PatternTree)
-> ParsecT [Char] () Identity [PatternTree] -> JMParser PatternTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] () Identity [PatternTree]
-> ParsecT [Char] () Identity [PatternTree]
forall a. JMParser a -> JMParser a
brackets' (JMParser PatternTree -> ParsecT [Char] () Identity [PatternTree]
forall a. JMParser a -> JMParser [a]
commaSep JMParser PatternTree
patternTree)
ptObj :: JMParser PatternTree
ptObj = JMParser PatternTree -> JMParser PatternTree
forall a. JMParser a -> JMParser a
lexeme (JMParser PatternTree -> JMParser PatternTree)
-> JMParser PatternTree -> JMParser PatternTree
forall a b. (a -> b) -> a -> b
$ [([Char], PatternTree)] -> PatternTree
PTObj ([([Char], PatternTree)] -> PatternTree)
-> ParsecT [Char] () Identity [([Char], PatternTree)]
-> JMParser PatternTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] () Identity [([Char], PatternTree)]
-> ParsecT [Char] () Identity [([Char], PatternTree)]
forall a. JMParser a -> JMParser a
oxfordBraces (JMParser ([Char], PatternTree)
-> ParsecT [Char] () Identity [([Char], PatternTree)]
forall a. JMParser a -> JMParser [a]
commaSep (JMParser ([Char], PatternTree)
-> ParsecT [Char] () Identity [([Char], PatternTree)])
-> JMParser ([Char], PatternTree)
-> ParsecT [Char] () Identity [([Char], PatternTree)]
forall a b. (a -> b) -> a -> b
$ ([Char] -> PatternTree -> ([Char], PatternTree))
-> JMParser [Char]
-> JMParser PatternTree
-> JMParser ([Char], PatternTree)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) JMParser [Char]
myIdent (JMParser [Char]
colon JMParser [Char] -> JMParser PatternTree -> JMParser PatternTree
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JMParser PatternTree
patternTree))
varOrAs :: JMParser PatternTree
varOrAs = do
Ident
i <- (Ident, Maybe (Bool, JLocalType)) -> Ident
forall a b. (a, b) -> a
fst ((Ident, Maybe (Bool, JLocalType)) -> Ident)
-> JMParser (Ident, Maybe (Bool, JLocalType)) -> JMParser Ident
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JMParser (Ident, Maybe (Bool, JLocalType))
varidentdecl
Bool
isAs <- Bool
-> ParsecT [Char] () Identity Bool
-> ParsecT [Char] () Identity Bool
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]
"@" JMParser ()
-> ParsecT [Char] () Identity Bool
-> ParsecT [Char] () Identity Bool
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT [Char] () Identity Bool
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
if Bool
isAs
then Ident -> PatternTree -> PatternTree
PTAs Ident
i (PatternTree -> PatternTree)
-> JMParser PatternTree -> JMParser PatternTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JMParser PatternTree
patternTree
else PatternTree -> JMParser PatternTree
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PatternTree -> JMParser PatternTree)
-> PatternTree -> JMParser PatternTree
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 Maybe JLocalType
forall a. Maybe a
Nothing, JExpr -> JExpr -> JStat
AssignStat (JVal -> JExpr
ValExpr (Ident -> JVal
JVar (Ident -> Ident
cleanIdent Ident
asIdent))) JExpr
path] [JStat] -> [JStat] -> [JStat]
forall a. [a] -> [a] -> [a]
++ JExpr -> PatternTree -> [JStat]
go JExpr
path PatternTree
pt
go JExpr
path (PTVar Ident
i)
| Ident
i Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== ([Char] -> Ident
StrI [Char]
"_") = []
| Bool
otherwise = [Ident -> Maybe JLocalType -> JStat
DeclStat Ident
i Maybe JLocalType
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) = ((JExpr, PatternTree) -> [JStat])
-> [(JExpr, PatternTree)] -> [JStat]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((JExpr -> PatternTree -> [JStat])
-> (JExpr, PatternTree) -> [JStat]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry JExpr -> PatternTree -> [JStat]
go) ([(JExpr, PatternTree)] -> [JStat])
-> [(JExpr, PatternTree)] -> [JStat]
forall a b. (a -> b) -> a -> b
$ [JExpr] -> [PatternTree] -> [(JExpr, PatternTree)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Integer -> JExpr) -> [Integer] -> [JExpr]
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 (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ Integer -> JVal
JInt Integer
i)
go JExpr
path (PTObj [([Char], PatternTree)]
xs) = ((JExpr, PatternTree) -> [JStat])
-> [(JExpr, PatternTree)] -> [JStat]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((JExpr -> PatternTree -> [JStat])
-> (JExpr, PatternTree) -> [JStat]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry JExpr -> PatternTree -> [JStat]
go) ([(JExpr, PatternTree)] -> [JStat])
-> [(JExpr, PatternTree)] -> [JStat]
forall a b. (a -> b) -> a -> b
$ (([Char], PatternTree) -> (JExpr, PatternTree))
-> [([Char], PatternTree)] -> [(JExpr, PatternTree)]
forall a b. (a -> b) -> [a] -> [b]
map (([Char] -> JExpr) -> ([Char], PatternTree) -> (JExpr, PatternTree)
forall b c d. (b -> c) -> (b, d) -> (c, d)
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 (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ [Char] -> JVal
JStr [Char]
lbl)
go JExpr
path (PTCons PatternTree
x PatternTree
xs) = [[JStat]] -> [JStat]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [JExpr -> PatternTree -> [JStat]
go (JExpr -> JExpr -> JExpr
IdxExpr JExpr
path (JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
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 (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ Integer -> JVal
JInt Integer
1]) PatternTree
xs]
case PatternTree
ptree of
PTVar Ident
i -> Either (Ident -> [JStat]) (Ident, [JStat])
-> JMParser (Either (Ident -> [JStat]) (Ident, [JStat]))
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Ident -> [JStat]) (Ident, [JStat])
-> JMParser (Either (Ident -> [JStat]) (Ident, [JStat])))
-> Either (Ident -> [JStat]) (Ident, [JStat])
-> JMParser (Either (Ident -> [JStat]) (Ident, [JStat]))
forall a b. (a -> b) -> a -> b
$ (Ident, [JStat]) -> Either (Ident -> [JStat]) (Ident, [JStat])
forall a b. b -> Either a b
Right (Ident
i,[])
PTAs Ident
i PatternTree
pt -> Either (Ident -> [JStat]) (Ident, [JStat])
-> JMParser (Either (Ident -> [JStat]) (Ident, [JStat]))
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Ident -> [JStat]) (Ident, [JStat])
-> JMParser (Either (Ident -> [JStat]) (Ident, [JStat])))
-> Either (Ident -> [JStat]) (Ident, [JStat])
-> JMParser (Either (Ident -> [JStat]) (Ident, [JStat]))
forall a b. (a -> b) -> a -> b
$ (Ident, [JStat]) -> Either (Ident -> [JStat]) (Ident, [JStat])
forall a b. b -> Either a b
Right (Ident
i, JExpr -> PatternTree -> [JStat]
go (JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ Ident -> JVal
JVar Ident
i) PatternTree
pt)
PatternTree
_ -> Either (Ident -> [JStat]) (Ident, [JStat])
-> JMParser (Either (Ident -> [JStat]) (Ident, [JStat]))
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Ident -> [JStat]) (Ident, [JStat])
-> JMParser (Either (Ident -> [JStat]) (Ident, [JStat])))
-> Either (Ident -> [JStat]) (Ident, [JStat])
-> JMParser (Either (Ident -> [JStat]) (Ident, [JStat]))
forall a b. (a -> b) -> a -> b
$ (Ident -> [JStat]) -> Either (Ident -> [JStat]) (Ident, [JStat])
forall a b. a -> Either a b
Left ((Ident -> [JStat]) -> Either (Ident -> [JStat]) (Ident, [JStat]))
-> (Ident -> [JStat]) -> Either (Ident -> [JStat]) (Ident, [JStat])
forall a b. (a -> b) -> a -> b
$ \Ident
i -> JExpr -> PatternTree -> [JStat]
go (JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ Ident -> JVal
JVar Ident
i) PatternTree
ptree
patternBlocks :: JMParser ([Ident],[JStat])
patternBlocks :: JMParser ([Ident], [JStat])
patternBlocks = ([[JStat]] -> [JStat])
-> ([Ident], [[JStat]]) -> ([Ident], [JStat])
forall a b. (a -> b) -> ([Ident], a) -> ([Ident], b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[JStat]] -> [JStat]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (([Ident], [[JStat]]) -> ([Ident], [JStat]))
-> ([Either (Ident -> [JStat]) (Ident, [JStat])]
-> ([Ident], [[JStat]]))
-> [Either (Ident -> [JStat]) (Ident, [JStat])]
-> ([Ident], [JStat])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Ident, [JStat])] -> ([Ident], [[JStat]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Ident, [JStat])] -> ([Ident], [[JStat]]))
-> ([Either (Ident -> [JStat]) (Ident, [JStat])]
-> [(Ident, [JStat])])
-> [Either (Ident -> [JStat]) (Ident, [JStat])]
-> ([Ident], [[JStat]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ident
-> Either (Ident -> [JStat]) (Ident, [JStat]) -> (Ident, [JStat]))
-> [Ident]
-> [Either (Ident -> [JStat]) (Ident, [JStat])]
-> [(Ident, [JStat])]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Ident
i Either (Ident -> [JStat]) (Ident, [JStat])
efr -> ((Ident -> [JStat]) -> (Ident, [JStat]))
-> ((Ident, [JStat]) -> (Ident, [JStat]))
-> Either (Ident -> [JStat]) (Ident, [JStat])
-> (Ident, [JStat])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\Ident -> [JStat]
f -> (Ident
i, Ident -> [JStat]
f Ident
i)) (Ident, [JStat]) -> (Ident, [JStat])
forall a. a -> a
id Either (Ident -> [JStat]) (Ident, [JStat])
efr) ((Int -> Ident) -> [Int] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Ident
StrI ([Char] -> Ident) -> (Int -> [Char]) -> Int -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"jmId_match_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char]) -> (Int -> [Char]) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show) [(Int
1::Int)..]) ([Either (Ident -> [JStat]) (Ident, [JStat])]
-> ([Ident], [JStat]))
-> ParsecT
[Char] () Identity [Either (Ident -> [JStat]) (Ident, [JStat])]
-> JMParser ([Ident], [JStat])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JMParser (Either (Ident -> [JStat]) (Ident, [JStat]))
-> ParsecT
[Char] () Identity [Either (Ident -> [JStat]) (Ident, [JStat])]
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 :: GenParser Char () [JStat]
destructuringDecl = do
(Ident
i,[JStat]
patDecls) <- ((Ident -> [JStat]) -> (Ident, [JStat]))
-> ((Ident, [JStat]) -> (Ident, [JStat]))
-> Either (Ident -> [JStat]) (Ident, [JStat])
-> (Ident, [JStat])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\Ident -> [JStat]
f -> (Ident
matchVar, Ident -> [JStat]
f Ident
matchVar)) (Ident, [JStat]) -> (Ident, [JStat])
forall a. a -> a
id (Either (Ident -> [JStat]) (Ident, [JStat]) -> (Ident, [JStat]))
-> JMParser (Either (Ident -> [JStat]) (Ident, [JStat]))
-> ParsecT [Char] () Identity (Ident, [JStat])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JMParser (Either (Ident -> [JStat]) (Ident, [JStat]))
patternBinding
Maybe [JStat]
optAssignStat <- GenParser Char () [JStat]
-> ParsecT [Char] () Identity (Maybe [JStat])
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (GenParser Char () [JStat]
-> ParsecT [Char] () Identity (Maybe [JStat]))
-> GenParser Char () [JStat]
-> ParsecT [Char] () Identity (Maybe [JStat])
forall a b. (a -> b) -> a -> b
$ do
[Char] -> JMParser ()
reservedOp [Char]
"="
JExpr
e <- GenParser Char () JExpr
expr
[JStat] -> GenParser Char () [JStat]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([JStat] -> GenParser Char () [JStat])
-> [JStat] -> GenParser Char () [JStat]
forall a b. (a -> b) -> a -> b
$ JExpr -> JExpr -> JStat
AssignStat (JVal -> JExpr
ValExpr (Ident -> JVal
JVar (Ident -> Ident
cleanIdent Ident
i))) JExpr
e JStat -> [JStat] -> [JStat]
forall a. a -> [a] -> [a]
: [JStat]
patDecls
[JStat] -> GenParser Char () [JStat]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([JStat] -> GenParser Char () [JStat])
-> [JStat] -> GenParser Char () [JStat]
forall a b. (a -> b) -> a -> b
$ Ident -> Maybe JLocalType -> JStat
DeclStat Ident
i Maybe JLocalType
forall a. Maybe a
Nothing JStat -> [JStat] -> [JStat]
forall a. a -> [a] -> [a]
: [JStat] -> Maybe [JStat] -> [JStat]
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 :: GenParser Char () [JStat]
statblock = [[JStat]] -> [JStat]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[JStat]] -> [JStat])
-> ParsecT [Char] () Identity [[JStat]]
-> GenParser Char () [JStat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GenParser Char () [JStat]
-> JMParser [Char] -> ParsecT [Char] () Identity [[JStat]]
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 JMParser ()
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Char () [JStat]
statement) (JMParser [Char]
semi JMParser [Char] -> JMParser [Char] -> JMParser [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> JMParser [Char]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
""))
statblock0 :: JMParser [JStat]
statblock0 :: GenParser Char () [JStat]
statblock0 = GenParser Char () [JStat] -> GenParser Char () [JStat]
forall tok st a. GenParser tok st a -> GenParser tok st a
try GenParser Char () [JStat]
statblock GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (JMParser ()
whiteSpace JMParser ()
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [JStat] -> GenParser Char () [JStat]
forall a. a -> ParsecT [Char] () Identity a
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 :: GenParser Char () [JStat]
statementOrEmpty = GenParser Char () [JStat] -> GenParser Char () [JStat]
forall tok st a. GenParser tok st a -> GenParser tok st a
try GenParser Char () [JStat]
forall {a}. JMParser [a]
emptyStat GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
statement
where emptyStat :: JMParser [a]
emptyStat = JMParser [a] -> JMParser [a]
forall a. JMParser a -> JMParser a
braces (JMParser ()
whiteSpace JMParser () -> JMParser [a] -> JMParser [a]
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [a] -> JMParser [a]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [])
statement :: JMParser [JStat]
statement :: GenParser Char () [JStat]
statement = GenParser Char () [JStat]
declStat
GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
funDecl
GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
functionDecl
GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
foreignStat
GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
returnStat
GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
labelStat
GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
ifStat
GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
whileStat
GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
switchStat
GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
forStat
GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
doWhileStat
GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall a. JMParser a -> JMParser a
braces GenParser Char () [JStat]
statblock
GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
assignOpStat
GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
tryStat
GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
applStat
GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
breakStat
GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
continueStat
GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
antiStat
GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
antiStatSimple
GenParser Char () [JStat] -> [Char] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"statement"
where
declStat :: GenParser Char () [JStat]
declStat = do
[Char] -> JMParser ()
reserved [Char]
"var"
[JStat]
res <- [[JStat]] -> [JStat]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[JStat]] -> [JStat])
-> ParsecT [Char] () Identity [[JStat]]
-> GenParser Char () [JStat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenParser Char () [JStat] -> ParsecT [Char] () Identity [[JStat]]
forall a. JMParser a -> JMParser [a]
commaSep1 GenParser Char () [JStat]
destructuringDecl
[Char]
_ <- JMParser [Char]
semi
[JStat] -> GenParser Char () [JStat]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [JStat]
res
functionDecl :: GenParser Char () [JStat]
functionDecl = do
[Char] -> JMParser ()
reserved [Char]
"function"
(Ident
i,Maybe (Bool, JLocalType)
mbTyp) <- JMParser (Ident, Maybe (Bool, JLocalType))
varidentdecl
([Ident]
as,[JStat]
patDecls) <- ([Ident] -> ([Ident], [JStat]))
-> ParsecT [Char] () Identity [Ident]
-> JMParser ([Ident], [JStat])
forall a b.
(a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Ident]
x -> ([Ident]
x,[])) (ParsecT [Char] () Identity [Ident]
-> ParsecT [Char] () Identity [Ident]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] () Identity [Ident]
-> ParsecT [Char] () Identity [Ident])
-> ParsecT [Char] () Identity [Ident]
-> ParsecT [Char] () Identity [Ident]
forall a b. (a -> b) -> a -> b
$ ParsecT [Char] () Identity [Ident]
-> ParsecT [Char] () Identity [Ident]
forall a. JMParser a -> JMParser a
parens (JMParser Ident -> ParsecT [Char] () Identity [Ident]
forall a. JMParser a -> JMParser [a]
commaSep JMParser Ident
identdecl)) JMParser ([Ident], [JStat])
-> JMParser ([Ident], [JStat]) -> JMParser ([Ident], [JStat])
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' <- GenParser Char () JStat -> GenParser Char () JStat
forall tok st a. GenParser tok st a -> GenParser tok st a
try (JExpr -> JStat
ReturnStat (JExpr -> JStat)
-> GenParser Char () JExpr -> GenParser Char () JStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenParser Char () JExpr -> GenParser Char () JExpr
forall a. JMParser a -> JMParser a
braces GenParser Char () JExpr
expr) GenParser Char () JStat
-> GenParser Char () JStat -> GenParser Char () JStat
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([JStat] -> JStat
l2s ([JStat] -> JStat)
-> GenParser Char () [JStat] -> GenParser Char () JStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenParser Char () [JStat]
statement)
let b :: JStat
b = [JStat] -> JStat
BlockStat [JStat]
patDecls JStat -> JStat -> JStat
forall a. Monoid a => a -> a -> a
`mappend` JStat
b'
[JStat] -> GenParser Char () [JStat]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([JStat] -> GenParser Char () [JStat])
-> [JStat] -> GenParser Char () [JStat]
forall a b. (a -> b) -> a -> b
$ [Ident -> Maybe JLocalType -> JStat
DeclStat Ident
i (((Bool, JLocalType) -> JLocalType)
-> Maybe (Bool, JLocalType) -> Maybe JLocalType
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool, JLocalType) -> JLocalType
forall a b. (a, b) -> b
snd Maybe (Bool, JLocalType)
mbTyp),
JExpr -> JExpr -> JStat
AssignStat (JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
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 (JExpr -> JExpr) -> JExpr -> JExpr
forall a b. (a -> b) -> a -> b
$ JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ [Ident] -> JStat -> JVal
JFunc [Ident]
as JStat
b)]
funDecl :: GenParser Char () [JStat]
funDecl = do
[Char] -> JMParser ()
reserved [Char]
"fun"
Ident
n <- JMParser Ident
identdecl
Maybe (Bool, JLocalType)
mbTyp <- JMParser (Bool, JLocalType)
-> ParsecT [Char] () Identity (Maybe (Bool, JLocalType))
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' <- GenParser Char () JStat -> GenParser Char () JStat
forall tok st a. GenParser tok st a -> GenParser tok st a
try (JExpr -> JStat
ReturnStat (JExpr -> JStat)
-> GenParser Char () JExpr -> GenParser Char () JStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenParser Char () JExpr -> GenParser Char () JExpr
forall a. JMParser a -> JMParser a
braces GenParser Char () JExpr
expr) GenParser Char () JStat
-> GenParser Char () JStat -> GenParser Char () JStat
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([JStat] -> JStat
l2s ([JStat] -> JStat)
-> GenParser Char () [JStat] -> GenParser Char () JStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenParser Char () [JStat]
statement) GenParser Char () JStat
-> GenParser Char () JStat -> GenParser Char () JStat
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]
"->" JMParser [Char]
-> GenParser Char () JStat -> GenParser Char () JStat
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JExpr -> JStat
ReturnStat (JExpr -> JStat)
-> GenParser Char () JExpr -> GenParser Char () JStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenParser Char () JExpr
expr)
let b :: JStat
b = [JStat] -> JStat
BlockStat [JStat]
patDecls JStat -> JStat -> JStat
forall a. Monoid a => a -> a -> a
`mappend` JStat
b'
[JStat] -> GenParser Char () [JStat]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([JStat] -> GenParser Char () [JStat])
-> [JStat] -> GenParser Char () [JStat]
forall a b. (a -> b) -> a -> b
$ [Ident -> Maybe JLocalType -> JStat
DeclStat (Ident -> Ident
addBang Ident
n) (((Bool, JLocalType) -> JLocalType)
-> Maybe (Bool, JLocalType) -> Maybe JLocalType
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool, JLocalType) -> JLocalType
forall a b. (a, b) -> b
snd Maybe (Bool, JLocalType)
mbTyp),
JExpr -> JExpr -> JStat
AssignStat (JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ Ident -> JVal
JVar Ident
n) (Maybe (Bool, JLocalType) -> JExpr -> JExpr
addForcedType Maybe (Bool, JLocalType)
mbTyp (JExpr -> JExpr) -> JExpr -> JExpr
forall a b. (a -> b) -> a -> b
$ JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
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
'!'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
'!'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
x)
foreignStat :: GenParser Char () [JStat]
foreignStat = do
[Char] -> JMParser ()
reserved [Char]
"foreign"
Ident
i <- JMParser Ident -> JMParser Ident
forall tok st a. GenParser tok st a -> GenParser tok st a
try (JMParser Ident -> JMParser Ident)
-> JMParser Ident -> JMParser Ident
forall a b. (a -> b) -> a -> b
$ JMParser Ident
identdecl JMParser Ident -> JMParser () -> JMParser Ident
forall (m :: * -> *) b a. Monad m => m b -> m a -> m b
<<* [Char] -> JMParser ()
reservedOp [Char]
"::"
JLocalType
t <- CharParser () JLocalType
forall a. CharParser a JLocalType
runTypeParser
[JStat] -> GenParser Char () [JStat]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Ident -> JLocalType -> JStat
ForeignStat Ident
i JLocalType
t]
returnStat :: GenParser Char () [JStat]
returnStat =
[Char] -> JMParser ()
reserved [Char]
"return" JMParser ()
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (JStat -> [JStat] -> [JStat]
forall a. a -> [a] -> [a]
:[]) (JStat -> [JStat]) -> (JExpr -> JStat) -> JExpr -> [JStat]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JExpr -> JStat
ReturnStat (JExpr -> [JStat])
-> GenParser Char () JExpr -> GenParser Char () [JStat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JExpr -> GenParser Char () JExpr -> GenParser Char () JExpr
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 (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ Ident -> JVal
JVar (Ident -> JVal) -> Ident -> JVal
forall a b. (a -> b) -> a -> b
$ [Char] -> Ident
StrI [Char]
"undefined") GenParser Char () JExpr
expr
ifStat :: GenParser Char () [JStat]
ifStat = do
[Char] -> JMParser ()
reserved [Char]
"if"
JExpr
p <- GenParser Char () JExpr -> GenParser Char () JExpr
forall a. JMParser a -> JMParser a
parens GenParser Char () JExpr
expr
JStat
b <- [JStat] -> JStat
l2s ([JStat] -> JStat)
-> GenParser Char () [JStat] -> GenParser Char () JStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenParser Char () [JStat]
statementOrEmpty
Bool
isElse <- (JMParser () -> JMParser ()
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") JMParser ()
-> ParsecT [Char] () Identity Bool
-> ParsecT [Char] () Identity Bool
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT [Char] () Identity Bool
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
ParsecT [Char] () Identity Bool
-> ParsecT [Char] () Identity Bool
-> ParsecT [Char] () Identity Bool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Bool -> ParsecT [Char] () Identity Bool
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
if Bool
isElse
then do
[Char] -> JMParser ()
reserved [Char]
"else"
JStat -> [JStat]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (JStat -> [JStat]) -> ([JStat] -> JStat) -> [JStat] -> [JStat]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JExpr -> JStat -> JStat -> JStat
IfStat JExpr
p JStat
b (JStat -> JStat) -> ([JStat] -> JStat) -> [JStat] -> JStat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JStat] -> JStat
l2s ([JStat] -> [JStat])
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenParser Char () [JStat]
statementOrEmpty
else [JStat] -> GenParser Char () [JStat]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([JStat] -> GenParser Char () [JStat])
-> [JStat] -> GenParser Char () [JStat]
forall a b. (a -> b) -> a -> b
$ [JExpr -> JStat -> JStat -> JStat
IfStat JExpr
p JStat
b JStat
nullStat]
whileStat :: GenParser Char () [JStat]
whileStat =
[Char] -> JMParser ()
reserved [Char]
"while" JMParser ()
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (JExpr -> [JStat] -> [JStat])
-> GenParser Char () JExpr
-> GenParser Char () [JStat]
-> GenParser Char () [JStat]
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)])
(GenParser Char () JExpr -> GenParser Char () JExpr
forall a. JMParser a -> JMParser a
parens GenParser Char () JExpr
expr) GenParser Char () [JStat]
statementOrEmpty
doWhileStat :: GenParser Char () [JStat]
doWhileStat = [Char] -> JMParser ()
reserved [Char]
"do" JMParser ()
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([JStat] -> JExpr -> [JStat])
-> GenParser Char () [JStat]
-> GenParser Char () JExpr
-> GenParser Char () [JStat]
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)])
GenParser Char () [JStat]
statementOrEmpty ([Char] -> JMParser ()
reserved [Char]
"while" JMParser () -> GenParser Char () JExpr -> GenParser Char () JExpr
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> GenParser Char () JExpr -> GenParser Char () JExpr
forall a. JMParser a -> JMParser a
parens GenParser Char () JExpr
expr)
switchStat :: GenParser Char () [JStat]
switchStat = do
[Char] -> JMParser ()
reserved [Char]
"switch"
JExpr
e <- GenParser Char () JExpr -> GenParser Char () JExpr
forall a. JMParser a -> JMParser a
parens (GenParser Char () JExpr -> GenParser Char () JExpr)
-> GenParser Char () JExpr -> GenParser Char () JExpr
forall a b. (a -> b) -> a -> b
$ GenParser Char () JExpr
expr
([(JExpr, JStat)]
l,[JStat]
d) <- JMParser ([(JExpr, JStat)], [JStat])
-> JMParser ([(JExpr, JStat)], [JStat])
forall a. JMParser a -> JMParser a
braces (([(JExpr, JStat)] -> [JStat] -> ([(JExpr, JStat)], [JStat]))
-> ParsecT [Char] () Identity [(JExpr, JStat)]
-> GenParser Char () [JStat]
-> JMParser ([(JExpr, JStat)], [JStat])
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (ParsecT [Char] () Identity (JExpr, JStat)
-> ParsecT [Char] () Identity [(JExpr, JStat)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [Char] () Identity (JExpr, JStat)
caseStat) ([JStat] -> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option ([]) GenParser Char () [JStat]
dfltStat))
[JStat] -> GenParser Char () [JStat]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([JStat] -> GenParser Char () [JStat])
-> [JStat] -> GenParser Char () [JStat]
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" JMParser ()
-> ParsecT [Char] () Identity (JExpr, JStat)
-> ParsecT [Char] () Identity (JExpr, JStat)
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (JExpr -> JStat -> (JExpr, JStat))
-> GenParser Char () JExpr
-> GenParser Char () JStat
-> ParsecT [Char] () Identity (JExpr, JStat)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) GenParser Char () JExpr
expr (Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':' ParsecT [Char] () Identity Char
-> GenParser Char () JStat -> GenParser Char () JStat
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [JStat] -> JStat
l2s ([JStat] -> JStat)
-> GenParser Char () [JStat] -> GenParser Char () JStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenParser Char () [JStat]
statblock)
tryStat :: GenParser Char () [JStat]
tryStat = do
[Char] -> JMParser ()
reserved [Char]
"try"
[JStat]
s <- GenParser Char () [JStat]
statement
Bool
isCatch <- (JMParser () -> JMParser ()
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") JMParser ()
-> ParsecT [Char] () Identity Bool
-> ParsecT [Char] () Identity Bool
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT [Char] () Identity Bool
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
ParsecT [Char] () Identity Bool
-> ParsecT [Char] () Identity Bool
-> ParsecT [Char] () Identity Bool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Bool -> ParsecT [Char] () Identity Bool
forall a. a -> ParsecT [Char] () Identity 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"
(Ident -> [JStat] -> (Ident, [JStat]))
-> JMParser Ident
-> GenParser Char () [JStat]
-> ParsecT [Char] () Identity (Ident, [JStat])
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (JMParser Ident -> JMParser Ident
forall a. JMParser a -> JMParser a
parens JMParser Ident
identdecl) GenParser Char () [JStat]
statement
else (Ident, [JStat]) -> ParsecT [Char] () Identity (Ident, [JStat])
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Ident, [JStat]) -> ParsecT [Char] () Identity (Ident, [JStat]))
-> (Ident, [JStat]) -> ParsecT [Char] () Identity (Ident, [JStat])
forall a b. (a -> b) -> a -> b
$ ([Char] -> Ident
StrI [Char]
"", [])
Bool
isFinally <- (JMParser () -> JMParser ()
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") JMParser ()
-> ParsecT [Char] () Identity Bool
-> ParsecT [Char] () Identity Bool
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT [Char] () Identity Bool
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
ParsecT [Char] () Identity Bool
-> ParsecT [Char] () Identity Bool
-> ParsecT [Char] () Identity Bool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Bool -> ParsecT [Char] () Identity Bool
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
[JStat]
s2 <- if Bool
isFinally
then [Char] -> JMParser ()
reserved [Char]
"finally" JMParser ()
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Char () [JStat]
statement
else [JStat] -> GenParser Char () [JStat]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([JStat] -> GenParser Char () [JStat])
-> [JStat] -> GenParser Char () [JStat]
forall a b. (a -> b) -> a -> b
$ []
[JStat] -> GenParser Char () [JStat]
forall a. a -> ParsecT [Char] () Identity a
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 :: GenParser Char () [JStat]
dfltStat =
[Char] -> JMParser ()
reserved [Char]
"default" JMParser ()
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':' ParsecT [Char] () Identity Char -> JMParser () -> JMParser ()
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JMParser ()
whiteSpace JMParser ()
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Char () [JStat]
statblock
forStat :: GenParser Char () [JStat]
forStat =
[Char] -> JMParser ()
reserved [Char]
"for" JMParser ()
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (([Char] -> JMParser ()
reserved [Char]
"each" JMParser ()
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> GenParser Char () [JStat]
inBlock Bool
True)
GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (Bool -> GenParser Char () [JStat]
inBlock Bool
False)
GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
simpleForStat)
inBlock :: Bool -> GenParser Char () [JStat]
inBlock Bool
isEach = do
Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(' ParsecT [Char] () Identity Char -> JMParser () -> JMParser ()
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JMParser ()
whiteSpace JMParser () -> JMParser () -> JMParser ()
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JMParser () -> JMParser ()
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 <- GenParser Char () JExpr
expr
Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')' ParsecT [Char] () Identity Char -> JMParser () -> JMParser ()
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JMParser ()
whiteSpace
JStat
s <- [JStat] -> JStat
l2s ([JStat] -> JStat)
-> GenParser Char () [JStat] -> GenParser Char () JStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenParser Char () [JStat]
statement
[JStat] -> GenParser Char () [JStat]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([JStat] -> GenParser Char () [JStat])
-> [JStat] -> GenParser Char () [JStat]
forall a b. (a -> b) -> a -> b
$ [Bool -> Ident -> JExpr -> JStat -> JStat
ForInStat Bool
isEach Ident
i JExpr
e JStat
s]
simpleForStat :: GenParser Char () [JStat]
simpleForStat = do
([JStat]
before,Maybe JExpr
after,[JStat]
p) <- JMParser ([JStat], Maybe JExpr, [JStat])
-> JMParser ([JStat], Maybe JExpr, [JStat])
forall a. JMParser a -> JMParser a
parens JMParser ([JStat], Maybe JExpr, [JStat])
threeStat
[JStat]
b <- GenParser Char () [JStat]
statement
[JStat] -> GenParser Char () [JStat]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([JStat] -> GenParser Char () [JStat])
-> [JStat] -> GenParser Char () [JStat]
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 :: JMParser ([JStat], Maybe JExpr, [JStat])
threeStat =
([JStat]
-> Maybe JExpr -> [JStat] -> ([JStat], Maybe JExpr, [JStat]))
-> GenParser Char () [JStat]
-> ParsecT [Char] () Identity (Maybe JExpr)
-> GenParser Char () [JStat]
-> JMParser ([JStat], Maybe JExpr, [JStat])
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 (,,) ([JStat] -> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] GenParser Char () [JStat]
statement GenParser Char () [JStat]
-> JMParser () -> GenParser Char () [JStat]
forall (m :: * -> *) b a. Monad m => m b -> m a -> m b
<<* JMParser [Char] -> JMParser ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional JMParser [Char]
semi)
(GenParser Char () JExpr -> ParsecT [Char] () Identity (Maybe JExpr)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe GenParser Char () JExpr
expr ParsecT [Char] () Identity (Maybe JExpr)
-> JMParser [Char] -> ParsecT [Char] () Identity (Maybe JExpr)
forall (m :: * -> *) b a. Monad m => m b -> m a -> m b
<<* JMParser [Char]
semi)
([JStat] -> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] GenParser Char () [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 [JStat] -> [JStat] -> [JStat]
forall a. [a] -> [a] -> [a]
++ [Bool -> JExpr -> JStat -> JStat
WhileStat Bool
False (JExpr -> Maybe JExpr -> JExpr
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> JExpr
jsv [Char]
"true") Maybe JExpr
p) JStat
b']
where b' :: JStat
b' = [JStat] -> JStat
BlockStat ([JStat] -> JStat) -> [JStat] -> JStat
forall a b. (a -> b) -> a -> b
$ [JStat]
bs [JStat] -> [JStat] -> [JStat]
forall a. [a] -> [a] -> [a]
++ [JStat]
after
assignOpStat :: GenParser Char () [JStat]
assignOpStat = do
let rop :: [Char] -> JMParser [Char]
rop [Char]
x = [Char] -> JMParser ()
reservedOp [Char]
x JMParser () -> JMParser [Char] -> JMParser [Char]
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> JMParser [Char]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
x
(JExpr
e1,[Char]
op) <- GenParser Char () (JExpr, [Char])
-> GenParser Char () (JExpr, [Char])
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char () (JExpr, [Char])
-> GenParser Char () (JExpr, [Char]))
-> GenParser Char () (JExpr, [Char])
-> GenParser Char () (JExpr, [Char])
forall a b. (a -> b) -> a -> b
$ (JExpr -> [Char] -> (JExpr, [Char]))
-> GenParser Char () JExpr
-> JMParser [Char]
-> GenParser Char () (JExpr, [Char])
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) GenParser Char () JExpr
dotExpr (([Char] -> [Char]) -> JMParser [Char] -> JMParser [Char]
forall a b.
(a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
1) (JMParser [Char] -> JMParser [Char])
-> JMParser [Char] -> JMParser [Char]
forall a b. (a -> b) -> a -> b
$
[Char] -> JMParser [Char]
rop [Char]
"="
JMParser [Char] -> JMParser [Char] -> JMParser [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]
"+="
JMParser [Char] -> JMParser [Char] -> JMParser [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]
"-="
JMParser [Char] -> JMParser [Char] -> JMParser [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]
"*="
JMParser [Char] -> JMParser [Char] -> JMParser [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]
"/="
JMParser [Char] -> JMParser [Char] -> JMParser [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]
"%="
JMParser [Char] -> JMParser [Char] -> JMParser [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]
"<<="
JMParser [Char] -> JMParser [Char] -> JMParser [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]
">>="
JMParser [Char] -> JMParser [Char] -> JMParser [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]
">>>="
JMParser [Char] -> JMParser [Char] -> JMParser [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]
"&="
JMParser [Char] -> JMParser [Char] -> JMParser [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]
"^="
JMParser [Char] -> JMParser [Char] -> JMParser [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 = [Char] -> ParsecT [Char] () Identity a
forall a. [Char] -> ParsecT [Char] () Identity a
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 [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
badList then JMParser ()
forall {a}. ParsecT [Char] () Identity a
gofail else () -> JMParser ()
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ApplExpr JExpr
_ [JExpr]
_ -> JMParser ()
forall {a}. ParsecT [Char] () Identity a
gofail
ValExpr JVal
_ -> JMParser ()
forall {a}. ParsecT [Char] () Identity a
gofail
JExpr
_ -> () -> JMParser ()
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
JExpr
e2 <- GenParser Char () JExpr
expr
[JStat] -> GenParser Char () [JStat]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [JExpr -> JExpr -> JStat
AssignStat JExpr
e1 (if [Char]
op [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"=" then JExpr
e2 else [Char] -> JExpr -> JExpr -> JExpr
InfixExpr [Char]
op JExpr
e1 JExpr
e2)]
applStat :: GenParser Char () [JStat]
applStat = JExpr -> GenParser Char () [JStat]
forall {tok} {st}. JExpr -> GenParser tok st [JStat]
expr2stat' (JExpr -> GenParser Char () [JStat])
-> GenParser Char () JExpr -> GenParser Char () [JStat]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GenParser Char () JExpr
expr
expr2stat' :: JExpr -> GenParser tok st [JStat]
expr2stat' JExpr
e = case JExpr -> JStat
expr2stat JExpr
e of
BlockStat [] -> GenParser tok st [JStat]
forall tok st a. GenParser tok st a
pzero
JStat
x -> [JStat] -> GenParser tok st [JStat]
forall a. a -> ParsecT [tok] st Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [JStat
x]
breakStat :: GenParser Char () [JStat]
breakStat = do
[Char] -> JMParser ()
reserved [Char]
"break"
Maybe [Char]
l <- JMParser [Char] -> ParsecT [Char] () Identity (Maybe [Char])
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
[JStat] -> GenParser Char () [JStat]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Maybe [Char] -> JStat
BreakStat Maybe [Char]
l]
continueStat :: GenParser Char () [JStat]
continueStat = do
[Char] -> JMParser ()
reserved [Char]
"continue"
Maybe [Char]
l <- JMParser [Char] -> ParsecT [Char] () Identity (Maybe [Char])
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
[JStat] -> GenParser Char () [JStat]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Maybe [Char] -> JStat
ContinueStat Maybe [Char]
l]
labelStat :: GenParser Char () [JStat]
labelStat = do
[Char]
lbl <- JMParser [Char] -> JMParser [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (JMParser [Char] -> JMParser [Char])
-> JMParser [Char] -> JMParser [Char]
forall a b. (a -> b) -> a -> b
$ do
[Char]
l <- JMParser [Char]
myIdent JMParser [Char]
-> ParsecT [Char] () Identity Char -> JMParser [Char]
forall (m :: * -> *) b a. Monad m => m b -> m a -> m b
<<* Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
Bool -> JMParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([Char]
l [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
"default")
[Char] -> JMParser [Char]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
l
JStat
s <- [JStat] -> JStat
l2s ([JStat] -> JStat)
-> GenParser Char () [JStat] -> GenParser Char () JStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenParser Char () [JStat]
statblock0
[JStat] -> GenParser Char () [JStat]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char] -> JStat -> JStat
LabelStat [Char]
lbl JStat
s]
antiStat :: GenParser Char () [JStat]
antiStat = JStat -> [JStat]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (JStat -> [JStat]) -> ([Char] -> JStat) -> [Char] -> [JStat]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> JStat
AntiStat ([Char] -> [JStat]) -> JMParser [Char] -> GenParser Char () [JStat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
[Char]
x <- (JMParser [Char] -> JMParser [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> JMParser [Char]
symbol [Char]
"`(") JMParser [Char] -> JMParser [Char] -> JMParser [Char]
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT [Char] () Identity Char
-> JMParser [Char] -> JMParser [Char]
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` JMParser [Char] -> JMParser [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> JMParser [Char]
symbol [Char]
")`"))
([Char] -> JMParser [Char])
-> (Exp -> JMParser [Char]) -> Either [Char] Exp -> JMParser [Char]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> JMParser [Char]
forall a. [Char] -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> JMParser [Char])
-> ([Char] -> [Char]) -> [Char] -> JMParser [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"Bad AntiQuotation: \n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++))
(JMParser [Char] -> Exp -> JMParser [Char]
forall a b. a -> b -> a
const ([Char] -> JMParser [Char]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
x))
([Char] -> Either [Char] Exp
parseHSExp [Char]
x)
antiStatSimple :: GenParser Char () [JStat]
antiStatSimple = JStat -> [JStat]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (JStat -> [JStat]) -> ([Char] -> JStat) -> [Char] -> [JStat]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> JStat
AntiStat ([Char] -> [JStat]) -> JMParser [Char] -> GenParser Char () [JStat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
[Char]
x <- ([Char] -> JMParser [Char]
symbol [Char]
"`" JMParser [Char] -> JMParser [Char] -> JMParser [Char]
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT [Char] () Identity Char
-> JMParser [Char] -> JMParser [Char]
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]
"`")
([Char] -> JMParser [Char])
-> (Exp -> JMParser [Char]) -> Either [Char] Exp -> JMParser [Char]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> JMParser [Char]
forall a. [Char] -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> JMParser [Char])
-> ([Char] -> [Char]) -> [Char] -> JMParser [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"Bad AntiQuotation: \n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++))
(JMParser [Char] -> Exp -> JMParser [Char]
forall a b. a -> b -> a
const ([Char] -> JMParser [Char]
forall a. a -> ParsecT [Char] () Identity a
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 = IO (Either WrapError Regex) -> Either WrapError Regex
forall a. IO a -> a
unsafePerformIO (IO (Either WrapError Regex) -> Either WrapError Regex)
-> IO (Either WrapError Regex) -> Either WrapError Regex
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 :: GenParser Char () JExpr
expr = do
JExpr
e <- GenParser Char () JExpr
exprWithIf
JExpr -> GenParser Char () JExpr
addType JExpr
e
where
addType :: JExpr -> GenParser Char () JExpr
addType JExpr
e = do
Maybe (Bool, JLocalType)
optTyp <- JMParser (Bool, JLocalType)
-> ParsecT [Char] () Identity (Maybe (Bool, JLocalType))
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)) -> JExpr -> GenParser Char () JExpr
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (JExpr -> GenParser Char () JExpr)
-> JExpr -> GenParser Char () JExpr
forall a b. (a -> b) -> a -> b
$ Bool -> JExpr -> JLocalType -> JExpr
TypeExpr Bool
b JExpr
e JLocalType
t
Maybe (Bool, JLocalType)
Nothing -> JExpr -> GenParser Char () JExpr
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return JExpr
e
exprWithIf :: GenParser Char () JExpr
exprWithIf = do
JExpr
e <- GenParser Char () JExpr
rawExpr
JExpr -> GenParser Char () JExpr
addIf JExpr
e GenParser Char () JExpr
-> GenParser Char () JExpr -> GenParser Char () JExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> JExpr -> GenParser Char () JExpr
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return JExpr
e
addIf :: JExpr -> GenParser Char () JExpr
addIf JExpr
e = do
[Char] -> JMParser ()
reservedOp [Char]
"?"
JExpr
t <- GenParser Char () JExpr
exprWithIf
[Char]
_ <- JMParser [Char]
colon
JExpr
el <- GenParser Char () JExpr
exprWithIf
let ans :: JExpr
ans = (JExpr -> JExpr -> JExpr -> JExpr
IfExpr JExpr
e JExpr
t JExpr
el)
JExpr -> GenParser Char () JExpr
addIf JExpr
ans GenParser Char () JExpr
-> GenParser Char () JExpr -> GenParser Char () JExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> JExpr -> GenParser Char () JExpr
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return JExpr
ans
rawExpr :: GenParser Char () JExpr
rawExpr = OperatorTable Char () JExpr
-> GenParser Char () JExpr -> GenParser Char () JExpr
forall tok st a.
OperatorTable tok st a -> GenParser tok st a -> GenParser tok st a
buildExpressionParser OperatorTable Char () JExpr
table GenParser Char () JExpr
dotExpr GenParser Char () JExpr -> [Char] -> GenParser Char () JExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"expression"
table :: OperatorTable 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 = GenParser Char () (JExpr -> JExpr) -> Operator Char () JExpr
forall tok st a. GenParser tok st (a -> a) -> Operator tok st a
Prefix ([Char] -> JMParser ()
reservedOp [Char]
s JMParser ()
-> GenParser Char () (JExpr -> JExpr)
-> GenParser Char () (JExpr -> JExpr)
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (JExpr -> JExpr) -> GenParser Char () (JExpr -> JExpr)
forall a. a -> ParsecT [Char] () Identity a
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 = GenParser Char () (JExpr -> JExpr -> JExpr)
-> Assoc -> Operator Char () JExpr
forall tok st a.
GenParser tok st (a -> a -> a) -> Assoc -> Operator tok st a
Infix ([Char] -> JMParser ()
reservedOp [Char]
s JMParser ()
-> GenParser Char () (JExpr -> JExpr -> JExpr)
-> GenParser Char () (JExpr -> JExpr -> JExpr)
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (JExpr -> JExpr -> JExpr)
-> GenParser Char () (JExpr -> JExpr -> JExpr)
forall a. a -> ParsecT [Char] () Identity a
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 = GenParser Char () (JExpr -> JExpr -> JExpr)
-> Assoc -> Operator Char () JExpr
forall tok st a.
GenParser tok st (a -> a -> a) -> Assoc -> Operator tok st a
Infix ([Char] -> JMParser ()
reservedOp [Char]
s JMParser ()
-> GenParser Char () (JExpr -> JExpr -> JExpr)
-> GenParser Char () (JExpr -> JExpr -> JExpr)
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (JExpr -> JExpr -> JExpr)
-> GenParser Char () (JExpr -> JExpr -> JExpr)
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> JExpr -> JExpr -> JExpr
InfixExpr [Char]
s)) Assoc
AssocNone
applOp :: Operator Char () JExpr
applOp = GenParser Char () (JExpr -> JExpr -> JExpr)
-> Assoc -> Operator Char () JExpr
forall tok st a.
GenParser tok st (a -> a -> a) -> Assoc -> Operator tok st a
Infix ([Char] -> JMParser ()
reservedOp [Char]
"<|" JMParser ()
-> GenParser Char () (JExpr -> JExpr -> JExpr)
-> GenParser Char () (JExpr -> JExpr -> JExpr)
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (JExpr -> JExpr -> JExpr)
-> GenParser Char () (JExpr -> JExpr -> JExpr)
forall a. a -> ParsecT [Char] () Identity a
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 = GenParser Char () (JExpr -> JExpr -> JExpr)
-> Assoc -> Operator Char () JExpr
forall tok st a.
GenParser tok st (a -> a -> a) -> Assoc -> Operator tok st a
Infix ([Char] -> JMParser ()
reservedOp [Char]
"|>" JMParser ()
-> GenParser Char () (JExpr -> JExpr -> JExpr)
-> GenParser Char () (JExpr -> JExpr -> JExpr)
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (JExpr -> JExpr -> JExpr)
-> GenParser Char () (JExpr -> JExpr -> JExpr)
forall a. a -> ParsecT [Char] () Identity a
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 = GenParser Char () (JExpr -> JExpr -> JExpr)
-> Assoc -> Operator Char () JExpr
forall tok st a.
GenParser tok st (a -> a -> a) -> Assoc -> Operator tok st a
Infix ([Char] -> JMParser ()
reservedOp [Char]
":|" JMParser ()
-> GenParser Char () (JExpr -> JExpr -> JExpr)
-> GenParser Char () (JExpr -> JExpr -> JExpr)
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (JExpr -> JExpr -> JExpr)
-> GenParser Char () (JExpr -> JExpr -> JExpr)
forall a. a -> ParsecT [Char] () Identity a
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") Maybe JLocalType
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 = GenParser Char () (JExpr -> JExpr) -> Operator Char () JExpr
forall tok st a. GenParser tok st (a -> a) -> Operator tok st a
Prefix ([Char] -> JMParser ()
reservedOp [Char]
"-" JMParser ()
-> GenParser Char () (JExpr -> JExpr)
-> GenParser Char () (JExpr -> JExpr)
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (JExpr -> JExpr) -> GenParser Char () (JExpr -> JExpr)
forall a. a -> ParsecT [Char] () Identity a
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 :: GenParser Char () JExpr
dotExpr = do
[JExpr]
e <- GenParser Char () JExpr -> ParsecT [Char] () Identity [JExpr]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (GenParser Char () JExpr -> GenParser Char () JExpr
forall a. JMParser a -> JMParser a
lexeme GenParser Char () JExpr
dotExprOne) ParsecT [Char] () Identity [JExpr]
-> [Char] -> ParsecT [Char] () Identity [JExpr]
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'] -> JExpr -> GenParser Char () JExpr
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return JExpr
e'
(JExpr
e':[JExpr]
es) -> JExpr -> GenParser Char () JExpr
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (JExpr -> GenParser Char () JExpr)
-> JExpr -> GenParser Char () JExpr
forall a b. (a -> b) -> a -> b
$ JExpr -> [JExpr] -> JExpr
ApplExpr JExpr
e' [JExpr]
es
[JExpr]
_ -> [Char] -> GenParser Char () JExpr
forall a. HasCallStack => [Char] -> a
error [Char]
"exprApp"
dotExprOne :: JMParser JExpr
dotExprOne :: GenParser Char () JExpr
dotExprOne = JExpr -> GenParser Char () JExpr
addNxt (JExpr -> GenParser Char () JExpr)
-> GenParser Char () JExpr -> GenParser Char () JExpr
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GenParser Char () JExpr
valExpr GenParser Char () JExpr
-> GenParser Char () JExpr -> GenParser Char () JExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () JExpr
antiExpr GenParser Char () JExpr
-> GenParser Char () JExpr -> GenParser Char () JExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () JExpr
antiExprSimple GenParser Char () JExpr
-> GenParser Char () JExpr -> GenParser Char () JExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () JExpr -> GenParser Char () JExpr
forall a. JMParser a -> JMParser a
parens' GenParser Char () JExpr
expr GenParser Char () JExpr
-> GenParser Char () JExpr -> GenParser Char () JExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () JExpr
notExpr GenParser Char () JExpr
-> GenParser Char () JExpr -> GenParser Char () JExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () JExpr
newExpr
where
addNxt :: JExpr -> GenParser Char () JExpr
addNxt JExpr
e = do
Maybe Char
nxt <- (Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Maybe Char)
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity (Maybe Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] () Identity Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT [Char] () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT [Char] () Identity (Maybe Char)
-> ParsecT [Char] () Identity (Maybe Char)
-> ParsecT [Char] () Identity (Maybe Char)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Maybe Char -> ParsecT [Char] () Identity (Maybe Char)
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Char
forall a. Maybe a
Nothing)
case Maybe Char
nxt of
Just Char
'.' -> JExpr -> GenParser Char () JExpr
addNxt (JExpr -> GenParser Char () JExpr)
-> GenParser Char () JExpr -> GenParser Char () JExpr
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (JMParser [Char]
dot JMParser [Char]
-> GenParser Char () JExpr -> GenParser Char () JExpr
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (JExpr -> Ident -> JExpr
SelExpr JExpr
e (Ident -> JExpr) -> JMParser Ident -> GenParser Char () JExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JMParser Ident
ident' JMParser Ident -> JMParser Ident -> JMParser Ident
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> JMParser Ident
forall {u}. ParsecT [Char] u Identity Ident
numIdent)))
Just Char
'[' -> JExpr -> GenParser Char () JExpr
addNxt (JExpr -> GenParser Char () JExpr)
-> GenParser Char () JExpr -> GenParser Char () JExpr
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (JExpr -> JExpr -> JExpr
IdxExpr JExpr
e (JExpr -> JExpr)
-> GenParser Char () JExpr -> GenParser Char () JExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenParser Char () JExpr -> GenParser Char () JExpr
forall a. JMParser a -> JMParser a
brackets' GenParser Char () JExpr
expr)
Just Char
'(' -> JExpr -> GenParser Char () JExpr
addNxt (JExpr -> GenParser Char () JExpr)
-> GenParser Char () JExpr -> GenParser Char () JExpr
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (JExpr -> [JExpr] -> JExpr
ApplExpr JExpr
e ([JExpr] -> JExpr)
-> ParsecT [Char] () Identity [JExpr] -> GenParser Char () JExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] () Identity [JExpr]
-> ParsecT [Char] () Identity [JExpr]
forall a. JMParser a -> JMParser a
parens' (GenParser Char () JExpr -> ParsecT [Char] () Identity [JExpr]
forall a. JMParser a -> JMParser [a]
commaSep GenParser Char () JExpr
expr))
Just Char
'-' -> GenParser Char () JExpr -> GenParser Char () JExpr
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> JMParser ()
reservedOp [Char]
"--" JMParser () -> GenParser Char () JExpr -> GenParser Char () JExpr
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JExpr -> GenParser Char () JExpr
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> [Char] -> JExpr -> JExpr
PPostExpr Bool
False [Char]
"--" JExpr
e)) GenParser Char () JExpr
-> GenParser Char () JExpr -> GenParser Char () JExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> JExpr -> GenParser Char () JExpr
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return JExpr
e
Just Char
'+' -> GenParser Char () JExpr -> GenParser Char () JExpr
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> JMParser ()
reservedOp [Char]
"++" JMParser () -> GenParser Char () JExpr -> GenParser Char () JExpr
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JExpr -> GenParser Char () JExpr
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> [Char] -> JExpr -> JExpr
PPostExpr Bool
False [Char]
"++" JExpr
e)) GenParser Char () JExpr
-> GenParser Char () JExpr -> GenParser Char () JExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> JExpr -> GenParser Char () JExpr
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return JExpr
e
Maybe Char
_ -> JExpr -> GenParser Char () JExpr
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return JExpr
e
numIdent :: ParsecT [Char] u Identity Ident
numIdent = [Char] -> Ident
StrI ([Char] -> Ident)
-> ParsecT [Char] u Identity [Char]
-> ParsecT [Char] u Identity Ident
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Char] u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
notExpr :: GenParser Char () JExpr
notExpr = GenParser Char () JExpr -> GenParser Char () JExpr
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> JMParser [Char]
symbol [Char]
"!" JMParser [Char]
-> GenParser Char () JExpr -> GenParser Char () JExpr
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Char () JExpr
dotExpr) GenParser Char () JExpr
-> (JExpr -> GenParser Char () JExpr) -> GenParser Char () JExpr
forall a b.
ParsecT [Char] () Identity a
-> (a -> ParsecT [Char] () Identity b)
-> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \JExpr
e ->
JExpr -> GenParser Char () JExpr
forall a. a -> ParsecT [Char] () Identity a
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 :: GenParser Char () JExpr
newExpr = JExpr -> JExpr
NewExpr (JExpr -> JExpr)
-> GenParser Char () JExpr -> GenParser Char () JExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> JMParser ()
reserved [Char]
"new" JMParser () -> GenParser Char () JExpr -> GenParser Char () JExpr
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Char () JExpr
dotExpr)
antiExpr :: GenParser Char () JExpr
antiExpr = [Char] -> JExpr
AntiExpr ([Char] -> JExpr) -> JMParser [Char] -> GenParser Char () JExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
[Char]
x <- (JMParser [Char] -> JMParser [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> JMParser [Char]
symbol [Char]
"`(") JMParser [Char] -> JMParser [Char] -> JMParser [Char]
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT [Char] () Identity Char
-> JMParser [Char] -> JMParser [Char]
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` JMParser [Char] -> JMParser [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> JMParser [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
")`"))
([Char] -> JMParser [Char])
-> (Exp -> JMParser [Char]) -> Either [Char] Exp -> JMParser [Char]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> JMParser [Char]
forall a. [Char] -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> JMParser [Char])
-> ([Char] -> [Char]) -> [Char] -> JMParser [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"Bad AntiQuotation: \n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++))
(JMParser [Char] -> Exp -> JMParser [Char]
forall a b. a -> b -> a
const ([Char] -> JMParser [Char]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
x))
([Char] -> Either [Char] Exp
parseHSExp [Char]
x)
antiExprSimple :: GenParser Char () JExpr
antiExprSimple = [Char] -> JExpr
AntiExpr ([Char] -> JExpr) -> JMParser [Char] -> GenParser Char () JExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
[Char]
x <- ([Char] -> JMParser [Char]
symbol [Char]
"`" JMParser [Char] -> JMParser [Char] -> JMParser [Char]
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT [Char] () Identity Char
-> JMParser [Char] -> JMParser [Char]
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]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"`")
([Char] -> JMParser [Char])
-> (Exp -> JMParser [Char]) -> Either [Char] Exp -> JMParser [Char]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> JMParser [Char]
forall a. [Char] -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> JMParser [Char])
-> ([Char] -> [Char]) -> [Char] -> JMParser [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"Bad AntiQuotation: \n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++))
(JMParser [Char] -> Exp -> JMParser [Char]
forall a b. a -> b -> a
const ([Char] -> JMParser [Char]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
x))
([Char] -> Either [Char] Exp
parseHSExp [Char]
x)
valExpr :: GenParser Char () JExpr
valExpr = JVal -> JExpr
ValExpr (JVal -> JExpr)
-> ParsecT [Char] () Identity JVal -> GenParser Char () JExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT [Char] () Identity JVal
num ParsecT [Char] () Identity JVal
-> ParsecT [Char] () Identity JVal
-> ParsecT [Char] () Identity JVal
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 ParsecT [Char] () Identity JVal
-> ParsecT [Char] () Identity JVal
-> ParsecT [Char] () Identity JVal
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity JVal -> ParsecT [Char] () Identity JVal
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT [Char] () Identity JVal
regex ParsecT [Char] () Identity JVal
-> ParsecT [Char] () Identity JVal
-> ParsecT [Char] () Identity JVal
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 ParsecT [Char] () Identity JVal
-> ParsecT [Char] () Identity JVal
-> ParsecT [Char] () Identity JVal
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 ParsecT [Char] () Identity JVal
-> ParsecT [Char] () Identity JVal
-> ParsecT [Char] () Identity JVal
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 ParsecT [Char] () Identity JVal
-> ParsecT [Char] () Identity JVal
-> ParsecT [Char] () Identity JVal
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) GenParser Char () JExpr -> [Char] -> GenParser Char () JExpr
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 = (Integer -> JVal)
-> (SaneDouble -> JVal) -> Either Integer SaneDouble -> JVal
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Integer -> JVal
JInt SaneDouble -> JVal
JDouble (Either Integer SaneDouble -> JVal)
-> ParsecT [Char] () Identity (Either Integer SaneDouble)
-> ParsecT [Char] () Identity JVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] () Identity (Either Integer SaneDouble)
-> ParsecT [Char] () Identity (Either Integer SaneDouble)
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT [Char] () Identity (Either Integer SaneDouble)
forall a. Fractional a => JMParser (Either Integer a)
natFloat
str :: ParsecT [Char] () Identity JVal
str = [Char] -> JVal
JStr ([Char] -> JVal)
-> JMParser [Char] -> ParsecT [Char] () Identity JVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> JMParser [Char]
myStringLiteral Char
'"' JMParser [Char] -> JMParser [Char] -> JMParser [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
_ -> JVal -> ParsecT [Char] () Identity JVal
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> JVal
JRegEx [Char]
s)
Left WrapError
err -> [Char] -> ParsecT [Char] () Identity JVal
forall a. [Char] -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Parse error in regexp: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ WrapError -> [Char]
forall a. Show a => a -> [Char]
show WrapError
err)
list :: ParsecT [Char] () Identity JVal
list = [JExpr] -> JVal
JList ([JExpr] -> JVal)
-> ParsecT [Char] () Identity [JExpr]
-> ParsecT [Char] () Identity JVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] () Identity [JExpr]
-> ParsecT [Char] () Identity [JExpr]
forall a. JMParser a -> JMParser a
brackets' (GenParser Char () JExpr -> ParsecT [Char] () Identity [JExpr]
forall a. JMParser a -> JMParser [a]
commaSep GenParser Char () JExpr
expr)
hash :: ParsecT [Char] () Identity JVal
hash = Map [Char] JExpr -> JVal
JHash (Map [Char] JExpr -> JVal)
-> ([([Char], JExpr)] -> Map [Char] JExpr)
-> [([Char], JExpr)]
-> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([Char], JExpr)] -> Map [Char] JExpr
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([([Char], JExpr)] -> JVal)
-> ParsecT [Char] () Identity [([Char], JExpr)]
-> ParsecT [Char] () Identity JVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] () Identity [([Char], JExpr)]
-> ParsecT [Char] () Identity [([Char], JExpr)]
forall a. JMParser a -> JMParser a
braces' (JMParser ([Char], JExpr)
-> ParsecT [Char] () Identity [([Char], JExpr)]
forall a. JMParser a -> JMParser [a]
commaSep JMParser ([Char], JExpr)
propPair)
var :: ParsecT [Char] () Identity JVal
var = Ident -> JVal
JVar (Ident -> JVal)
-> JMParser Ident -> ParsecT [Char] () Identity JVal
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]
"\\" JMParser [Char] -> JMParser () -> JMParser ()
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> JMParser ()
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) JMParser () -> JMParser () -> JMParser ()
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) <- ([Ident] -> ([Ident], [JStat]))
-> ParsecT [Char] () Identity [Ident]
-> JMParser ([Ident], [JStat])
forall a b.
(a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Ident]
x -> ([Ident]
x,[])) (ParsecT [Char] () Identity [Ident]
-> ParsecT [Char] () Identity [Ident]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] () Identity [Ident]
-> ParsecT [Char] () Identity [Ident])
-> ParsecT [Char] () Identity [Ident]
-> ParsecT [Char] () Identity [Ident]
forall a b. (a -> b) -> a -> b
$ ParsecT [Char] () Identity [Ident]
-> ParsecT [Char] () Identity [Ident]
forall a. JMParser a -> JMParser a
parens (JMParser Ident -> ParsecT [Char] () Identity [Ident]
forall a. JMParser a -> JMParser [a]
commaSep JMParser Ident
identdecl)) JMParser ([Ident], [JStat])
-> JMParser ([Ident], [JStat]) -> JMParser ([Ident], [JStat])
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' <- (GenParser Char () JStat -> GenParser Char () JStat
forall a. JMParser a -> JMParser a
braces' GenParser Char () JStat
statOrEblock GenParser Char () JStat
-> GenParser Char () JStat -> GenParser Char () JStat
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]
"->" JMParser [Char]
-> GenParser Char () JStat -> GenParser Char () JStat
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (JExpr -> JStat
ReturnStat (JExpr -> JStat)
-> GenParser Char () JExpr -> GenParser Char () JStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenParser Char () JExpr
expr)))
JVal -> ParsecT [Char] () Identity JVal
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (JVal -> ParsecT [Char] () Identity JVal)
-> JVal -> ParsecT [Char] () Identity JVal
forall a b. (a -> b) -> a -> b
$ [Ident] -> JStat -> JVal
JFunc [Ident]
as ([JStat] -> JStat
BlockStat [JStat]
patDecls JStat -> JStat -> JStat
forall a. Monoid a => a -> a -> a
`mappend` JStat
b')
statOrEblock :: GenParser Char () JStat
statOrEblock = GenParser Char () JStat -> GenParser Char () JStat
forall tok st a. GenParser tok st a -> GenParser tok st a
try (JExpr -> JStat
ReturnStat (JExpr -> JStat)
-> GenParser Char () JExpr -> GenParser Char () JStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenParser Char () JExpr
expr GenParser Char () JExpr -> Char -> GenParser Char () JExpr
forall a. JMParser a -> Char -> JMParser a
`folBy` Char
'}') GenParser Char () JStat
-> GenParser Char () JStat -> GenParser Char () JStat
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([JStat] -> JStat
l2s ([JStat] -> JStat)
-> GenParser Char () [JStat] -> GenParser Char () JStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenParser Char () [JStat]
statblock)
propPair :: JMParser ([Char], JExpr)
propPair = ([Char] -> JExpr -> ([Char], JExpr))
-> JMParser [Char]
-> GenParser Char () JExpr
-> JMParser ([Char], JExpr)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) JMParser [Char]
myIdent (JMParser [Char]
colon JMParser [Char]
-> GenParser Char () JExpr -> GenParser Char () JExpr
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Char () 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 JMParser a -> JMParser () -> JMParser a
forall (m :: * -> *) b a. Monad m => m b -> m a -> m b
<<* (ParsecT [Char] () Identity Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
b) ParsecT [Char] () Identity Char
-> (Char -> JMParser ()) -> JMParser ()
forall a b.
ParsecT [Char] () Identity a
-> (a -> ParsecT [Char] () Identity b)
-> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JMParser () -> Char -> JMParser ()
forall a b. a -> b -> a
const (() -> JMParser ()
forall a. a -> ParsecT [Char] () Identity a
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' = Char -> Char -> JMParser a -> JMParser a
forall a. Char -> Char -> JMParser a -> JMParser a
around' Char
'[' Char
']'
braces' :: forall a. JMParser a -> JMParser a
braces' = Char -> Char -> JMParser a -> JMParser a
forall a. Char -> Char -> JMParser a -> JMParser a
around' Char
'{' Char
'}'
parens' :: forall a. JMParser a -> JMParser a
parens' = Char -> Char -> JMParser a -> JMParser a
forall a. Char -> Char -> JMParser a -> JMParser a
around' Char
'(' Char
')'
oxfordBraces :: forall a. JMParser a -> JMParser a
oxfordBraces JMParser a
x = JMParser () -> JMParser ()
forall a. JMParser a -> JMParser a
lexeme ([Char] -> JMParser ()
reservedOp [Char]
"{|") JMParser () -> JMParser a -> JMParser a
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (JMParser a -> JMParser a
forall a. JMParser a -> JMParser a
lexeme JMParser a
x JMParser a -> JMParser () -> JMParser a
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 = ParsecT [Char] () Identity Char -> ParsecT [Char] () Identity Char
forall a. JMParser a -> JMParser a
lexeme (Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
a) ParsecT [Char] () Identity Char -> JMParser a -> JMParser a
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (JMParser a -> JMParser a
forall a. JMParser a -> JMParser a
lexeme JMParser a
x JMParser a -> ParsecT [Char] () Identity Char -> JMParser a
forall (m :: * -> *) b a. Monad m => m b -> m a -> m b
<<* Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
b)
myIdent :: JMParser String
myIdent :: JMParser [Char]
myIdent = JMParser [Char] -> JMParser [Char]
forall a. JMParser a -> JMParser a
lexeme (JMParser [Char] -> JMParser [Char])
-> JMParser [Char] -> JMParser [Char]
forall a b. (a -> b) -> a -> b
$ ParsecT [Char] () Identity Char -> JMParser [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT [Char] () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"_-!@#$%^&*()") JMParser [Char] -> JMParser [Char] -> JMParser [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'
Bool -> JMParser () -> JMParser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
"jmId_" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
i) (JMParser () -> JMParser ()) -> JMParser () -> JMParser ()
forall a b. (a -> b) -> a -> b
$ [Char] -> JMParser ()
forall a. [Char] -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Illegal use of reserved jmId_ prefix in variable name."
Ident -> JMParser Ident
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Ident
StrI [Char]
i)
where
identifier' :: JMParser [Char]
identifier' =
JMParser [Char] -> JMParser [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (JMParser [Char] -> JMParser [Char])
-> JMParser [Char] -> JMParser [Char]
forall a b. (a -> b) -> a -> b
$
do{ [Char]
name <- JMParser [Char]
ident''
; if [Char] -> Bool
isReservedName [Char]
name
then [Char] -> JMParser [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
[Char] -> ParsecT s u m a
unexpected ([Char]
"reserved word " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
name)
else [Char] -> JMParser [Char]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
name
}
ident'' :: JMParser [Char]
ident''
= do{ Char
c <- GenLanguageDef [Char] () Identity
-> ParsecT [Char] () Identity Char
forall s u (m :: * -> *).
GenLanguageDef s u m -> ParsecT s u m Char
P.identStart GenLanguageDef [Char] () Identity
jsLang
; [Char]
cs <- ParsecT [Char] () Identity Char -> JMParser [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (GenLanguageDef [Char] () Identity
-> ParsecT [Char] () Identity Char
forall s u (m :: * -> *).
GenLanguageDef s u m -> ParsecT s u m Char
P.identLetter GenLanguageDef [Char] () Identity
jsLang)
; [Char] -> JMParser [Char]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
cs)
}
JMParser [Char] -> [Char] -> JMParser [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"identifier"
isReservedName :: [Char] -> Bool
isReservedName [Char]
name
= [[Char]] -> [Char] -> Bool
forall {a}. Ord a => [a] -> a -> Bool
isReserved [[Char]]
theReservedNames [Char]
caseName
where
caseName :: [Char]
caseName | GenLanguageDef [Char] () Identity -> Bool
forall s u (m :: * -> *). GenLanguageDef s u m -> Bool
P.caseSensitive GenLanguageDef [Char] () Identity
jsLang = [Char]
name
| Bool
otherwise = (Char -> Char) -> [Char] -> [Char]
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 (a -> a -> Ordering
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
| GenLanguageDef [Char] () Identity -> Bool
forall s u (m :: * -> *). GenLanguageDef s u m -> Bool
P.caseSensitive GenLanguageDef [Char] () Identity
jsLang = [[Char]]
sortedNames
| Bool
otherwise = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower) [[Char]]
sortedNames
where
sortedNames :: [[Char]]
sortedNames = [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
sort (GenLanguageDef [Char] () Identity -> [[Char]]
forall s u (m :: * -> *). GenLanguageDef s u m -> [[Char]]
P.reservedNames GenLanguageDef [Char] () Identity
jsLang)
natFloat :: Fractional a => JMParser (Either Integer a)
natFloat :: forall a. Fractional a => JMParser (Either Integer a)
natFloat = (Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'0' ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity (Either Integer a)
-> ParsecT [Char] () Identity (Either Integer a)
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] () Identity (Either Integer a)
zeroNumFloat)
ParsecT [Char] () Identity (Either Integer a)
-> ParsecT [Char] () Identity (Either Integer a)
-> ParsecT [Char] () Identity (Either Integer a)
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 ParsecT [Char] () Identity (Either Integer a)
-> [Char] -> ParsecT [Char] () Identity (Either Integer a)
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 = (Integer -> Either Integer a
forall a b. a -> Either a b
Left (Integer -> Either Integer a)
-> ParsecT [Char] () Identity Integer
-> ParsecT [Char] () Identity (Either Integer a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT [Char] () Identity Integer
forall {u}. ParsecT [Char] u Identity Integer
hexadecimal ParsecT [Char] () Identity Integer
-> ParsecT [Char] () Identity Integer
-> ParsecT [Char] () Identity Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity Integer
forall {u}. ParsecT [Char] u Identity Integer
octal))
ParsecT [Char] () Identity (Either Integer a)
-> ParsecT [Char] () Identity (Either Integer a)
-> ParsecT [Char] () Identity (Either Integer a)
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
ParsecT [Char] () Identity (Either Integer a)
-> ParsecT [Char] () Identity (Either Integer a)
-> ParsecT [Char] () Identity (Either Integer a)
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
ParsecT [Char] () Identity (Either Integer a)
-> ParsecT [Char] () Identity (Either Integer a)
-> ParsecT [Char] () Identity (Either Integer a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Either Integer a -> ParsecT [Char] () Identity (Either Integer a)
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Either Integer a
forall a b. a -> Either a b
Left Integer
0)
decimalFloat :: ParsecT [Char] () Identity (Either Integer a)
decimalFloat = do Integer
n <- ParsecT [Char] () Identity Integer
forall {u}. ParsecT [Char] u Identity Integer
decimal
Either Integer a
-> ParsecT [Char] () Identity (Either Integer a)
-> ParsecT [Char] () Identity (Either Integer a)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Integer -> Either Integer a
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 = a -> Either Integer a
forall a b. b -> Either a b
Right (a -> Either Integer a)
-> ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity (Either Integer a)
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 <- ParsecT [Char] () Identity a
forall {u}. ParsecT [Char] u Identity a
fraction
a
expo <- a -> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity a
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'
a -> ParsecT [Char] () Identity a
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
fract)a -> a -> a
forall a. Num a => a -> a -> a
*a
expo)
)
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity a
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
n a -> a -> a
forall a. Num a => a -> a -> a
*) (a -> a)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity 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 = Char -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' ParsecT [Char] u Identity Char
-> ParsecT [Char] u Identity a -> ParsecT [Char] u Identity a
forall a b.
ParsecT [Char] u Identity a
-> ParsecT [Char] u Identity b -> ParsecT [Char] u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((Char -> a -> a) -> a -> [Char] -> a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> a -> a
forall {a}. Fractional a => Char -> a -> a
op a
0.0 ([Char] -> a)
-> ParsecT [Char] u Identity [Char] -> ParsecT [Char] u Identity a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Char] u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT [Char] u Identity a
-> [Char] -> ParsecT [Char] u Identity a
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 a -> a -> a
forall a. Num a => a -> a -> a
+ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
digitToInt Char
d))a -> a -> a
forall a. Fractional a => a -> a -> a
/a
10.0
exponent' :: ParsecT [Char] () Identity a
exponent' = do Char
_ <- [Char] -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"eE"
Integer -> Integer
f <- ParsecT [Char] () Identity (Integer -> Integer)
forall {u}. ParsecT [Char] u Identity (Integer -> Integer)
sign
Integer -> a
forall {b} {a}. (Fractional a, Integral b) => b -> a
power (Integer -> a) -> (Integer -> Integer) -> Integer -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
f (Integer -> a)
-> ParsecT [Char] () Identity Integer
-> ParsecT [Char] () Identity a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Char] () Identity Integer
forall {u}. ParsecT [Char] u Identity Integer
decimal
where
power :: b -> a
power b
e | b
e b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
0 = a
1.0a -> a -> a
forall a. Fractional a => a -> a -> a
/b -> a
power(-b
e)
| Bool
otherwise = Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer
10Integer -> b -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^b
e)
sign :: ParsecT [Char] u Identity (Integer -> Integer)
sign = (Char -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT [Char] u Identity Char
-> ParsecT [Char] u Identity (Integer -> Integer)
-> ParsecT [Char] u Identity (Integer -> Integer)
forall a b.
ParsecT [Char] u Identity a
-> ParsecT [Char] u Identity b -> ParsecT [Char] u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Integer -> Integer)
-> ParsecT [Char] u Identity (Integer -> Integer)
forall a. a -> ParsecT [Char] u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer -> Integer
forall a. Num a => a -> a
negate)
ParsecT [Char] u Identity (Integer -> Integer)
-> ParsecT [Char] u Identity (Integer -> Integer)
-> ParsecT [Char] u Identity (Integer -> Integer)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+' ParsecT [Char] u Identity Char
-> ParsecT [Char] u Identity (Integer -> Integer)
-> ParsecT [Char] u Identity (Integer -> Integer)
forall a b.
ParsecT [Char] u Identity a
-> ParsecT [Char] u Identity b -> ParsecT [Char] u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Integer -> Integer)
-> ParsecT [Char] u Identity (Integer -> Integer)
forall a. a -> ParsecT [Char] u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer -> Integer
forall a. a -> a
id)
ParsecT [Char] u Identity (Integer -> Integer)
-> ParsecT [Char] u Identity (Integer -> Integer)
-> ParsecT [Char] u Identity (Integer -> Integer)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Integer -> Integer)
-> ParsecT [Char] u Identity (Integer -> Integer)
forall a. a -> ParsecT [Char] u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer -> Integer
forall a. a -> a
id
decimal :: ParsecT [Char] u Identity Integer
decimal = Integer
-> ParsecT [Char] u Identity Char
-> ParsecT [Char] u Identity Integer
forall {s} {m :: * -> *} {t} {u}.
Stream s m t =>
Integer -> ParsecT s u m Char -> ParsecT s u m Integer
number Integer
10 ParsecT [Char] u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
hexadecimal :: ParsecT [Char] u Identity Integer
hexadecimal = [Char] -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"xX" ParsecT [Char] u Identity Char
-> ParsecT [Char] u Identity Integer
-> ParsecT [Char] u Identity Integer
forall a b.
ParsecT [Char] u Identity a
-> ParsecT [Char] u Identity b -> ParsecT [Char] u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer
-> ParsecT [Char] u Identity Char
-> ParsecT [Char] u Identity Integer
forall {s} {m :: * -> *} {t} {u}.
Stream s m t =>
Integer -> ParsecT s u m Char -> ParsecT s u m Integer
number Integer
16 ParsecT [Char] u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
octal :: ParsecT [Char] u Identity Integer
octal = [Char] -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"oO" ParsecT [Char] u Identity Char
-> ParsecT [Char] u Identity Integer
-> ParsecT [Char] u Identity Integer
forall a b.
ParsecT [Char] u Identity a
-> ParsecT [Char] u Identity b -> ParsecT [Char] u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer
-> ParsecT [Char] u Identity Char
-> ParsecT [Char] u Identity Integer
forall {s} {m :: * -> *} {t} {u}.
Stream s m t =>
Integer -> ParsecT s u m Char -> ParsecT s u m Integer
number Integer
8 ParsecT [Char] u Identity Char
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 = (Integer -> Char -> Integer) -> Integer -> [Char] -> Integer
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Integer
x Char
d -> Integer
baseInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Char -> Int
digitToInt Char
d)) Integer
0 ([Char] -> Integer)
-> ParsecT s u m [Char] -> ParsecT s u m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m Char -> ParsecT s u m [Char]
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
_ <- Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
t
[Char]
x <- [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char])
-> ParsecT [Char] () Identity [[Char]] -> JMParser [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JMParser [Char] -> ParsecT [Char] () Identity [[Char]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many JMParser [Char]
myChar
Char
_ <- Char -> ParsecT [Char] () Identity 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 <- [Char] -> ParsecT [Char] () Identity Char
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 <- ParsecT [Char] () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
[Char] -> JMParser [Char]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c,Char
c2]
Char
_ -> [Char] -> JMParser [Char]
forall a. a -> ParsecT [Char] () Identity a
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 Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x20' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xff' -> [Char] -> [Char] -> JMParser [Char]
parseIt (Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
rs) [Char]
ds
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x20' -> [Char] -> JMParser [Char]
forall a. [Char] -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> JMParser [Char]) -> [Char] -> JMParser [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"Illegal unescaped character in string: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
x
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0x10ffff -> [Char] -> [Char] -> JMParser [Char]
parseIt (Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
rs) [Char]
ds
| Bool
otherwise -> [Char] -> JMParser [Char]
forall a. [Char] -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> JMParser [Char]) -> [Char] -> JMParser [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"Illegal unescaped character in string: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
x
where
i :: Integer
i = (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c) :: Integer)
[] -> [Char] -> JMParser [Char]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> JMParser [Char]) -> [Char] -> JMParser [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
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
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
rs) [Char]
cs
Char
'"' -> [Char] -> [Char] -> JMParser [Char]
parseIt (Char
'"' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
rs) [Char]
cs
Char
'n' -> [Char] -> [Char] -> JMParser [Char]
parseIt (Char
'\n' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
rs) [Char]
cs
Char
'r' -> [Char] -> [Char] -> JMParser [Char]
parseIt (Char
'\r' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
rs) [Char]
cs
Char
't' -> [Char] -> [Char] -> JMParser [Char]
parseIt (Char
'\t' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
rs) [Char]
cs
Char
'f' -> [Char] -> [Char] -> JMParser [Char]
parseIt (Char
'\f' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
rs) [Char]
cs
Char
'b' -> [Char] -> [Char] -> JMParser [Char]
parseIt (Char
'\b' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
rs) [Char]
cs
Char
'/' -> [Char] -> [Char] -> JMParser [Char]
parseIt (Char
'/' Char -> [Char] -> [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 ReadS Int
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 (Int -> Char
forall a. Enum a => Int -> a
toEnum Int
n Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
rs) [Char]
cs'
[(Int, [Char])]
badHex -> [Char] -> JMParser [Char]
forall a. [Char] -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> JMParser [Char]) -> [Char] -> JMParser [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"Unable to parse JSON String: invalid hex: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [(Int, [Char])] -> [Char]
forall a. Show a => a -> [Char]
show [(Int, [Char])]
badHex
[Char]
_ -> [Char] -> JMParser [Char]
forall a. [Char] -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> JMParser [Char]) -> [Char] -> JMParser [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"Unable to parse JSON String: invalid hex: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cs
Char
_ -> [Char] -> JMParser [Char]
forall a. [Char] -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> JMParser [Char]) -> [Char] -> JMParser [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"Unable to parse JSON String: invalid escape char: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
c]
regexLiteral :: JMParser String
regexLiteral :: JMParser [Char]
regexLiteral = do
Char
_ <- Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/'
[Char]
x <- [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char])
-> ParsecT [Char] () Identity [[Char]] -> JMParser [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JMParser [Char] -> ParsecT [Char] () Identity [[Char]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many JMParser [Char]
forall {u}. ParsecT [Char] u Identity [Char]
myChar
Char
_ <- Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/'
Bool
b <- Bool
-> ParsecT [Char] () Identity Bool
-> ParsecT [Char] () Identity Bool
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 -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/' ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Bool
-> ParsecT [Char] () Identity Bool
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT [Char] () Identity Bool
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
if Bool
b
then JMParser [Char]
forall {a}. ParsecT [Char] () Identity a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
else [Char] -> JMParser [Char]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
x
where myChar :: ParsecT [Char] u Identity [Char]
myChar = do
Char
c <- [Char] -> ParsecT [Char] u Identity Char
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 <- ParsecT [Char] u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
[Char] -> ParsecT [Char] u Identity [Char]
forall a. a -> ParsecT [Char] u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c,Char
c2]
Char
_ -> [Char] -> ParsecT [Char] u Identity [Char]
forall a. a -> ParsecT [Char] u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c]