content: module Token where
  
  import Control.Applicative (Alternative (..), optional, (<|>))
  import Data.Char (digitToInt, isAlpha, isAlphaNum, isDigit)
  import Data.Functor (($>))
  import Parser
  
  data Keyword
    = And
    | Class
    | Else
    | Fun
    | For
    | If
    | Or
    | Print
    | Return
    | Super
    | This
    | Var
    | While
    deriving (Show, Eq)
  
  data Single
    = LeftParen
    | RightParen
    | LeftBrace
    | RightBrace
    | Comma
    | Dot
    | Minus
    | Plus
    | Semicolon
    | Star
    | Slash
    | Newline
    deriving (Show, Eq)
  
  data Multi
    = Bang
    | BangEqual
    | Equal
    | EqualEqual
    | Greater
    | GreaterEqual
    | Less
    | LessEqual
    deriving (Show, Eq)
  
  data Whitespace
    = Space
    | CarriageReturn
    | Tab
    deriving (Show, Eq)
  
  data Number = Number
    { wholePart :: Int,
      fractionalPart :: Int
    }
    deriving (Show, Eq)
  
  data Literal
    = NumberLiteral Number
    | StringLiteral String
    | BooleanLiteral Bool
    | NilLiteral
    deriving (Show, Eq)
  
  type Ident = String
  
  data TokenType
    = SingleToken Single
    | MultiToken Multi
    | CommentToken String
    | WhitespaceToken Whitespace
    | IdentifierToken Ident
    | KeywordToken Keyword
    | LiteralToken Literal
    deriving (Show, Eq)
  
  data Token = Token
    { line :: Int,
      ty :: TokenType
    }
    deriving (Show, Eq)
  
  -- Token Parsing!
  
  type Code = (String, Int)
  
  helper :: (Char -> Bool) -> (Char -> Code -> (a, Code)) -> Parser Code a
  helper predicate action = Parser $ \(s, line) ->
    case s of
      (c : rest) | predicate c -> Just $ action c (rest, line)
      _ -> Nothing
  
  char :: Char -> Parser Code Char
  char c = satisfies (== c)
  
  peek :: (Char -> Bool) -> Parser Code ()
  peek p = helper p $ \x (xs, line) ->
    ((), (x : xs, line))
  
  satisfies :: (Char -> Bool) -> Parser Code Char
  satisfies p = helper p $ \x (xs, line) ->
    (x, (xs, if x == '\n' then line + 1 else line))
  
  string :: String -> Parser Code String
  string "" = pure ""
  string (x : xs) = (:) <$> char x <*> string xs
  
  single :: Parser Code Single
  single =
    char '(' $> LeftParen
      <|> char ')' $> RightParen
      <|> char '{' $> LeftBrace
      <|> char '}' $> RightBrace
      <|> char ',' $> Comma
      <|> char '.' $> Dot
      <|> (char '-' <* peek (not . isDigit)) $> Minus -- check not actually a negative number!
      <|> char '+' $> Plus
      <|> char ';' $> Semicolon
      <|> char '*' $> Star
  
  multi :: Parser Code Multi
  multi =
    (char '!' *> (char '=' $> BangEqual <|> pure Bang))
      <|> (char '>' *> (char '=' $> GreaterEqual <|> pure Greater))
      <|> (char '<' *> (char '=' $> LessEqual <|> pure Less))
      <|> (char '=' *> (char '=' $> EqualEqual <|> pure Equal))
  
  comment :: Parser Code String
  comment =
    string "//" *> many (satisfies (/= '\n')) <* char '\n'
  
  whitespace :: Parser Code Whitespace
  whitespace =
    char ' ' $> Space
      <|> char '\r' $> CarriageReturn
      <|> char '\t' $> Tab
  
  string' :: Parser Code String
  string' =
    char '"' *> many (satisfies (/= '"')) <* char '"'
  
  int :: Parser Code Int
  int = digitsToInt <$> some (satisfies isDigit)
    where
      digitsToInt = foldl (\num d -> num * 10 + digitToInt d) 0
  
  whole :: Parser Code Int
  whole = sign <$> optional (char '-') <*> int
    where
      sign c = case c of
        Just '-' -> negate
        _ -> id
  
  fractional :: Parser Code Int
  fractional = (char '.' *> int) <|> pure 0
  
  number :: Parser Code Number
  number = Number <$> whole <*> fractional
  
  keyword :: Parser Code Keyword
  keyword =
    ( string "and" $> And
        <|> string "class" $> Class
        <|> string "else" $> Else
        <|> string "for" $> For
        <|> string "fun" $> Fun
        <|> string "if" $> If
        <|> string "or" $> Or
        <|> string "print" $> Print
        <|> string "return" $> Return
        <|> string "super" $> Super
        <|> string "this" $> This
        <|> string "var" $> Var
        <|> string "while" $> While
    )
      <* peek (== ' ') -- keywords must be followed by space
  
  identifier :: Parser Code String
  identifier = (:) <$> satisfies isAlpha <*> many (satisfies isAlphaNum)
  
  literal :: Parser Code Literal
  literal =
    string "true" $> BooleanLiteral True
      <|> string "false" $> BooleanLiteral False
      <|> string "nil" $> NilLiteral
      <|> NumberLiteral <$> number
      <|> StringLiteral <$> string'
  
  ty' :: Parser Code TokenType
  ty' =
    SingleToken <$> single
      <|> MultiToken <$> multi
      <|> CommentToken <$> comment
      <|> char '/' $> SingleToken Slash
      <|> WhitespaceToken <$> whitespace
      <|> char '\n' $> SingleToken Newline
      <|> LiteralToken <$> literal
      <|> KeywordToken <$> keyword
      <|> IdentifierToken <$> identifier
  
  line' :: Parser Code Int
  line' = Parser $ \(s, l) -> Just (l, (s, l))
  
  token :: Parser Code Token
  token = Token <$> line' <*> ty'
  
  type Tokens = [Token]
  
  tokenise :: Code -> Maybe Tokens
  tokenise code =
    fmap
      ( filter
          ( \t -> case ty t of
              WhitespaceToken _ -> False
              _ -> True
          )
      )
      (consume token code)
  