content: {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE StandaloneDeriving #-}
  {-# LANGUAGE TemplateHaskell #-}
  {-# OPTIONS_GHC -fno-warn-orphans #-}
  
  -- | Contains class instances and functions related to tokens
  module GLua.TokenTypes where
  
  import Data.Aeson.TH (deriveJSON)
  import Data.List (foldl', partition)
  import GLua.AG.Token (MToken (..), Token (..))
  import GLua.EncodingOptions (encodingOptions)
  import GLua.Position (LineColPos (..), Region (..))
  
  instance Show MToken where
    show (MToken _ tok) = show tok
  
  -- | Simple EQ instance. TODO: check for position equality
  instance Eq MToken where
    (MToken _ t1) == (MToken _ t2) = t1 == t2
  
  -- | Simple Ord instance. TODO: check for position Ord
  instance Ord MToken where
    compare (MToken _ t1) (MToken _ t2) = compare t1 t2
  
  mpos :: MToken -> Region
  mpos (MToken p _) = p
  
  mtok :: MToken -> Token
  mtok (MToken _ t) = t
  
  -- | Map function for an MToken
  mapMtok :: (Token -> a) -> MToken -> a
  mapMtok f (MToken _ t) = f t
  
  ----------------------------------------
  --  Correcting token positions
  ----------------------------------------
  customAdvanceChr :: LineColPos -> Char -> LineColPos
  customAdvanceChr (LineColPos line _ abs') '\n' = LineColPos (line + 1) 0 (abs' + 1)
  customAdvanceChr (LineColPos line pos' abs') _ = LineColPos line (pos' + 1) (abs' + 1)
  
  customAdvanceStr :: LineColPos -> String -> LineColPos
  customAdvanceStr = foldl' customAdvanceChr
  
  customAdvanceToken :: LineColPos -> Token -> LineColPos
  customAdvanceToken (LineColPos line pos' abs') t = let len = tokenSize t in LineColPos line (pos' + len) (abs' + len)
  
  -- | Simple show instance
  instance Show Token where
    show token = case token of
      Whitespace s -> s
      DashComment c -> "--" ++ c
      DashBlockComment d s -> let n = replicate d '=' in "--[" ++ n ++ '[' : s ++ ']' : n ++ "]"
      SlashComment c -> "//" ++ c
      SlashBlockComment s -> "/*" ++ s ++ "*/"
      Semicolon -> ";"
      TNumber n -> n
      DQString s -> "\"" ++ s ++ "\""
      SQString s -> "'" ++ s ++ "'"
      MLString s -> s
      TTrue -> "true"
      TFalse -> "false"
      Nil -> "nil"
      VarArg -> "..."
      Plus -> "+"
      Minus -> "-"
      Multiply -> "*"
      Divide -> "/"
      Modulus -> "%"
      Power -> "^"
      TEq -> "=="
      TNEq -> "~="
      TCNEq -> "!="
      TLEQ -> "<="
      TGEQ -> ">="
      TLT -> "<"
      TGT -> ">"
      Equals -> "="
      Concatenate -> ".."
      Colon -> ":"
      Dot -> "."
      Comma -> ","
      Hash -> "#"
      Not -> "not"
      CNot -> "!"
      And -> "and"
      CAnd -> "&&"
      Or -> "or"
      COr -> "||"
      Function -> "function"
      Local -> "local"
      If -> "if"
      Then -> "then"
      Elseif -> "elseif"
      Else -> "else"
      For -> "for"
      In -> "in"
      Do -> "do"
      While -> "while"
      Until -> "until"
      Repeat -> "repeat"
      Continue -> "continue"
      Break -> "break"
      Return -> "return"
      End -> "end"
      LRound -> "("
      RRound -> ")"
      LCurly -> "{"
      RCurly -> "}"
      LSquare -> "["
      RSquare -> "]"
      Label spaceBefore ident spaceAfter -> spaceBefore ++ ident ++ spaceAfter
      Identifier i -> i
  
  -- | Whether an mtoken is a comment
  isWhitespace :: MToken -> Bool
  isWhitespace = mapMtok $ \case
    Whitespace{} -> True
    _ -> False
  
  -- | Whether an mtoken is a comment
  isComment :: MToken -> Bool
  isComment = mapMtok $ \case
    DashComment{} -> True
    DashBlockComment{} -> True
    SlashComment{} -> True
    SlashBlockComment{} -> True
    _ -> False
  
  -- | Split the tokens by comments and other tokens
  splitComments :: [MToken] -> ([MToken], [MToken])
  splitComments = partition isComment
  
  -- | Extracts the label name out of the token, returns empty string when the token is not a label or
  -- identifier.
  tokenLabel :: MToken -> String
  tokenLabel = mapMtok $ \case
    Label _ ident _ -> ident
    Identifier ident -> ident
    _ -> ""
  
  -- | The size of a token in characters
  tokenSize :: Token -> Int
  tokenSize = \case
    Whitespace s -> length s
    DashComment c -> 2 + length c
    DashBlockComment d s -> 6 + length s + 2 * d
    SlashComment c -> length c + 2
    SlashBlockComment s -> length s + 2
    Semicolon -> 1
    TNumber n -> length n
    DQString s -> length s + 2
    SQString s -> length s + 2
    MLString s -> length s
    TTrue -> 4
    TFalse -> 5
    Nil -> 3
    VarArg -> 3
    Plus -> 1
    Minus -> 1
    Multiply -> 1
    Divide -> 1
    Modulus -> 1
    Power -> 1
    TEq -> 2
    TNEq -> 2
    TCNEq -> 2
    TLEQ -> 2
    TGEQ -> 2
    TLT -> 1
    TGT -> 1
    Equals -> 1
    Concatenate -> 2
    Colon -> 1
    Dot -> 1
    Comma -> 1
    Hash -> 1
    Not -> 3
    CNot -> 1
    And -> 3
    CAnd -> 2
    Or -> 2
    COr -> 2
    Function -> 8
    Local -> 5
    If -> 2
    Then -> 4
    Elseif -> 6
    Else -> 4
    For -> 3
    In -> 2
    Do -> 2
    While -> 5
    Until -> 5
    Repeat -> 6
    Continue -> 8
    Break -> 5
    Return -> 6
    End -> 3
    LRound -> 1
    RRound -> 1
    LCurly -> 1
    RCurly -> 1
    LSquare -> 1
    RSquare -> 1
    Label spaceBefore ident spaceAfter -> 2 + length spaceBefore + length ident + length spaceAfter + 2
    Identifier i -> length i
  
  $(deriveJSON encodingOptions ''Token)
  $(deriveJSON encodingOptions ''MToken)
  