-- | 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 =
  [CharSet] -> CharSet
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
    CharSet -> CharSet -> CharSet
forall a. Semigroup a => a -> a -> a
<> [CharSet] -> CharSet
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 = (Char -> Bool) -> ParsecT s ParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy ((Char -> CharSet -> Bool) -> CharSet -> Char -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> CharSet -> Bool
Set.member CharSet
identifierStartCharSet) ParsecT s ParserState Identity Char
-> String -> ParsecT s ParserState Identity Char
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 = (Char -> Bool) -> ParsecT s ParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy ((Char -> CharSet -> Bool) -> CharSet -> Char -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> CharSet -> Bool
Set.member CharSet
identifierRestCharSet) ParsecT s ParserState Identity Char
-> String -> ParsecT s ParserState Identity Char
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 =
  String
-> String
-> String
-> Bool
-> ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity Char
-> ParserState
-> ParserState
-> Bool
-> GenLanguageDef s ParserState Identity
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
                ParsecT s ParserState Identity Char
forall s. Stream s Identity Char => Parser s Char
identifierStart
                ParsecT s ParserState Identity Char
forall s. Stream s Identity Char => Parser s Char
identifierRest
                (String -> ParsecT s ParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"{}<>()~.,?:|&^=!+-*/%!") -- operator start
                (String -> ParsecT s ParserState Identity Char
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 = GenLanguageDef s ParserState Identity
-> GenTokenParser s ParserState Identity
forall s (m :: * -> *) u.
Stream s m Char =>
GenLanguageDef s u m -> GenTokenParser s u m
T.makeTokenParser GenLanguageDef s ParserState Identity
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 = GenTokenParser s ParserState Identity
-> ParsecT s ParserState Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
T.identifier  GenTokenParser s ParserState Identity
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 = GenTokenParser s ParserState Identity
-> String -> ParsecT s ParserState Identity ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
T.reserved  GenTokenParser s ParserState Identity
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 = GenTokenParser s ParserState Identity
-> ParsecT s ParserState Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
T.operator  GenTokenParser s ParserState Identity
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 = GenTokenParser s ParserState Identity
-> String -> ParsecT s ParserState Identity ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
T.reservedOp GenTokenParser s ParserState Identity
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 = GenTokenParser s ParserState Identity
-> ParsecT s ParserState Identity Char
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m Char
T.charLiteral GenTokenParser s ParserState Identity
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 = GenTokenParser s ParserState Identity
-> ParsecT s ParserState Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
T.stringLiteral GenTokenParser s ParserState Identity
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 = GenTokenParser s ParserState Identity
-> String -> ParsecT s ParserState Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m String
T.symbol GenTokenParser s ParserState Identity
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 = GenTokenParser s ParserState Identity
-> ParsecT s ParserState Identity ()
forall s u (m :: * -> *). GenTokenParser s u m -> ParsecT s u m ()
T.whiteSpace GenTokenParser s ParserState Identity
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 = GenTokenParser s ParserState Identity
-> forall a.
   ParsecT s ParserState Identity a
   -> ParsecT s ParserState Identity a
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
T.parens  GenTokenParser s ParserState Identity
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 = GenTokenParser s ParserState Identity
-> forall a.
   ParsecT s ParserState Identity a
   -> ParsecT s ParserState Identity a
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
T.braces  GenTokenParser s ParserState Identity
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 = GenTokenParser s ParserState Identity
-> forall a.
   ParsecT s ParserState Identity a
   -> ParsecT s ParserState Identity a
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
T.squares GenTokenParser s ParserState Identity
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 = GenTokenParser s ParserState Identity
-> ParsecT s ParserState Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
T.semi  GenTokenParser s ParserState Identity
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 = GenTokenParser s ParserState Identity
-> ParsecT s ParserState Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
T.comma  GenTokenParser s ParserState Identity
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 = GenTokenParser s ParserState Identity
-> ParsecT s ParserState Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
T.colon GenTokenParser s ParserState Identity
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 = GenTokenParser s ParserState Identity
-> ParsecT s ParserState Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
T.dot GenTokenParser s ParserState Identity
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 = GenTokenParser s ParserState Identity
-> forall a.
   ParsecT s ParserState Identity a
   -> ParsecT s ParserState Identity a
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
T.brackets GenTokenParser s ParserState Identity
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 = GenTokenParser s ParserState Identity
-> forall a.
   ParsecT s ParserState Identity a
   -> ParsecT s ParserState Identity a
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
T.lexeme GenTokenParser s ParserState Identity
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 = ParsecT s ParserState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT s ParserState Identity Char
-> (Char -> ParsecT s ParserState Identity String)
-> ParsecT s ParserState Identity String
forall a b.
ParsecT s ParserState Identity a
-> (a -> ParsecT s ParserState Identity b)
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
d -> case Char
d of
  Char
'0' -> String -> ParsecT s ParserState Identity String
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
d]
  Char
_   -> (Char
dChar -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String)
-> ParsecT s ParserState Identity String
-> ParsecT s ParserState Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s ParserState Identity String
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 = ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT s ParserState Identity Char
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 = ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s ParserState Identity Char
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 ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT s ParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'0' ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity Char
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT s ParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"xX")
               ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s ParserState Identity Char
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 ei <- String -> ParsecT s ParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"eE"
                  sgn<- option "" $ oneOf "+-" >>= \Char
x -> String -> ParsecT s ParserState Identity String
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
x]
                  si <- decDigits
                  return (ei:(sgn++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 =   
  [ParsecT s ParserState Identity (String, Bool)]
-> ParsecT s ParserState Identity (String, Bool)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [do whole <- Parser s String
forall s. Stream s Identity Char => Parser s String
decIntLit
             mfrac <- optionMaybe ((:) <$> char '.' <*> decDigitsOpt)
             mexp  <- optionMaybe exponentPart
             let isint = Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
mfrac Bool -> Bool -> Bool
&& Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
mexp
             return (whole ++ marr mfrac ++ marr mexp, isint)
         ,do frac <- (:) (Char -> String -> String)
-> ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ParsecT s ParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.') ParsecT s ParserState Identity (String -> String)
-> Parser s String -> Parser s String
forall a b.
ParsecT s ParserState Identity (a -> b)
-> ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser s String
forall s. Stream s Identity Char => Parser s String
decDigits
             exp <- option "" exponentPart
             return ('0':frac++exp, True)             
         ]

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