-- | 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 "$_"
    , 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
<?> "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
<?> "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 "/*"
                "*/"
                "//"
                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 "{}<>()~.,?:|&^=!+-*/%!") -- operator start
                (String -> ParsecT s ParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf "=<>|&+") -- operator rest
                ["break", "case", "catch", "const", "continue", "debugger", 
                 "default", "delete", "do", "else", "enum", "false", "finally",
                 "for", "function", "if", "instanceof", "in", "let", "new", 
                 "null", "return", "switch", "this", "throw", "true", "try", 
                 "typeof", "var", "void", "while", "with"]
                ["|=", "^=", "&=", "<<=", ">>=", ">>>=", "+=", "-=", "*=", "/=", 
                 "%=", "=", ";", ",", "?", ":", "||", "&&", "|", "^", "&", 
                 "===", "==", "=", "!==", "!=", "<<", "<=", "<", ">>>", ">>", 
                 ">=", ">", "++", "--", "+", "-", "*", "/", "%", "!", "~", ".", 
                 "[", "]", "{", "}", "(", ")","</","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
>>= \d :: Char
d -> case Char
d of
  '0' -> String -> Parser s String
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
d]
  _   -> (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 '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 "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 "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 "" (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 "+-" 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
>>= \x :: 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 '.' 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 '.') 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 "" 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 ('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 ar :: [a]
ar) = [a]
ar
marr Nothing = []