-- | 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 :: Parser s Char
identifierStart = (Char -> Bool) -> Parser s 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) Parser s Char -> String -> Parser s 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 :: Parser s Char
identifierRest = (Char -> Bool) -> Parser s 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) Parser s Char -> String -> Parser s 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 :: 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 :: 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 :: Parser s String
identifier = GenTokenParser s ParserState Identity -> Parser s 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 :: String -> Parser s ()
reserved = GenTokenParser s ParserState Identity -> String -> Parser s ()
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 :: Parser s String
operator = GenTokenParser s ParserState Identity -> Parser s 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 :: String -> Parser s ()
reservedOp = GenTokenParser s ParserState Identity -> String -> Parser s ()
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 :: Parser s Char
charLiteral = GenTokenParser s ParserState Identity -> Parser s 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 :: Parser s String
stringLiteral = GenTokenParser s ParserState Identity -> Parser s 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 :: String -> Parser s String
symbol = GenTokenParser s ParserState Identity -> String -> Parser s 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 :: Parser s ()
whiteSpace = GenTokenParser s ParserState Identity -> Parser s ()
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 :: 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 :: 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 :: 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 :: Parser s String
semi = GenTokenParser s ParserState Identity -> Parser s 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 :: Parser s String
comma = GenTokenParser s ParserState Identity -> Parser s 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 :: Parser s String
colon = GenTokenParser s ParserState Identity -> Parser s 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 :: Parser s String
dot = GenTokenParser s ParserState Identity -> Parser s 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 :: 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 :: 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 :: 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 -> Parser s String) -> Parser s String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
d -> case Char
d of
  Char
'0' -> String -> Parser s String
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
d]
  Char
_   -> (Char
dChar -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> Parser s String -> Parser s String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser s String
forall s. Stream s Identity Char => Parser s String
decDigitsOpt

decDigitsOpt :: Stream s Identity Char => Parser s String
decDigitsOpt :: Parser s String
decDigitsOpt = ParsecT s ParserState Identity Char -> Parser s 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 :: Parser s String
decDigits = ParsecT s ParserState Identity Char -> Parser s String
forall s (m :: * -> *) t u a.
Stream s m t =>
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 :: 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 (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 -> Parser s String
forall s (m :: * -> *) t u a.
Stream s m t =>
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 :: Parser s String
exponentPart = do Char
ei <- String -> ParsecT s ParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"eE"
                  String
sgn<- String -> Parser s String -> Parser s String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" (Parser s String -> Parser s String)
-> Parser s String -> Parser s String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT s ParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"+-" ParsecT s ParserState Identity Char
-> (Char -> Parser s String) -> Parser s String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
x -> String -> Parser s String
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
x]
                  String
si <- Parser s String
forall s. Stream s Identity Char => Parser s String
decDigits
                  String -> Parser s String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
eiChar -> String -> String
forall a. a -> [a] -> [a]
:(String
sgnString -> String -> String
forall 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 :: Parser s (String, Bool)
decLit =   
  [Parser s (String, Bool)] -> Parser s (String, Bool)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [do String
whole <- Parser s String
forall s. Stream s Identity Char => Parser s String
decIntLit
             Maybe String
mfrac <- Parser s String -> ParsecT s ParserState Identity (Maybe String)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ((:) (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser s String
forall s. Stream s Identity Char => Parser s String
decDigitsOpt)
             Maybe String
mexp  <- Parser s String -> ParsecT s ParserState Identity (Maybe String)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe Parser s String
forall s. Stream s Identity Char => Parser s String
exponentPart
             let isint :: Bool
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
             (String, Bool) -> Parser s (String, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
whole String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
forall a. Maybe [a] -> [a]
marr Maybe String
mfrac String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
forall a. Maybe [a] -> [a]
marr Maybe String
mexp, Bool
isint)
         ,do String
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 (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
             String
exp <- String -> Parser s String -> Parser s String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" Parser s String
forall s. Stream s Identity Char => Parser s String
exponentPart
             (String, Bool) -> Parser s (String, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'0'Char -> String -> String
forall a. a -> [a] -> [a]
:String
fracString -> String -> String
forall a. [a] -> [a] -> [a]
++String
exp, Bool
True)             
         ]

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