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

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

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

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

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

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

import Text.Regex.Posix.String

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

import System.IO.Unsafe
import Numeric(readHex)

-- import Debug.Trace

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

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

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

quoteJMPat :: String -> TH.PatQ
quoteJMPat :: String -> Q Pat
quoteJMPat String
s = case String -> Either ParseError JStat
parseJM String
s of
               Right JStat
x -> (forall b. Data b => b -> Maybe (Q Pat)) -> JStat -> Q Pat
forall a.
Data a =>
(forall b. Data b => b -> Maybe (Q Pat)) -> a -> Q 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 -> String -> Q Pat
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (ParseError -> String
forall a. Show a => a -> String
show ParseError
err)

quoteJMExp :: String -> TH.ExpQ
quoteJMExp :: String -> Q Exp
quoteJMExp String
s = case String -> Either ParseError JStat
parseJM String
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
                   String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (ParseError -> String
forall a. Show a => a -> String
show (ParseError -> String) -> ParseError -> String
forall a b. (a -> b) -> a -> b
$ SourcePos -> ParseError -> ParseError
setErrorPos SourcePos
newPos ParseError
err)

quoteJMPatE :: String -> TH.PatQ
quoteJMPatE :: String -> Q Pat
quoteJMPatE String
s = case String -> Either ParseError JExpr
parseJME String
s of
               Right JExpr
x -> (forall b. Data b => b -> Maybe (Q Pat)) -> JExpr -> Q Pat
forall a.
Data a =>
(forall b. Data b => b -> Maybe (Q Pat)) -> a -> Q 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 -> String -> Q Pat
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (ParseError -> String
forall a. Show a => a -> String
show ParseError
err)

quoteJMExpE :: String -> TH.ExpQ
quoteJMExpE :: String -> Q Exp
quoteJMExpE String
s = case String -> Either ParseError JExpr
parseJME String
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
                   String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (ParseError -> String
forall a. Show a => a -> String
show (ParseError -> String) -> ParseError -> String
forall a b. (a -> b) -> a -> b
$ SourcePos -> ParseError -> ParseError
setErrorPos SourcePos
newPos ParseError
err)


-- | Traverse a syntax tree, replace an identifier by an
-- antiquotation of a free variable.
-- Don't replace identifiers on the right hand side of selector
-- expressions.
antiIdent :: JMacro a => String -> a -> a
antiIdent :: String -> a -> a
antiIdent String
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 :: JMGadt a -> JMGadt a
go (JMGExpr (ValExpr (JVar (StrI String
s'))))
             | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
s' = JExpr -> JMGadt JExpr
JMGExpr (String -> JExpr
AntiExpr (String -> JExpr) -> String -> JExpr
forall a b. (a -> b) -> a -> b
$ String -> String
fixIdent String
s)
          go (JMGExpr (SelExpr JExpr
x Ident
i)) =
              JExpr -> JMGadt JExpr
JMGExpr (JExpr -> Ident -> JExpr
SelExpr (String -> JExpr -> JExpr
forall a. JMacro a => String -> a -> a
antiIdent String
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 forall a. JMGadt a -> JMGadt a
go JMGadt a
x

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

fixIdent :: String -> String
fixIdent :: String -> String
fixIdent String
"_" = String
"_x_"
fixIdent css :: String
css@(Char
c:String
_)
    | Char -> Bool
isUpper Char
c = Char
'_' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
escapeDollar String
css
    | Bool
otherwise = String -> String
escapeDollar String
css
  where
    escapeDollar :: String -> String
escapeDollar = (Char -> Char) -> String -> String
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 String
_ = String
"_x_"


jm2th :: Data a => a -> TH.ExpQ
jm2th :: a -> Q Exp
jm2th a
v = (forall b. Data b => b -> Maybe (Q Exp)) -> a -> Q Exp
forall a.
Data a =>
(forall b. Data b => b -> Maybe (Q Exp)) -> a -> Q 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 q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` JStat -> Maybe (Q Exp)
handleStat
                      (b -> Maybe (Q Exp))
-> (JExpr -> Maybe (Q Exp)) -> b -> Maybe (Q Exp)
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` JExpr -> Maybe (Q Exp)
handleExpr
                      (b -> Maybe (Q Exp))
-> (JVal -> Maybe (Q Exp)) -> b -> Maybe (Q Exp)
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` JVal -> Maybe (Q Exp)
handleVal
                      (b -> Maybe (Q Exp))
-> (String -> Maybe (Q Exp)) -> b -> Maybe (Q Exp)
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` String -> Maybe (Q Exp)
handleStr
                      (b -> Maybe (Q Exp))
-> (JType -> Maybe (Q Exp)) -> b -> Maybe (Q Exp)
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` JType -> Maybe (Q Exp)
handleTyp
                     ) a
v

    where handleStat :: JStat -> Maybe (TH.ExpQ)
          handleStat :: JStat -> Maybe (Q Exp)
handleStat (BlockStat [JStat]
ss) = 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
$
                                      String -> Q Exp -> Q Exp
appConstr String
"BlockStat" (Q Exp -> Q Exp) -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$
                                      [Q Exp] -> Q Exp
TH.listE ([JStat] -> [Q Exp]
blocks [JStat]
ss)
              where blocks :: [JStat] -> [TH.ExpQ]
                    blocks :: [JStat] -> [Q Exp]
blocks [] = []
                    blocks (DeclStat (StrI String
i) Maybe JLocalType
t:[JStat]
xs) = case String
i of
                     (Char
'!':Char
'!':String
i') -> JStat -> Q Exp
forall a. Data a => a -> Q Exp
jm2th (Ident -> Maybe JLocalType -> JStat
DeclStat (String -> Ident
StrI String
i') Maybe JLocalType
t) Q Exp -> [Q Exp] -> [Q Exp]
forall a. a -> [a] -> [a]
: [JStat] -> [Q Exp]
blocks [JStat]
xs
                     (Char
'!':String
i') ->
                        [Q Exp -> Q Exp -> Q Exp
TH.appE ([Q Pat] -> Q Exp -> Q Exp
TH.lamE [Name -> Q Pat
TH.varP (Name -> Q Pat) -> (String -> Name) -> String -> Q Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
mkName (String -> Name) -> (String -> String) -> String -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
fixIdent (String -> Q Pat) -> String -> Q Pat
forall a b. (a -> b) -> a -> b
$ String
i'] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$
                                 String -> Q Exp -> Q Exp
appConstr String
"BlockStat"
                                 ([Q Exp] -> Q 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
TH.appE (Name -> Q Exp
TH.varE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"jsv")
                                                                            (Lit -> Q Exp
TH.litE (Lit -> Q Exp) -> Lit -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> Lit
TH.StringL String
i'))]
                        where ds :: Q Exp
ds =
                                  Q Exp -> Q Exp -> Q Exp
TH.appE
                                        (Q Exp -> Q Exp -> Q Exp
TH.appE (Name -> Q Exp
TH.conE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"DeclStat")
                                               (Q Exp -> Q Exp -> Q Exp
TH.appE (Name -> Q Exp
TH.conE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"StrI")
                                                      (Lit -> Q Exp
TH.litE (Lit -> Q Exp) -> Lit -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> Lit
TH.StringL String
i')))
                                        (Maybe JLocalType -> Q Exp
forall a. Data a => a -> Q Exp
jm2th Maybe JLocalType
t)
                     String
_ ->
                        [Q Exp -> Q Exp -> Q Exp
TH.appE
                           (Q Exp -> Q Exp -> Q Exp
TH.appE (Name -> Q Exp
TH.varE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"jVarTy")
                                  ([Q Pat] -> Q Exp -> Q Exp
TH.lamE [Name -> Q Pat
TH.varP (Name -> Q Pat) -> (String -> Name) -> String -> Q Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
mkName (String -> Name) -> (String -> String) -> String -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
fixIdent (String -> Q Pat) -> String -> Q Pat
forall a b. (a -> b) -> a -> b
$ String
i] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$
                                     String -> Q Exp -> Q Exp
appConstr String
"BlockStat"
                                     ([Q Exp] -> Q 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 (String -> JStat -> JStat
forall a. JMacro a => String -> a -> a
antiIdent String
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 String
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 :: * -> *). Foldable t => Q Exp -> t (Q Exp) -> Q Exp
appFun (Name -> Q 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
TH.lamE [Name -> Q Pat
TH.varP (Name -> Q Pat) -> Name -> Q Pat
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
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
$ String -> JStat -> JStat
forall a. JMacro a => String -> a -> a
antiIdent String
i JStat
s)
                         ]
              where forFunc :: Name
forFunc
                        | Bool
b = String -> Name
mkName String
"jForEachIn"
                        | Bool
otherwise = String -> Name
mkName String
"jForIn"

          handleStat (TryStat JStat
s (StrI String
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 :: * -> *). Foldable t => Q Exp -> t (Q Exp) -> Q Exp
appFun (Name -> Q Exp
TH.varE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"jTryCatchFinally")
                        [JStat -> Q Exp
forall a. Data a => a -> Q Exp
jm2th JStat
s,
                         [Q Pat] -> Q Exp -> Q Exp
TH.lamE [Name -> Q Pat
TH.varP (Name -> Q Pat) -> Name -> Q Pat
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
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
$ String -> JStat -> JStat
forall a. JMacro a => String -> a -> a
antiIdent String
i JStat
s1),
                         JStat -> Q Exp
forall a. Data a => a -> Q Exp
jm2th JStat
s2
                         ]

          handleStat (AntiStat String
s) = case String -> Either String Exp
parseHSExp String
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
TH.appE (Name -> Q Exp
TH.varE (String -> Name
mkName String
"toStat"))
                                                                  (Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
ans)
                                      Left String
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
$ String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err

          handleStat JStat
_ = Maybe (Q Exp)
forall a. Maybe a
Nothing

          handleExpr :: JExpr -> Maybe (TH.ExpQ)
          handleExpr :: JExpr -> Maybe (Q Exp)
handleExpr (AntiExpr String
s) = case String -> Either String Exp
parseHSExp String
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
TH.appE (Name -> Q Exp
TH.varE (String -> Name
mkName String
"toJExpr")) (Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
ans)
                                      Left String
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
$ String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
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
TH.appE (Name -> Q Exp
TH.varE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"jLam")
                      ([Q Pat] -> Q Exp -> Q Exp
TH.lamE ((String -> Q Pat) -> [String] -> [Q Pat]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> Q Pat
TH.varP (Name -> Q Pat) -> (String -> Name) -> String -> Q Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
mkName (String -> Name) -> (String -> String) -> String -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
fixIdent) [String]
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
$ [String] -> JStat -> JStat
forall a. JMacro a => [String] -> a -> a
antiIdents [String]
is JStat
s))
            where is :: [String]
is = (Ident -> String) -> [Ident] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(StrI String
i) -> String
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 String 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
TH.appE (Name -> Q Exp
TH.varE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"jhFromList") (Q Exp -> Q Exp) -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$
                                [(String, JExpr)] -> Q Exp
forall a. Data a => a -> Q Exp
jm2th (Map String JExpr -> [(String, JExpr)]
forall k a. Map k a -> [(k, a)]
M.toList Map String JExpr
m)
          handleVal JVal
_ = Maybe (Q Exp)
forall a. Maybe a
Nothing

          handleStr :: String -> Maybe (TH.ExpQ)
          handleStr :: String -> Maybe (Q Exp)
handleStr String
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
TH.litE (Lit -> Q Exp) -> Lit -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> Lit
TH.StringL String
x

          handleTyp :: JType -> Maybe (TH.ExpQ)
          handleTyp :: JType -> Maybe (Q Exp)
handleTyp (JTRecord JType
t Map String 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
TH.appE (Q Exp -> Q Exp -> Q Exp
TH.appE (Name -> Q Exp
TH.varE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"jtFromList") (JType -> Q Exp
forall a. Data a => a -> Q Exp
jm2th JType
t))
                                          ([(String, JType)] -> Q Exp
forall a. Data a => a -> Q Exp
jm2th ([(String, JType)] -> Q Exp) -> [(String, JType)] -> Q Exp
forall a b. (a -> b) -> a -> b
$ Map String JType -> [(String, JType)]
forall k a. Map k a -> [(k, a)]
M.toList Map String JType
mp)

          handleTyp JType
_ = Maybe (Q Exp)
forall a. Maybe a
Nothing

          appFun :: Q Exp -> t (Q Exp) -> Q Exp
appFun Q Exp
x = (Q Exp -> Q Exp -> Q Exp) -> Q Exp -> t (Q Exp) -> Q Exp
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Q Exp -> Q Exp -> Q Exp
TH.appE) Q Exp
x
          appConstr :: String -> Q Exp -> Q Exp
appConstr String
n = Q Exp -> Q Exp -> Q Exp
TH.appE (Name -> Q Exp
TH.conE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
n)


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

type JMParser a =  CharParser () a

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

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

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

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

whiteSpace :: JMParser ()
whiteSpace= TokenParser () -> JMParser ()
forall s u (m :: * -> *). GenTokenParser s u m -> ParsecT s u m ()
P.whiteSpace TokenParser ()
lexer
symbol :: String -> JMParser String
symbol    = TokenParser () -> String -> JMParser String
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m String
P.symbol TokenParser ()
lexer
parens :: JMParser a -> JMParser a
parens    = TokenParser ()
-> forall a.
   ParsecT String () Identity a -> ParsecT String () Identity 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 :: JMParser a -> JMParser a
braces    = TokenParser ()
-> forall a.
   ParsecT String () Identity a -> ParsecT String () Identity 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
-- brackets  = P.brackets lexer
dot :: JMParser String
dot       = TokenParser () -> JMParser String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
P.dot TokenParser ()
lexer
colon :: JMParser String
colon     = TokenParser () -> JMParser String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
P.colon TokenParser ()
lexer
semi :: JMParser String
semi      = TokenParser () -> JMParser String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
P.semi TokenParser ()
lexer
identifier :: JMParser String
identifier= TokenParser () -> JMParser String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
P.identifier TokenParser ()
lexer
reserved :: String -> JMParser ()
reserved  = TokenParser () -> String -> JMParser ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reserved TokenParser ()
lexer
reservedOp :: String -> JMParser ()
reservedOp= TokenParser () -> String -> JMParser ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reservedOp TokenParser ()
lexer
commaSep1 :: JMParser a -> JMParser [a]
commaSep1 = TokenParser ()
-> forall a.
   ParsecT String () Identity a -> ParsecT String () Identity [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 :: JMParser a -> JMParser [a]
commaSep  = TokenParser ()
-> forall a.
   ParsecT String () Identity a -> ParsecT String () Identity [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 :: JMParser a -> JMParser a
lexeme    = TokenParser ()
-> forall a.
   ParsecT String () Identity a -> ParsecT String () Identity 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 <<* :: m b -> m a -> m b
<<* m a
y = do
  b
xr <- m b
x
  a
_ <- m a
y
  b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
xr

parseJM :: String -> Either ParseError JStat
parseJM :: String -> Either ParseError JStat
parseJM String
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]
-> () -> String -> String -> Either ParseError [JStat]
forall tok st a.
GenParser tok st a -> st -> String -> [tok] -> Either ParseError a
runParser GenParser Char () [JStat]
jmacroParser () String
"" String
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 (m :: * -> *) a. Monad m => a -> m a
return [JStat]
ans

parseJME :: String -> Either ParseError JExpr
parseJME :: String -> Either ParseError JExpr
parseJME String
s = GenParser Char () JExpr
-> () -> String -> String -> Either ParseError JExpr
forall tok st a.
GenParser tok st a -> st -> String -> [tok] -> Either ParseError a
runParser GenParser Char () JExpr
jmacroParserE () String
"" String
s
    where jmacroParserE :: GenParser Char () JExpr
jmacroParserE = do
            JExpr
ans <- JMParser ()
whiteSpace JMParser () -> GenParser Char () JExpr -> GenParser Char () JExpr
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 (m :: * -> *) a. Monad m => a -> m a
return JExpr
ans

getType :: JMParser (Bool, JLocalType)
getType :: JMParser (Bool, JLocalType)
getType = do
  Bool
isForce <- (String -> JMParser ()
reservedOp String
"::!" JMParser ()
-> ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT String () Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> JMParser ()
reservedOp String
"::" JMParser ()
-> ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT String () Identity Bool
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 (m :: * -> *) a. Monad m => a -> m a
return (Bool
isForce, JLocalType
t)

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

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

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

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

-- Handle varident decls for type annotations?
-- Patterns
data PatternTree = PTAs Ident PatternTree
                 | PTCons PatternTree PatternTree
                 | PTList [PatternTree]
                 | PTObj [(String,PatternTree)]
                 | PTVar Ident
                   deriving Int -> PatternTree -> String -> String
[PatternTree] -> String -> String
PatternTree -> String
(Int -> PatternTree -> String -> String)
-> (PatternTree -> String)
-> ([PatternTree] -> String -> String)
-> Show PatternTree
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PatternTree] -> String -> String
$cshowList :: [PatternTree] -> String -> String
show :: PatternTree -> String
$cshow :: PatternTree -> String
showsPrec :: Int -> PatternTree -> String -> String
$cshowsPrec :: Int -> PatternTree -> String -> String
Show
patternTree :: JMParser PatternTree
patternTree :: JMParser PatternTree
patternTree = [PatternTree] -> PatternTree
toCons ([PatternTree] -> PatternTree)
-> ParsecT String () Identity [PatternTree] -> JMParser PatternTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JMParser PatternTree -> JMParser PatternTree
forall a.
ParsecT String () Identity a -> ParsecT String () Identity 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 String () 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` String -> JMParser ()
reservedOp String
":|"
    where
      toCons :: [PatternTree] -> PatternTree
toCons [] = Ident -> PatternTree
PTVar (String -> Ident
StrI String
"_")
      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.
ParsecT String () Identity a -> ParsecT String () Identity a
lexeme (JMParser PatternTree -> JMParser PatternTree)
-> JMParser PatternTree -> JMParser PatternTree
forall a b. (a -> b) -> a -> b
$ [PatternTree] -> PatternTree
PTList ([PatternTree] -> PatternTree)
-> ParsecT String () Identity [PatternTree] -> JMParser PatternTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity [PatternTree]
-> ParsecT String () Identity [PatternTree]
forall a.
ParsecT String () Identity a -> ParsecT String () Identity a
brackets' (JMParser PatternTree -> ParsecT String () Identity [PatternTree]
forall a.
ParsecT String () Identity a -> ParsecT String () Identity [a]
commaSep JMParser PatternTree
patternTree)
      ptObj :: JMParser PatternTree
ptObj   = JMParser PatternTree -> JMParser PatternTree
forall a.
ParsecT String () Identity a -> ParsecT String () Identity a
lexeme (JMParser PatternTree -> JMParser PatternTree)
-> JMParser PatternTree -> JMParser PatternTree
forall a b. (a -> b) -> a -> b
$ [(String, PatternTree)] -> PatternTree
PTObj  ([(String, PatternTree)] -> PatternTree)
-> ParsecT String () Identity [(String, PatternTree)]
-> JMParser PatternTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity [(String, PatternTree)]
-> ParsecT String () Identity [(String, PatternTree)]
forall a.
ParsecT String () Identity a -> ParsecT String () Identity a
oxfordBraces (JMParser (String, PatternTree)
-> ParsecT String () Identity [(String, PatternTree)]
forall a.
ParsecT String () Identity a -> ParsecT String () Identity [a]
commaSep (JMParser (String, PatternTree)
 -> ParsecT String () Identity [(String, PatternTree)])
-> JMParser (String, PatternTree)
-> ParsecT String () Identity [(String, PatternTree)]
forall a b. (a -> b) -> a -> b
$ (String -> PatternTree -> (String, PatternTree))
-> JMParser String
-> JMParser PatternTree
-> JMParser (String, PatternTree)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) JMParser String
myIdent (JMParser String
colon JMParser String -> JMParser PatternTree -> JMParser PatternTree
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 String () Identity Bool
-> ParsecT String () 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 (String -> JMParser ()
reservedOp String
"@" JMParser ()
-> ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT String () Identity Bool
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 (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

--either we have a function from any ident to the constituent parts
--OR the top level is named, and hence we have the top ident, plus decls for the constituent parts
patternBinding :: JMParser (Either (Ident -> [JStat]) (Ident,[JStat]))
patternBinding :: JMParser (Either (Ident -> [JStat]) (Ident, [JStat]))
patternBinding = do
  PatternTree
ptree <- JMParser PatternTree
patternTree
  let go :: JExpr -> PatternTree -> [JStat]
go JExpr
path (PTAs Ident
asIdent PatternTree
pt) = [Ident -> Maybe JLocalType -> JStat
DeclStat Ident
asIdent 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
== (String -> Ident
StrI String
"_") = []
          | 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 [(String, 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
$ ((String, PatternTree) -> (JExpr, PatternTree))
-> [(String, PatternTree)] -> [(JExpr, PatternTree)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> JExpr) -> (String, PatternTree) -> (JExpr, PatternTree)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first String -> JExpr
fixPath) [(String, PatternTree)]
xs
           where fixPath :: String -> JExpr
fixPath String
lbl = JExpr -> JExpr -> JExpr
IdxExpr JExpr
path (JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ String -> JVal
JStr String
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 (String -> Ident
StrI String
"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 (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 (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 (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 (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 (String -> Ident
StrI (String -> Ident) -> (Int -> String) -> Int -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"jmId_match_" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) [(Int
1::Int)..]) ([Either (Ident -> [JStat]) (Ident, [JStat])]
 -> ([Ident], [JStat]))
-> ParsecT
     String () 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
     String () 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 String () 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 String () 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 String () Identity (Maybe [JStat]))
-> GenParser Char () [JStat]
-> ParsecT String () Identity (Maybe [JStat])
forall a b. (a -> b) -> a -> b
$ do
       String -> JMParser ()
reservedOp String
"="
       JExpr
e <- GenParser Char () JExpr
expr
       [JStat] -> GenParser Char () [JStat]
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 (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 = String -> Ident
StrI String
"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 String () Identity [[JStat]]
-> GenParser Char () [JStat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GenParser Char () [JStat]
-> JMParser String -> ParsecT String () 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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Char () [JStat]
statement) (JMParser String
semi JMParser String -> JMParser String -> JMParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> JMParser String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""))

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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [JStat] -> GenParser Char () [JStat]
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.
ParsecT String () Identity a -> ParsecT String () Identity a
braces (JMParser ()
whiteSpace JMParser () -> JMParser [a] -> JMParser [a]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [a] -> JMParser [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [])

-- return either an expression or a statement
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.
ParsecT String () Identity a -> ParsecT String () Identity 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] -> String -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"statement"
    where
      declStat :: GenParser Char () [JStat]
declStat = do
        String -> JMParser ()
reserved String
"var"
        [JStat]
res <- [[JStat]] -> [JStat]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[JStat]] -> [JStat])
-> ParsecT String () Identity [[JStat]]
-> GenParser Char () [JStat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenParser Char () [JStat] -> ParsecT String () Identity [[JStat]]
forall a.
ParsecT String () Identity a -> ParsecT String () Identity [a]
commaSep1 GenParser Char () [JStat]
destructuringDecl
        String
_ <- JMParser String
semi
        [JStat] -> GenParser Char () [JStat]
forall (m :: * -> *) a. Monad m => a -> m a
return [JStat]
res

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

        (Ident
i,Maybe (Bool, JLocalType)
mbTyp) <- JMParser (Ident, Maybe (Bool, JLocalType))
varidentdecl
        ([Ident]
as,[JStat]
patDecls) <- ([Ident] -> ([Ident], [JStat]))
-> ParsecT String () Identity [Ident]
-> JMParser ([Ident], [JStat])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Ident]
x -> ([Ident]
x,[])) (ParsecT String () Identity [Ident]
-> ParsecT String () Identity [Ident]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String () Identity [Ident]
 -> ParsecT String () Identity [Ident])
-> ParsecT String () Identity [Ident]
-> ParsecT String () Identity [Ident]
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity [Ident]
-> ParsecT String () Identity [Ident]
forall a.
ParsecT String () Identity a -> ParsecT String () Identity a
parens (JMParser Ident -> ParsecT String () Identity [Ident]
forall a.
ParsecT String () Identity a -> ParsecT String () Identity [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.
ParsecT String () Identity a -> ParsecT String () Identity 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 (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 (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
        String -> JMParser ()
reserved String
"fun"
        Ident
n <- JMParser Ident
identdecl
        Maybe (Bool, JLocalType)
mbTyp <- JMParser (Bool, JLocalType)
-> ParsecT String () 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.
ParsecT String () Identity a -> ParsecT String () Identity 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
<|> (String -> JMParser String
symbol String
"->" JMParser String
-> GenParser Char () JStat -> GenParser Char () JStat
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 (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 (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 String
x) = String -> Ident
StrI (Char
'!'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'!'Char -> String -> String
forall a. a -> [a] -> [a]
:String
x)

      foreignStat :: GenParser Char () [JStat]
foreignStat = do
          String -> JMParser ()
reserved String
"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
<<* String -> JMParser ()
reservedOp String
"::"
          JLocalType
t <- CharParser () JLocalType
forall a. CharParser a JLocalType
runTypeParser
          [JStat] -> GenParser Char () [JStat]
forall (m :: * -> *) a. Monad m => a -> m a
return [Ident -> JLocalType -> JStat
ForeignStat Ident
i JLocalType
t]

      returnStat :: GenParser Char () [JStat]
returnStat =
        String -> JMParser ()
reserved String
"return" JMParser ()
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
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
$ String -> Ident
StrI String
"undefined") GenParser Char () JExpr
expr

      ifStat :: GenParser Char () [JStat]
ifStat = do
        String -> JMParser ()
reserved String
"if"
        JExpr
p <- GenParser Char () JExpr -> GenParser Char () JExpr
forall a.
ParsecT String () Identity a -> ParsecT String () Identity 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 (String -> JMParser ()
reserved String
"else") JMParser ()
-> ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT String () Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
                  ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Bool -> ParsecT String () Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        if Bool
isElse
          then do
            String -> JMParser ()
reserved String
"else"
            JStat -> [JStat]
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 (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 =
          String -> JMParser ()
reserved String
"while" JMParser ()
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
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.
ParsecT String () Identity a -> ParsecT String () Identity a
parens GenParser Char () JExpr
expr) GenParser Char () [JStat]
statementOrEmpty

      doWhileStat :: GenParser Char () [JStat]
doWhileStat = String -> JMParser ()
reserved String
"do" JMParser ()
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
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 (String -> JMParser ()
reserved String
"while" JMParser () -> GenParser Char () JExpr -> GenParser Char () JExpr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> GenParser Char () JExpr -> GenParser Char () JExpr
forall a.
ParsecT String () Identity a -> ParsecT String () Identity a
parens GenParser Char () JExpr
expr)

      switchStat :: GenParser Char () [JStat]
switchStat = do
        String -> JMParser ()
reserved String
"switch"
        JExpr
e <- GenParser Char () JExpr -> GenParser Char () JExpr
forall a.
ParsecT String () Identity a -> ParsecT String () Identity 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.
ParsecT String () Identity a -> ParsecT String () Identity a
braces (([(JExpr, JStat)] -> [JStat] -> ([(JExpr, JStat)], [JStat]))
-> ParsecT String () 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 String () Identity (JExpr, JStat)
-> ParsecT String () Identity [(JExpr, JStat)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String () 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 (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 String () Identity (JExpr, JStat)
caseStat =
        String -> JMParser ()
reserved String
"case" JMParser ()
-> ParsecT String () Identity (JExpr, JStat)
-> ParsecT String () Identity (JExpr, JStat)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (JExpr -> JStat -> (JExpr, JStat))
-> GenParser Char () JExpr
-> GenParser Char () JStat
-> ParsecT String () 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 String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':' ParsecT String () Identity Char
-> GenParser Char () JStat -> GenParser Char () JStat
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
        String -> JMParser ()
reserved String
"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 (String -> JMParser ()
reserved String
"catch") JMParser ()
-> ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT String () Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
                  ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Bool -> ParsecT String () Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        (Ident
i,[JStat]
s1) <- if Bool
isCatch
                  then do
                    String -> JMParser ()
reserved String
"catch"
                    (Ident -> [JStat] -> (Ident, [JStat]))
-> JMParser Ident
-> GenParser Char () [JStat]
-> ParsecT String () 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.
ParsecT String () Identity a -> ParsecT String () Identity a
parens JMParser Ident
identdecl) GenParser Char () [JStat]
statement
                  else (Ident, [JStat]) -> ParsecT String () Identity (Ident, [JStat])
forall (m :: * -> *) a. Monad m => a -> m a
return ((Ident, [JStat]) -> ParsecT String () Identity (Ident, [JStat]))
-> (Ident, [JStat]) -> ParsecT String () Identity (Ident, [JStat])
forall a b. (a -> b) -> a -> b
$ (String -> Ident
StrI String
"", [])
        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 (String -> JMParser ()
reserved String
"finally") JMParser ()
-> ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT String () Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
                  ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Bool -> ParsecT String () Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        [JStat]
s2 <- if Bool
isFinally
                then String -> JMParser ()
reserved String
"finally" JMParser ()
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Char () [JStat]
statement
                else [JStat] -> GenParser Char () [JStat]
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 (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 =
        String -> JMParser ()
reserved String
"default" JMParser ()
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':' ParsecT String () Identity Char -> JMParser () -> JMParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JMParser ()
whiteSpace JMParser ()
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Char () [JStat]
statblock

      forStat :: GenParser Char () [JStat]
forStat =
        String -> JMParser ()
reserved String
"for" JMParser ()
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((String -> JMParser ()
reserved String
"each" JMParser ()
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
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 String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(' ParsecT String () Identity Char -> JMParser () -> JMParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JMParser ()
whiteSpace JMParser () -> JMParser () -> JMParser ()
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 (String -> JMParser ()
reserved String
"var")
        Ident
i <- JMParser Ident
identdecl
        String -> JMParser ()
reserved String
"in"
        JExpr
e <- GenParser Char () JExpr
expr
        Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')' ParsecT String () Identity Char -> JMParser () -> JMParser ()
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 (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.
ParsecT String () Identity a -> ParsecT String () Identity a
parens JMParser ([JStat], Maybe JExpr, [JStat])
threeStat
        [JStat]
b <- GenParser Char () [JStat]
statement
        [JStat] -> GenParser Char () [JStat]
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 String () 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 String -> JMParser ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional JMParser String
semi)
                                (GenParser Char () JExpr -> ParsecT String () 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 String () Identity (Maybe JExpr)
-> JMParser String -> ParsecT String () Identity (Maybe JExpr)
forall (m :: * -> *) b a. Monad m => m b -> m a -> m b
<<* JMParser String
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 (String -> JExpr
jsv String
"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 :: String -> JMParser String
rop String
x = String -> JMParser ()
reservedOp String
x JMParser () -> JMParser String -> JMParser String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> JMParser String
forall (m :: * -> *) a. Monad m => a -> m a
return String
x
          (JExpr
e1,String
op) <- GenParser Char () (JExpr, String)
-> GenParser Char () (JExpr, String)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char () (JExpr, String)
 -> GenParser Char () (JExpr, String))
-> GenParser Char () (JExpr, String)
-> GenParser Char () (JExpr, String)
forall a b. (a -> b) -> a -> b
$ (JExpr -> String -> (JExpr, String))
-> GenParser Char () JExpr
-> JMParser String
-> GenParser Char () (JExpr, String)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) GenParser Char () JExpr
dotExpr ((String -> String) -> JMParser String -> JMParser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1) (JMParser String -> JMParser String)
-> JMParser String -> JMParser String
forall a b. (a -> b) -> a -> b
$
                                                   String -> JMParser String
rop String
"="
                                               JMParser String -> JMParser String -> JMParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> JMParser String
rop String
"+="
                                               JMParser String -> JMParser String -> JMParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> JMParser String
rop String
"-="
                                               JMParser String -> JMParser String -> JMParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> JMParser String
rop String
"*="
                                               JMParser String -> JMParser String -> JMParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> JMParser String
rop String
"/="
                                               JMParser String -> JMParser String -> JMParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> JMParser String
rop String
"%="
                                               JMParser String -> JMParser String -> JMParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> JMParser String
rop String
"<<="
                                               JMParser String -> JMParser String -> JMParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> JMParser String
rop String
">>="
                                               JMParser String -> JMParser String -> JMParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> JMParser String
rop String
">>>="
                                               JMParser String -> JMParser String -> JMParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> JMParser String
rop String
"&="
                                               JMParser String -> JMParser String -> JMParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> JMParser String
rop String
"^="
                                               JMParser String -> JMParser String -> JMParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> JMParser String
rop String
"|="
                                              )
          let gofail :: ParsecT String () Identity a
gofail  = String -> ParsecT String () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid assignment.")
              badList :: [String]
badList = [String
"this",String
"true",String
"false",String
"undefined",String
"null"]
          case JExpr
e1 of
            ValExpr (JVar (StrI String
s)) -> if String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
badList then JMParser ()
forall a. ParsecT String () Identity a
gofail else () -> JMParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            ApplExpr JExpr
_ [JExpr]
_ -> JMParser ()
forall a. ParsecT String () Identity a
gofail
            ValExpr JVal
_ -> JMParser ()
forall a. ParsecT String () Identity a
gofail
            JExpr
_ -> () -> JMParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          JExpr
e2 <- GenParser Char () JExpr
expr
          [JStat] -> GenParser Char () [JStat]
forall (m :: * -> *) a. Monad m => a -> m a
return [JExpr -> JExpr -> JStat
AssignStat JExpr
e1 (if String
op String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"=" then JExpr
e2 else String -> JExpr -> JExpr -> JExpr
InfixExpr String
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

--fixme: don't handle ifstats
      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 (m :: * -> *) a. Monad m => a -> m a
return [JStat
x]
{-
      expr2stat' :: JExpr -> JStat
      expr2stat' (ApplExpr x y) = return $ (ApplStat x y)
      expr2stat' (IfExpr x y z) = liftM2 (IfStat x) (expr2stat' y) (expr2stat' z)
      expr2stat' (PostExpr s x) = return $ PostStat s x
      expr2stat' (AntiExpr x)   = return $ AntiStat x
      expr2stat' _ = fail "Value expression used as statement"
-}

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

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

      labelStat :: GenParser Char () [JStat]
labelStat = do
        String
lbl <- JMParser String -> JMParser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (JMParser String -> JMParser String)
-> JMParser String -> JMParser String
forall a b. (a -> b) -> a -> b
$ do
                    String
l <- JMParser String
myIdent JMParser String
-> ParsecT String () Identity Char -> JMParser String
forall (m :: * -> *) b a. Monad m => m b -> m a -> m b
<<* Char -> ParsecT String () 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 (String
l String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"default")
                    String -> JMParser String
forall (m :: * -> *) a. Monad m => a -> m a
return String
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 (m :: * -> *) a. Monad m => a -> m a
return [String -> JStat -> JStat
LabelStat String
lbl JStat
s]

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

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

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

compileRegex :: String -> Either WrapError Regex
compileRegex :: String -> Either WrapError Regex
compileRegex String
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 -> String -> IO (Either WrapError Regex)
compile CompOption
co ExecOption
eo String
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 String () 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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return JExpr
e
    addIf :: JExpr -> GenParser Char () JExpr
addIf JExpr
e = do
          String -> JMParser ()
reservedOp String
"?"
          JExpr
t <- GenParser Char () JExpr
exprWithIf
          String
_ <- JMParser String
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 (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 -> String -> GenParser Char () JExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"expression"
    table :: OperatorTable Char () JExpr
table = [[String -> Operator Char () JExpr
pop String
"~", String -> Operator Char () JExpr
pop String
"!", Operator Char () JExpr
negop],
             [String -> Operator Char () JExpr
iop String
"*", String -> Operator Char () JExpr
iop String
"/", String -> Operator Char () JExpr
iop String
"%"],
             [String -> Operator Char () JExpr
pop String
"++", String -> Operator Char () JExpr
pop String
"--"],
             [String -> Operator Char () JExpr
iop String
"++", String -> Operator Char () JExpr
iop String
"+", String -> Operator Char () JExpr
iop String
"-", String -> Operator Char () JExpr
iop String
"--"],
             [String -> Operator Char () JExpr
iop String
"<<", String -> Operator Char () JExpr
iop String
">>", String -> Operator Char () JExpr
iop String
">>>"],
             [Operator Char () JExpr
consOp],
             [String -> Operator Char () JExpr
iope String
"==", String -> Operator Char () JExpr
iope String
"!=", String -> Operator Char () JExpr
iope String
"<", String -> Operator Char () JExpr
iope String
">",
              String -> Operator Char () JExpr
iope String
">=", String -> Operator Char () JExpr
iope String
"<=", String -> Operator Char () JExpr
iope String
"===", String -> Operator Char () JExpr
iope String
"!=="],
             [String -> Operator Char () JExpr
iop String
"&"],
             [String -> Operator Char () JExpr
iop String
"^"],
             [String -> Operator Char () JExpr
iop String
"|"],
             [String -> Operator Char () JExpr
iop String
"&&"],
             [String -> Operator Char () JExpr
iop String
"||"],
             [Operator Char () JExpr
applOp, Operator Char () JExpr
applOpRev]
            ]
    pop :: String -> Operator Char () JExpr
pop  String
s  = GenParser Char () (JExpr -> JExpr) -> Operator Char () JExpr
forall tok st a. GenParser tok st (a -> a) -> Operator tok st a
Prefix (String -> JMParser ()
reservedOp String
s JMParser ()
-> GenParser Char () (JExpr -> JExpr)
-> GenParser Char () (JExpr -> JExpr)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (JExpr -> JExpr) -> GenParser Char () (JExpr -> JExpr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> String -> JExpr -> JExpr
PPostExpr Bool
True String
s))
    iop :: String -> Operator Char () JExpr
iop  String
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 (String -> JMParser ()
reservedOp String
s JMParser ()
-> GenParser Char () (JExpr -> JExpr -> JExpr)
-> GenParser Char () (JExpr -> JExpr -> JExpr)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (JExpr -> JExpr -> JExpr)
-> GenParser Char () (JExpr -> JExpr -> JExpr)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> JExpr -> JExpr -> JExpr
InfixExpr String
s)) Assoc
AssocLeft
    iope :: String -> Operator Char () JExpr
iope String
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 (String -> JMParser ()
reservedOp String
s JMParser ()
-> GenParser Char () (JExpr -> JExpr -> JExpr)
-> GenParser Char () (JExpr -> JExpr -> JExpr)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (JExpr -> JExpr -> JExpr)
-> GenParser Char () (JExpr -> JExpr -> JExpr)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> JExpr -> JExpr -> JExpr
InfixExpr String
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 (String -> JMParser ()
reservedOp String
"<|" JMParser ()
-> GenParser Char () (JExpr -> JExpr -> JExpr)
-> GenParser Char () (JExpr -> JExpr -> JExpr)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (JExpr -> JExpr -> JExpr)
-> GenParser Char () (JExpr -> JExpr -> JExpr)
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 (String -> JMParser ()
reservedOp String
"|>" JMParser ()
-> GenParser Char () (JExpr -> JExpr -> JExpr)
-> GenParser Char () (JExpr -> JExpr -> JExpr)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (JExpr -> JExpr -> JExpr)
-> GenParser Char () (JExpr -> JExpr -> JExpr)
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 (String -> JMParser ()
reservedOp String
":|" JMParser ()
-> GenParser Char () (JExpr -> JExpr -> JExpr)
-> GenParser Char () (JExpr -> JExpr -> JExpr)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (JExpr -> JExpr -> JExpr)
-> GenParser Char () (JExpr -> JExpr -> JExpr)
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 [String -> Ident
StrI String
"x",String -> Ident
StrI String
"y"] ([JStat] -> JStat
BlockStat [[JStat] -> JStat
BlockStat [Ident -> Maybe JLocalType -> JStat
DeclStat (String -> Ident
StrI String
"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 (String -> Ident
StrI String
"x"))) (String -> Ident
StrI String
"slice")) [JVal -> JExpr
ValExpr (Integer -> JVal
JInt Integer
0)]),JExpr -> [JExpr] -> JStat
ApplStat (JExpr -> Ident -> JExpr
SelExpr JExpr
tmpVar (String -> Ident
StrI String
"unshift")) [JVal -> JExpr
ValExpr (Ident -> JVal
JVar (String -> Ident
StrI String
"y"))],JExpr -> JStat
ReturnStat JExpr
tmpVar]]))) [JExpr
x,JExpr
y]
        where tmpVar :: JExpr
tmpVar = JVal -> JExpr
ValExpr (Ident -> JVal
JVar (String -> Ident
StrI String
"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 (String -> JMParser ()
reservedOp String
"-" JMParser ()
-> GenParser Char () (JExpr -> JExpr)
-> GenParser Char () (JExpr -> JExpr)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (JExpr -> JExpr) -> GenParser Char () (JExpr -> JExpr)
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 -> String -> JExpr -> JExpr
PPostExpr Bool
True String
"-" JExpr
x

dotExpr :: JMParser JExpr
dotExpr :: GenParser Char () JExpr
dotExpr = do
  [JExpr]
e <- GenParser Char () JExpr -> ParsecT String () 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.
ParsecT String () Identity a -> ParsecT String () Identity a
lexeme GenParser Char () JExpr
dotExprOne) ParsecT String () Identity [JExpr]
-> String -> ParsecT String () Identity [JExpr]
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"simple expression"
  case [JExpr]
e of
    [JExpr
e'] -> JExpr -> GenParser Char () JExpr
forall (m :: * -> *) a. Monad m => a -> m a
return JExpr
e'
    (JExpr
e':[JExpr]
es) -> JExpr -> GenParser Char () JExpr
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]
_ -> String -> GenParser Char () JExpr
forall a. HasCallStack => String -> a
error String
"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.
ParsecT String () Identity a -> ParsecT String () Identity 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 String () Identity Char
-> ParsecT String () Identity (Maybe Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char -> ParsecT String () Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT String () Identity (Maybe Char)
-> ParsecT String () Identity (Maybe Char)
-> ParsecT String () 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 String () Identity (Maybe Char)
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 String
dot JMParser String
-> GenParser Char () JExpr -> GenParser Char () JExpr
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 String 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.
ParsecT String () Identity a -> ParsecT String () Identity 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 String () Identity [JExpr] -> GenParser Char () JExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity [JExpr]
-> ParsecT String () Identity [JExpr]
forall a.
ParsecT String () Identity a -> ParsecT String () Identity a
parens' (GenParser Char () JExpr -> ParsecT String () Identity [JExpr]
forall a.
ParsecT String () Identity a -> ParsecT String () Identity [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 (String -> JMParser ()
reservedOp String
"--" JMParser () -> GenParser Char () JExpr -> GenParser Char () JExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JExpr -> GenParser Char () JExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> String -> JExpr -> JExpr
PPostExpr Bool
False String
"--" 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 (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 (String -> JMParser ()
reservedOp String
"++" JMParser () -> GenParser Char () JExpr -> GenParser Char () JExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JExpr -> GenParser Char () JExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> String -> JExpr -> JExpr
PPostExpr Bool
False String
"++" 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 (m :: * -> *) a. Monad m => a -> m a
return JExpr
e
              Maybe Char
_   -> JExpr -> GenParser Char () JExpr
forall (m :: * -> *) a. Monad m => a -> m a
return JExpr
e

    numIdent :: ParsecT String u Identity Ident
numIdent = String -> Ident
StrI (String -> Ident)
-> ParsecT String u Identity String
-> ParsecT String u Identity Ident
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String u Identity Char -> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String 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 (String -> JMParser String
symbol String
"!" JMParser String
-> GenParser Char () JExpr -> GenParser Char () JExpr
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \JExpr
e ->
              JExpr -> GenParser Char () JExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (JExpr -> [JExpr] -> JExpr
ApplExpr (JVal -> JExpr
ValExpr (Ident -> JVal
JVar (String -> Ident
StrI String
"!"))) [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
<$> (String -> JMParser ()
reserved String
"new" JMParser () -> GenParser Char () JExpr -> GenParser Char () JExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Char () JExpr
dotExpr)

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

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

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

--notFolBy a b = a <<* notFollowedBy (char b)
folBy :: JMParser a -> Char -> JMParser a
folBy :: 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 String () Identity Char -> ParsecT String () 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 String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
b) ParsecT String () Identity Char
-> (Char -> JMParser ()) -> JMParser ()
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 (m :: * -> *) a. Monad m => a -> m a
return ()))

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

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

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

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


natFloat :: Fractional a => JMParser (Either Integer a)
natFloat :: JMParser (Either Integer a)
natFloat = (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'0' ParsecT String () Identity Char
-> JMParser (Either Integer a) -> JMParser (Either Integer a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JMParser (Either Integer a)
zeroNumFloat)
           JMParser (Either Integer a)
-> JMParser (Either Integer a) -> JMParser (Either Integer a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> JMParser (Either Integer a)
decimalFloat JMParser (Either Integer a)
-> String -> JMParser (Either Integer a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"number"
 where
    zeroNumFloat :: JMParser (Either Integer a)
zeroNumFloat    =  (Integer -> Either Integer a
forall a b. a -> Either a b
Left (Integer -> Either Integer a)
-> ParsecT String () Identity Integer
-> JMParser (Either Integer a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT String () Identity Integer
forall u. ParsecT String u Identity Integer
hexadecimal ParsecT String () Identity Integer
-> ParsecT String () Identity Integer
-> ParsecT String () Identity Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Integer
forall u. ParsecT String u Identity Integer
octal))
                       JMParser (Either Integer a)
-> JMParser (Either Integer a) -> JMParser (Either Integer a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> JMParser (Either Integer a)
decimalFloat
                       JMParser (Either Integer a)
-> JMParser (Either Integer a) -> JMParser (Either Integer a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Integer -> JMParser (Either Integer a)
fractFloat Integer
0
                       JMParser (Either Integer a)
-> JMParser (Either Integer a) -> JMParser (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 -> JMParser (Either Integer 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 :: JMParser (Either Integer a)
decimalFloat    = do Integer
n <- ParsecT String () Identity Integer
forall u. ParsecT String u Identity Integer
decimal
                         Either Integer a
-> JMParser (Either Integer a) -> JMParser (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 -> JMParser (Either Integer a)
fractFloat Integer
n)
    fractFloat :: Integer -> JMParser (Either Integer a)
fractFloat Integer
n    = a -> Either Integer a
forall a b. b -> Either a b
Right (a -> Either Integer a)
-> ParsecT String () Identity a -> JMParser (Either Integer a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> ParsecT String () Identity a
fractExponent Integer
n
    fractExponent :: Integer -> ParsecT String () Identity a
fractExponent Integer
n = (do a
fract <- ParsecT String () Identity a
forall u. ParsecT String u Identity a
fraction
                          a
expo  <- a -> ParsecT String () Identity a -> ParsecT String () 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 String () Identity a
exponent'
                          a -> ParsecT String () 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 String () Identity a
-> ParsecT String () Identity a -> ParsecT String () 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 String () Identity a -> ParsecT String () Identity a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity a
exponent')
    fraction :: ParsecT String u Identity a
fraction        = Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' ParsecT String u Identity Char
-> ParsecT String u Identity a -> ParsecT String u Identity a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((Char -> a -> a) -> a -> String -> a
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 (String -> a)
-> ParsecT String u Identity String -> ParsecT String u Identity a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String u Identity Char -> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT String u Identity a
-> String -> ParsecT String u Identity a
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"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 String () Identity a
exponent'       = do Char
_ <- String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"eE"
                         Integer -> Integer
f <- ParsecT String () Identity (Integer -> Integer)
forall u. ParsecT String u Identity (Integer -> Integer)
sign
                         Integer -> a
forall b p. (Fractional p, Integral b) => b -> p
power (Integer -> a) -> (Integer -> Integer) -> Integer -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
f (Integer -> a)
-> ParsecT String () Identity Integer
-> ParsecT String () Identity a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Integer
forall u. ParsecT String u Identity Integer
decimal
                    where
                       power :: b -> p
power b
e  | b
e b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
0      = p
1.0p -> p -> p
forall a. Fractional a => a -> a -> a
/b -> p
power(-b
e)
                                | Bool
otherwise  = Integer -> p
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 String u Identity (Integer -> Integer)
sign            =   (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT String u Identity Char
-> ParsecT String u Identity (Integer -> Integer)
-> ParsecT String u Identity (Integer -> Integer)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Integer -> Integer)
-> ParsecT String u Identity (Integer -> Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return Integer -> Integer
forall a. Num a => a -> a
negate)
                    ParsecT String u Identity (Integer -> Integer)
-> ParsecT String u Identity (Integer -> Integer)
-> ParsecT String 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 String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+' ParsecT String u Identity Char
-> ParsecT String u Identity (Integer -> Integer)
-> ParsecT String u Identity (Integer -> Integer)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Integer -> Integer)
-> ParsecT String u Identity (Integer -> Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return Integer -> Integer
forall a. a -> a
id)
                    ParsecT String u Identity (Integer -> Integer)
-> ParsecT String u Identity (Integer -> Integer)
-> ParsecT String 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 String u Identity (Integer -> Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return Integer -> Integer
forall a. a -> a
id

    decimal :: ParsecT String u Identity Integer
decimal         = Integer
-> ParsecT String u Identity Char
-> ParsecT String 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 String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
    hexadecimal :: ParsecT String u Identity Integer
hexadecimal     = String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"xX" ParsecT String u Identity Char
-> ParsecT String u Identity Integer
-> ParsecT String u Identity Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer
-> ParsecT String u Identity Char
-> ParsecT String 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 String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
    octal :: ParsecT String u Identity Integer
octal           = String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"oO" ParsecT String u Identity Char
-> ParsecT String u Identity Integer
-> ParsecT String u Identity Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer
-> ParsecT String u Identity Char
-> ParsecT String 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 String 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 -> String -> Integer
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 (String -> Integer)
-> ParsecT s u m String -> 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 String
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 String
myStringLiteral Char
t = do
    Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
t
    String
x <- [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ParsecT String () Identity [String] -> JMParser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JMParser String -> ParsecT String () Identity [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many JMParser String
myChar
    Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
t
    String -> JMParser String
decodeJson String
x
 where myChar :: JMParser String
myChar = do
         Char
c <- String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf [Char
t]
         case Char
c of
           Char
'\\' -> do
                  Char
c2 <- ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
                  String -> JMParser String
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c,Char
c2]
           Char
_ -> String -> JMParser String
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c]

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

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

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

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