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

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

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

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

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

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

import Text.Regex.Posix.String

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

import System.IO.Unsafe
import Numeric(readHex)

-- import Debug.Trace

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

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

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

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

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

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

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


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

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

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


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

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

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



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

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

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

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

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

          handleExpr JExpr
_ = Maybe (Q Exp)
forall a. Maybe a
Nothing

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

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

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

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

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


{--------------------------------------------------------------------
  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 [Char] () Identity -> TokenParser ()
forall s (m :: * -> *) u.
Stream s m Char =>
GenLanguageDef s u m -> GenTokenParser s u m
P.makeTokenParser GenLanguageDef [Char] () Identity
jsLang

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

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

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

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

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

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

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

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

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

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

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

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

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

--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
== ([Char] -> Ident
StrI [Char]
"_") = []
          | Bool
otherwise = [Ident -> Maybe JLocalType -> JStat
DeclStat Ident
i Maybe JLocalType
forall a. Maybe a
Nothing, JExpr -> JExpr -> JStat
AssignStat (JVal -> JExpr
ValExpr (Ident -> JVal
JVar (Ident -> Ident
cleanIdent Ident
i))) (JExpr
path)]
      go JExpr
path (PTList [PatternTree]
pts) = ((JExpr, PatternTree) -> [JStat])
-> [(JExpr, PatternTree)] -> [JStat]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((JExpr -> PatternTree -> [JStat])
-> (JExpr, PatternTree) -> [JStat]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry JExpr -> PatternTree -> [JStat]
go) ([(JExpr, PatternTree)] -> [JStat])
-> [(JExpr, PatternTree)] -> [JStat]
forall a b. (a -> b) -> a -> b
$ [JExpr] -> [PatternTree] -> [(JExpr, PatternTree)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Integer -> JExpr) -> [Integer] -> [JExpr]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> JExpr
addIntToPath [Integer
0..]) [PatternTree]
pts
           where addIntToPath :: Integer -> JExpr
addIntToPath Integer
i = JExpr -> JExpr -> JExpr
IdxExpr JExpr
path (JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ Integer -> JVal
JInt Integer
i)
      go JExpr
path (PTObj [([Char], PatternTree)]
xs)   = ((JExpr, PatternTree) -> [JStat])
-> [(JExpr, PatternTree)] -> [JStat]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((JExpr -> PatternTree -> [JStat])
-> (JExpr, PatternTree) -> [JStat]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry JExpr -> PatternTree -> [JStat]
go) ([(JExpr, PatternTree)] -> [JStat])
-> [(JExpr, PatternTree)] -> [JStat]
forall a b. (a -> b) -> a -> b
$ (([Char], PatternTree) -> (JExpr, PatternTree))
-> [([Char], PatternTree)] -> [(JExpr, PatternTree)]
forall a b. (a -> b) -> [a] -> [b]
map (([Char] -> JExpr) -> ([Char], PatternTree) -> (JExpr, PatternTree)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first [Char] -> JExpr
fixPath) [([Char], PatternTree)]
xs
           where fixPath :: [Char] -> JExpr
fixPath [Char]
lbl = JExpr -> JExpr -> JExpr
IdxExpr JExpr
path (JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ [Char] -> JVal
JStr [Char]
lbl)
      go JExpr
path (PTCons PatternTree
x PatternTree
xs) = [[JStat]] -> [JStat]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [JExpr -> PatternTree -> [JStat]
go (JExpr -> JExpr -> JExpr
IdxExpr JExpr
path (JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ Integer -> JVal
JInt Integer
0)) PatternTree
x,
                                      JExpr -> PatternTree -> [JStat]
go (JExpr -> [JExpr] -> JExpr
ApplExpr (JExpr -> Ident -> JExpr
SelExpr JExpr
path ([Char] -> Ident
StrI [Char]
"slice")) [JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ Integer -> JVal
JInt Integer
1]) PatternTree
xs]
  case PatternTree
ptree of
    PTVar Ident
i -> Either (Ident -> [JStat]) (Ident, [JStat])
-> JMParser (Either (Ident -> [JStat]) (Ident, [JStat]))
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Ident -> [JStat]) (Ident, [JStat])
 -> JMParser (Either (Ident -> [JStat]) (Ident, [JStat])))
-> Either (Ident -> [JStat]) (Ident, [JStat])
-> JMParser (Either (Ident -> [JStat]) (Ident, [JStat]))
forall a b. (a -> b) -> a -> b
$ (Ident, [JStat]) -> Either (Ident -> [JStat]) (Ident, [JStat])
forall a b. b -> Either a b
Right (Ident
i,[])
    PTAs  Ident
i PatternTree
pt -> Either (Ident -> [JStat]) (Ident, [JStat])
-> JMParser (Either (Ident -> [JStat]) (Ident, [JStat]))
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Ident -> [JStat]) (Ident, [JStat])
 -> JMParser (Either (Ident -> [JStat]) (Ident, [JStat])))
-> Either (Ident -> [JStat]) (Ident, [JStat])
-> JMParser (Either (Ident -> [JStat]) (Ident, [JStat]))
forall a b. (a -> b) -> a -> b
$ (Ident, [JStat]) -> Either (Ident -> [JStat]) (Ident, [JStat])
forall a b. b -> Either a b
Right (Ident
i, JExpr -> PatternTree -> [JStat]
go (JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ Ident -> JVal
JVar Ident
i) PatternTree
pt)
    PatternTree
_ -> Either (Ident -> [JStat]) (Ident, [JStat])
-> JMParser (Either (Ident -> [JStat]) (Ident, [JStat]))
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Ident -> [JStat]) (Ident, [JStat])
 -> JMParser (Either (Ident -> [JStat]) (Ident, [JStat])))
-> Either (Ident -> [JStat]) (Ident, [JStat])
-> JMParser (Either (Ident -> [JStat]) (Ident, [JStat]))
forall a b. (a -> b) -> a -> b
$ (Ident -> [JStat]) -> Either (Ident -> [JStat]) (Ident, [JStat])
forall a b. a -> Either a b
Left ((Ident -> [JStat]) -> Either (Ident -> [JStat]) (Ident, [JStat]))
-> (Ident -> [JStat]) -> Either (Ident -> [JStat]) (Ident, [JStat])
forall a b. (a -> b) -> a -> b
$ \Ident
i -> JExpr -> PatternTree -> [JStat]
go (JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ Ident -> JVal
JVar Ident
i) PatternTree
ptree

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

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

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

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

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

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

-- 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. JMParser a -> JMParser a
braces GenParser Char () [JStat]
statblock
            GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
assignOpStat
            GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
tryStat
            GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
applStat
            GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
breakStat
            GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
continueStat
            GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
antiStat
            GenParser Char () [JStat]
-> GenParser Char () [JStat] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () [JStat]
antiStatSimple
          GenParser Char () [JStat] -> [Char] -> GenParser Char () [JStat]
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"statement"
    where
      declStat :: GenParser Char () [JStat]
declStat = do
        [Char] -> JMParser ()
reserved [Char]
"var"
        [JStat]
res <- [[JStat]] -> [JStat]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[JStat]] -> [JStat])
-> ParsecT [Char] () Identity [[JStat]]
-> GenParser Char () [JStat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenParser Char () [JStat] -> ParsecT [Char] () Identity [[JStat]]
forall a. JMParser a -> JMParser [a]
commaSep1 GenParser Char () [JStat]
destructuringDecl
        [Char]
_ <- JMParser [Char]
semi
        [JStat] -> GenParser Char () [JStat]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [JStat]
res

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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


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

--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 a. a -> ParsecT [tok] st Identity a
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
        [Char] -> JMParser ()
reserved [Char]
"break"
        Maybe [Char]
l <- JMParser [Char] -> ParsecT [Char] () Identity (Maybe [Char])
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe JMParser [Char]
myIdent
        [JStat] -> GenParser Char () [JStat]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Maybe [Char] -> JStat
BreakStat Maybe [Char]
l]

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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

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