-- | This isn't a lexer in the sense that it provides a JavaScript
-- token-stream. This module provides character-parsers for various
-- JavaScript tokens.

module Language.ECMAScript3.Lexer(lexeme,identifier,reserved,operator,reservedOp,charLiteral,
                        stringLiteral,
--                        natural,integer,float,naturalOrFloat,
--                        decimal,
--                                 hexadecimal,octal,
                                 symbol,whiteSpace,parens,
                        braces,brackets,squares,semi,comma,colon,dot,
                        identifierStart
                                 ,hexIntLit,decIntLit, decDigits, decDigitsOpt, exponentPart, decLit) where

import Prelude hiding (lex)
import Data.Char
import Data.Monoid ((<>), mconcat)
import qualified Data.CharSet                  as Set
import qualified Data.CharSet.Unicode.Category as Set
import Text.Parsec
import qualified Text.Parsec.Token as T
import Language.ECMAScript3.Parser.State
import Language.ECMAScript3.Parser.Type
import Control.Monad.Identity
import Control.Applicative ((<$>), (<*>))
import Data.Maybe (isNothing)

identifierStartCharSet :: Set.CharSet
identifierStartCharSet :: CharSet
identifierStartCharSet =
  forall a. Monoid a => [a] -> a
mconcat
    [ String -> CharSet
Set.fromDistinctAscList String
"$_"
    , CharSet
Set.lowercaseLetter
    , CharSet
Set.uppercaseLetter
    , CharSet
Set.titlecaseLetter
    , CharSet
Set.modifierLetter
    , CharSet
Set.otherLetter
    , CharSet
Set.letterNumber
    ]

identifierRestCharSet :: Set.CharSet
identifierRestCharSet :: CharSet
identifierRestCharSet =
  CharSet
identifierStartCharSet
    forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat
         [ CharSet
Set.nonSpacingMark
         , CharSet
Set.spacingCombiningMark
         , CharSet
Set.decimalNumber
         , CharSet
Set.connectorPunctuation
         ]

identifierStart :: Stream s Identity Char => Parser s Char
identifierStart :: forall s. Stream s Identity Char => Parser s Char
identifierStart = forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> CharSet -> Bool
Set.member CharSet
identifierStartCharSet) forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"letter, '$', '_'"

identifierRest :: Stream s Identity Char => Parser s Char
identifierRest :: forall s. Stream s Identity Char => Parser s Char
identifierRest = forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> CharSet -> Bool
Set.member CharSet
identifierRestCharSet) forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"letter, digits, '$', '_' ..."

javascriptDef :: Stream s Identity Char =>T.GenLanguageDef s ParserState Identity
javascriptDef :: forall s.
Stream s Identity Char =>
GenLanguageDef s ParserState Identity
javascriptDef =
  forall s u (m :: * -> *).
String
-> String
-> String
-> Bool
-> ParsecT s u m Char
-> ParsecT s u m Char
-> ParsecT s u m Char
-> ParsecT s u m Char
-> ParserState
-> ParserState
-> Bool
-> GenLanguageDef s u m
T.LanguageDef String
"/*"
                String
"*/"
                String
"//"
                Bool
False -- no nested comments
                forall s. Stream s Identity Char => Parser s Char
identifierStart
                forall s. Stream s Identity Char => Parser s Char
identifierRest
                (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"{}<>()~.,?:|&^=!+-*/%!") -- operator start
                (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"=<>|&+") -- operator rest
                [String
"break", String
"case", String
"catch", String
"const", String
"continue", String
"debugger", 
                 String
"default", String
"delete", String
"do", String
"else", String
"enum", String
"false", String
"finally",
                 String
"for", String
"function", String
"if", String
"instanceof", String
"in", String
"let", String
"new", 
                 String
"null", String
"return", String
"switch", String
"this", String
"throw", String
"true", String
"try", 
                 String
"typeof", String
"var", String
"void", String
"while", String
"with"]
                [String
"|=", String
"^=", String
"&=", String
"<<=", String
">>=", String
">>>=", String
"+=", String
"-=", String
"*=", String
"/=", 
                 String
"%=", String
"=", String
";", String
",", String
"?", String
":", String
"||", String
"&&", String
"|", String
"^", String
"&", 
                 String
"===", String
"==", String
"=", String
"!==", String
"!=", String
"<<", String
"<=", String
"<", String
">>>", String
">>", 
                 String
">=", String
">", String
"++", String
"--", String
"+", String
"-", String
"*", String
"/", String
"%", String
"!", String
"~", String
".", 
                 String
"[", String
"]", String
"{", String
"}", String
"(", String
")",String
"</",String
"instanceof"]
                 Bool
True -- case-sensitive
            
lex :: Stream s Identity Char => T.GenTokenParser s ParserState Identity
lex :: forall s.
Stream s Identity Char =>
GenTokenParser s ParserState Identity
lex = forall s (m :: * -> *) u.
Stream s m Char =>
GenLanguageDef s u m -> GenTokenParser s u m
T.makeTokenParser forall s.
Stream s Identity Char =>
GenLanguageDef s ParserState Identity
javascriptDef

-- everything but commaSep and semiSep
identifier :: Stream s Identity Char => Parser s String
identifier :: forall s. Stream s Identity Char => Parser s String
identifier = forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
T.identifier  forall s.
Stream s Identity Char =>
GenTokenParser s ParserState Identity
lex
reserved :: Stream s Identity Char => String -> Parser s ()
reserved :: forall s. Stream s Identity Char => String -> Parser s ()
reserved = forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
T.reserved  forall s.
Stream s Identity Char =>
GenTokenParser s ParserState Identity
lex
operator :: Stream s Identity Char => Parser s String
operator :: forall s. Stream s Identity Char => Parser s String
operator = forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
T.operator  forall s.
Stream s Identity Char =>
GenTokenParser s ParserState Identity
lex
reservedOp :: Stream s Identity Char => String -> Parser s ()
reservedOp :: forall s. Stream s Identity Char => String -> Parser s ()
reservedOp = forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
T.reservedOp forall s.
Stream s Identity Char =>
GenTokenParser s ParserState Identity
lex 
charLiteral :: Stream s Identity Char => Parser s Char
charLiteral :: forall s. Stream s Identity Char => Parser s Char
charLiteral = forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m Char
T.charLiteral forall s.
Stream s Identity Char =>
GenTokenParser s ParserState Identity
lex 
stringLiteral :: Stream s Identity Char => Parser s String
stringLiteral :: forall s. Stream s Identity Char => Parser s String
stringLiteral = forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
T.stringLiteral forall s.
Stream s Identity Char =>
GenTokenParser s ParserState Identity
lex
-- natural :: Stream s Identity Char => Parser s Integer
-- natural = T.natural lex 
-- integer :: Stream s Identity Char => Parser s Integer
-- integer = T.integer lex 
-- float :: Stream s Identity Char => Parser s Double
-- float = T.float lex
-- naturalOrFloat :: Stream s Identity Char => Parser s (Either Integer Double)
-- naturalOrFloat = T.naturalOrFloat lex
-- decimal :: Stream s Identity Char => Parser s Integer
-- decimal = T.decimal lex 
-- hexadecimal :: Stream s Identity Char => Parser s Integer
-- hexadecimal = T.hexadecimal lex 
-- octal :: Stream s Identity Char => Parser s Integer
-- octal = T.octal lex
symbol :: Stream s Identity Char => String -> Parser s String
symbol :: forall s. Stream s Identity Char => String -> Parser s String
symbol = forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m String
T.symbol forall s.
Stream s Identity Char =>
GenTokenParser s ParserState Identity
lex
whiteSpace :: Stream s Identity Char => Parser s ()
whiteSpace :: forall s. Stream s Identity Char => Parser s ()
whiteSpace = forall s u (m :: * -> *). GenTokenParser s u m -> ParsecT s u m ()
T.whiteSpace forall s.
Stream s Identity Char =>
GenTokenParser s ParserState Identity
lex 
parens :: Stream s Identity Char => Parser s a -> Parser s a
parens :: forall s a. Stream s Identity Char => Parser s a -> Parser s a
parens = forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
T.parens  forall s.
Stream s Identity Char =>
GenTokenParser s ParserState Identity
lex
braces :: Stream s Identity Char => Parser s a -> Parser s a
braces :: forall s a. Stream s Identity Char => Parser s a -> Parser s a
braces = forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
T.braces  forall s.
Stream s Identity Char =>
GenTokenParser s ParserState Identity
lex
squares :: Stream s Identity Char => Parser s a -> Parser s a
squares :: forall s a. Stream s Identity Char => Parser s a -> Parser s a
squares = forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
T.squares forall s.
Stream s Identity Char =>
GenTokenParser s ParserState Identity
lex 
semi :: Stream s Identity Char => Parser s String
semi :: forall s. Stream s Identity Char => Parser s String
semi = forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
T.semi  forall s.
Stream s Identity Char =>
GenTokenParser s ParserState Identity
lex
comma :: Stream s Identity Char => Parser s String
comma :: forall s. Stream s Identity Char => Parser s String
comma = forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
T.comma  forall s.
Stream s Identity Char =>
GenTokenParser s ParserState Identity
lex
colon :: Stream s Identity Char => Parser s String
colon :: forall s. Stream s Identity Char => Parser s String
colon = forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
T.colon forall s.
Stream s Identity Char =>
GenTokenParser s ParserState Identity
lex
dot :: Stream s Identity Char => Parser s String
dot :: forall s. Stream s Identity Char => Parser s String
dot = forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
T.dot forall s.
Stream s Identity Char =>
GenTokenParser s ParserState Identity
lex
brackets :: Stream s Identity Char => Parser s a -> Parser s a
brackets :: forall s a. Stream s Identity Char => Parser s a -> Parser s a
brackets = forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
T.brackets forall s.
Stream s Identity Char =>
GenTokenParser s ParserState Identity
lex
lexeme :: Stream s Identity Char => Parser s a -> Parser s a
lexeme :: forall s a. Stream s Identity Char => Parser s a -> Parser s a
lexeme = forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
T.lexeme forall s.
Stream s Identity Char =>
GenTokenParser s ParserState Identity
lex

-- 7.8.3
decIntLit :: Stream s Identity Char => Parser s String
decIntLit :: forall s. Stream s Identity Char => Parser s String
decIntLit = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
d -> case Char
d of
  Char
'0' -> forall (m :: * -> *) a. Monad m => a -> m a
return [Char
d]
  Char
_   -> (Char
dforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Stream s Identity Char => Parser s String
decDigitsOpt

decDigitsOpt :: Stream s Identity Char => Parser s String
decDigitsOpt :: forall s. Stream s Identity Char => Parser s String
decDigitsOpt = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit

decDigits :: Stream s Identity Char => Parser s String
decDigits :: forall s. Stream s Identity Char => Parser s String
decDigits = forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit

hexIntLit :: Stream s Identity Char => Parser s String
hexIntLit :: forall s. Stream s Identity Char => Parser s String
hexIntLit = do forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'0' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"xX")
               forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit

exponentPart :: Stream s Identity Char => Parser s String
exponentPart :: forall s. Stream s Identity Char => Parser s String
exponentPart = do Char
ei <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"eE"
                  String
sgn<- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"+-" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
x -> forall (m :: * -> *) a. Monad m => a -> m a
return [Char
x]
                  String
si <- forall s. Stream s Identity Char => Parser s String
decDigits
                  forall (m :: * -> *) a. Monad m => a -> m a
return (Char
eiforall a. a -> [a] -> [a]
:(String
sgnforall a. [a] -> [a] -> [a]
++String
si))

-- data Sign = Plus | Minus

-- signedInteger :: Stream s Identity Char => Parser s (Sign, String)
-- signedInteger = do sgn <- option Plus (char '+' >> return Plus)
--                                    <|>(char '+' >> return Minus)
--                    s <- decDigits
--                    return (sgn, s)

-- | returns (s, True) if the number is an integer, an (s, False)
-- otherwise
decLit :: Stream s Identity Char => Parser s (String, Bool)
decLit :: forall s. Stream s Identity Char => Parser s (String, Bool)
decLit =   
  forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [do String
whole <- forall s. Stream s Identity Char => Parser s String
decIntLit
             Maybe String
mfrac <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s. Stream s Identity Char => Parser s String
decDigitsOpt)
             Maybe String
mexp  <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe forall s. Stream s Identity Char => Parser s String
exponentPart
             let isint :: Bool
isint = forall a. Maybe a -> Bool
isNothing Maybe String
mfrac Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Maybe String
mexp
             forall (m :: * -> *) a. Monad m => a -> m a
return (String
whole forall a. [a] -> [a] -> [a]
++ forall {a}. Maybe [a] -> [a]
marr Maybe String
mfrac forall a. [a] -> [a] -> [a]
++ forall {a}. Maybe [a] -> [a]
marr Maybe String
mexp, Bool
isint)
         ,do String
frac <- (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.') forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s. Stream s Identity Char => Parser s String
decDigits
             String
exp <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" forall s. Stream s Identity Char => Parser s String
exponentPart
             forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'0'forall a. a -> [a] -> [a]
:String
fracforall a. [a] -> [a] -> [a]
++String
exp, Bool
True)             
         ]

marr :: Maybe [a] -> [a]
marr (Just [a]
ar) = [a]
ar
marr Maybe [a]
Nothing = []