content: module Syntax.Lexer
    -- Literals
    ( natural
    , naturalOrFloat
    , stringLiteral
    , charLiteral
    -- Keywords
    , lcid
    , ucid
    , reserved
    , reservedOp
    , operator
    , symbol
    -- Delimiters
    , parens
    , braces
    , brackets
    , angles
    , separator
    , block
    -- Utils
    , commaSep
    , commaSep1
    , newline
    , comma
    , anySpace
    ) where
  
  import Data.Char (digitToInt)
  import Text.Parsec ((<|>), (<?>), sepEndBy1, sepEndBy, many, many1, between, try, skipMany, skipMany1, choice, unexpected, parserFail, option, parserZero)
  import Text.Parsec.Char (lower, upper, alphaNum, oneOf, noneOf, char, anyChar, string, digit, satisfy, endOfLine, hexDigit, octDigit)
  import Text.Parsec.String (Parser)
  
  lexeme :: Parser a -> Parser a
  lexeme p = p <* space
  
  space' :: Parser ()
  space' = choice [ ignore (oneOf " \t")
                  , comment
                  ]
  
  space :: Parser ()
  space = skipMany space'
  
  newline :: Parser ()
  newline = space >> endOfLine >> space
  
  anySpace :: Parser ()
  anySpace = skipMany (space' <|> newline)
  
  comment :: Parser ()
  comment = oneLineComment <|> multiLineComment
  
  oneLineComment :: Parser ()
  oneLineComment = do
    ignore . try . string $ "//"
    skipMany . satisfy $ (/= '\n')
  
  multiLineComment :: Parser ()
  multiLineComment = do
    ignore . try . string $ "/*"
    content
      where
        content :: Parser ()
        content = choice [ multiLineComment >> content
                         , ignore $ try (string "*/")
                         , ignore $ (anyChar >> content)
                         , parserFail "unterminated multiline comment"
                         ]
  
  -- Literals
  stringLiteral :: Parser String
  stringLiteral = lexeme $ between (char '"') (char '"') (many . noneOf $ "\"")
  
  charLiteral :: Parser Char
  charLiteral = lexeme $ between (char '\'') (char '\'') (noneOf "'")
  
  -- Delimiters
  parens :: Parser a -> Parser a
  parens p = lexeme $ between (char '(' <* anySpace) (anySpace *> char ')') p
  
  braces :: Parser a -> Parser a
  braces p = lexeme $ between (char '{' <* anySpace) (anySpace *> char '}') p
  
  brackets :: Parser a -> Parser a
  brackets p = lexeme $ between (char '[' <* anySpace) (anySpace *> char ']') p
  
  angles :: Parser a -> Parser a
  angles p = lexeme $ between (char '<' <* anySpace) (anySpace *> char '>') p
  
  comma :: Parser ()
  comma = ignore (char ',' <* anySpace)
  
  -- Keywords
  reservedKeywords :: [String]
  reservedKeywords = [ "fn"
                     , "match"
                     , "case"
                     , "if"
                     , "else"
                     , "operator"
                     , "let"
                     , "class"
                     , "enum"
                     , "type"
                     ]
  
  checkKeyword :: String -> Parser String
  checkKeyword word =
    if word `elem` reservedKeywords
       then unexpected ("reserved keyword " ++ show word)
       else return word
  
  lcid :: Parser String
  lcid = lexeme . try $ (:) <$> lower <*> idSuffix >>= checkKeyword
  
  ucid :: Parser String
  ucid = lexeme . try $ (:) <$> upper <*> idSuffix
  
  idSuffix :: Parser String
  idSuffix = many (alphaNum <|> oneOf "_'")
  
  reserved :: String -> Parser ()
  reserved name = ignore . lexeme . try . string $ name
  
  reservedOp :: String -> Parser ()
  reservedOp name = ignore . lexeme . try . string $ name
  
  operator :: Parser String
  operator = lexeme . try . many1 . oneOf $ ":!#$%&*+./<=>?@\\^|-~"
  
  symbol :: String -> Parser ()
  symbol c = ignore . lexeme . try . string $ c
  
  -- Utils
  commaSep :: Parser a -> Parser [a]
  commaSep = flip sepEndBy comma
  
  commaSep1 :: Parser a -> Parser [a]
  commaSep1 = flip sepEndBy1 comma
  
  ignore :: Parser a -> Parser ()
  ignore p = p >> return ()
  
  -- From Parsec
  naturalOrFloat :: Parser (Either Integer Double)
  naturalOrFloat  = lexeme (natFloat) <?> "number"
  
  natural :: Parser Integer
  natural         = lexeme nat        <?> "natural"
  
  
  -- floats
  natFloat :: Parser (Either Integer Double)
  natFloat        = do{ _ <- char '0'
                      ; zeroNumFloat
                      }
                    <|> decimalFloat
  
  zeroNumFloat :: Parser (Either Integer Double)
  zeroNumFloat    =  do{ n <- hexadecimal <|> octal
                       ; return (Left n)
                       }
                  <|> decimalFloat
                  <|> fractFloat 0
                  <|> return (Left 0)
  
  decimalFloat :: Parser (Either Integer Double)
  decimalFloat    = do{ n <- decimal
                      ; option (Left n)
                               (fractFloat n)
                      }
  
  fractFloat :: Integer -> Parser (Either Integer Double)
  fractFloat n    = do{ f <- fractExponent n
                      ; return (Right f)
                      }
  
  fractExponent :: Integer -> Parser Double
  fractExponent n = do{ fract <- fraction
                      ; expo  <- option "" exponent'
                      ; readDouble (show n ++ fract ++ expo)
                      }
                  <|>
                    do{ expo <- exponent'
                      ; readDouble (show n ++ expo)
                      }
                    where
                      readDouble s =
                        case reads s of
                          [(x, "")] -> return x
                          _         -> parserZero
  
  fraction :: Parser String
  fraction        = do{ _ <- char '.'
                      ; digits <- many1 digit <?> "fraction"
                      ; return ('.' : digits)
                      }
                    <?> "fraction"
  
  exponent' :: Parser String
  exponent'       = do{ _ <- oneOf "eE"
                      ; sign' <- fmap (:[]) (oneOf "+-") <|> return ""
                      ; e <- decimal <?> "exponent"
                      ; return ('e' : sign' ++ show e)
                      }
                    <?> "exponent"
  
  
  -- integers and naturals
  nat :: Parser Integer
  nat             = zeroNumber <|> decimal
  
  zeroNumber :: Parser Integer
  zeroNumber      = do{ _ <- char '0'
                      ; hexadecimal <|> octal <|> decimal <|> return 0
                      }
                    <?> ""
  
  decimal, hexadecimal, octal :: Parser Integer
  decimal         = number 10 digit
  hexadecimal     = do{ _ <- oneOf "xX"; number 16 hexDigit }
  octal           = do{ _ <- oneOf "oO"; number 8 octDigit  }
  
  number :: Integer -> Parser Char -> Parser Integer
  number base baseDigit
      = do{ digits <- many1 baseDigit
          ; let n = foldl (\x d -> base*x + toInteger (digitToInt d)) 0 digits
          ; seq n (return n)
          }
  
  separator :: Parser ()
  separator = skipMany1 newline
  
  block :: Parser a -> Parser [a]
  block p = braces $ p `sepEndBy` separator
  