{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Contains class instances and functions related to tokens
module GLua.TokenTypes where

import Data.Aeson (FromJSON, ToJSON)
import Data.List (foldl', partition)
import GHC.Generics (Generic)
import GLua.AG.Token (MToken (..), Token (..))
import GLua.Position (LineColPos (..), Region (..))

instance Show MToken where
  show :: MToken -> String
show (MToken Region
_ Token
tok) = forall a. Show a => a -> String
show Token
tok

-- | Simple EQ instance. TODO: check for position equality
instance Eq MToken where
  (MToken Region
_ Token
t1) == :: MToken -> MToken -> Bool
== (MToken Region
_ Token
t2) = Token
t1 forall a. Eq a => a -> a -> Bool
== Token
t2

-- | Simple Ord instance. TODO: check for position Ord
instance Ord MToken where
  compare :: MToken -> MToken -> Ordering
compare (MToken Region
_ Token
t1) (MToken Region
_ Token
t2) = forall a. Ord a => a -> a -> Ordering
compare Token
t1 Token
t2

deriving instance Generic MToken

instance ToJSON MToken
instance FromJSON MToken

instance ToJSON Token
instance FromJSON Token

mpos :: MToken -> Region
mpos :: MToken -> Region
mpos (MToken Region
p Token
_) = Region
p

mtok :: MToken -> Token
mtok :: MToken -> Token
mtok (MToken Region
_ Token
t) = Token
t

-- | Map function for an MToken
mapMtok :: (Token -> a) -> MToken -> a
mapMtok :: forall a. (Token -> a) -> MToken -> a
mapMtok Token -> a
f (MToken Region
_ Token
t) = Token -> a
f Token
t

----------------------------------------
--  Correcting token positions
----------------------------------------
customAdvanceChr :: LineColPos -> Char -> LineColPos
customAdvanceChr :: LineColPos -> Char -> LineColPos
customAdvanceChr (LineColPos Int
line Int
_ Int
abs') Char
'\n' = Int -> Int -> Int -> LineColPos
LineColPos (Int
line forall a. Num a => a -> a -> a
+ Int
1) Int
0 (Int
abs' forall a. Num a => a -> a -> a
+ Int
1)
customAdvanceChr (LineColPos Int
line Int
pos' Int
abs') Char
_ = Int -> Int -> Int -> LineColPos
LineColPos Int
line (Int
pos' forall a. Num a => a -> a -> a
+ Int
1) (Int
abs' forall a. Num a => a -> a -> a
+ Int
1)

customAdvanceStr :: LineColPos -> String -> LineColPos
customAdvanceStr :: LineColPos -> String -> LineColPos
customAdvanceStr = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' LineColPos -> Char -> LineColPos
customAdvanceChr

customAdvanceToken :: LineColPos -> Token -> LineColPos
customAdvanceToken :: LineColPos -> Token -> LineColPos
customAdvanceToken (LineColPos Int
line Int
pos' Int
abs') Token
t = let len :: Int
len = Token -> Int
tokenSize Token
t in Int -> Int -> Int -> LineColPos
LineColPos Int
line (Int
pos' forall a. Num a => a -> a -> a
+ Int
len) (Int
abs' forall a. Num a => a -> a -> a
+ Int
len)

-- | Simple show instance
instance Show Token where
  show :: Token -> String
show Token
token = case Token
token of
    Whitespace String
s -> String
s
    DashComment String
c -> String
"--" forall a. [a] -> [a] -> [a]
++ String
c
    DashBlockComment Int
d String
s -> let n :: String
n = forall a. Int -> a -> [a]
replicate Int
d Char
'=' in String
"--[" forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ Char
'[' forall a. a -> [a] -> [a]
: String
s forall a. [a] -> [a] -> [a]
++ Char
']' forall a. a -> [a] -> [a]
: String
n forall a. [a] -> [a] -> [a]
++ String
"]"
    SlashComment String
c -> String
"//" forall a. [a] -> [a] -> [a]
++ String
c
    SlashBlockComment String
s -> String
"/*" forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
"*/"
    Token
Semicolon -> String
";"
    TNumber String
n -> String
n
    DQString String
s -> String
"\"" forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
"\""
    SQString String
s -> String
"'" forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
"'"
    MLString String
s -> String
s
    Token
TTrue -> String
"true"
    Token
TFalse -> String
"false"
    Token
Nil -> String
"nil"
    Token
VarArg -> String
"..."
    Token
Plus -> String
"+"
    Token
Minus -> String
"-"
    Token
Multiply -> String
"*"
    Token
Divide -> String
"/"
    Token
Modulus -> String
"%"
    Token
Power -> String
"^"
    Token
TEq -> String
"=="
    Token
TNEq -> String
"~="
    Token
TCNEq -> String
"!="
    Token
TLEQ -> String
"<="
    Token
TGEQ -> String
">="
    Token
TLT -> String
"<"
    Token
TGT -> String
">"
    Token
Equals -> String
"="
    Token
Concatenate -> String
".."
    Token
Colon -> String
":"
    Token
Dot -> String
"."
    Token
Comma -> String
","
    Token
Hash -> String
"#"
    Token
Not -> String
"not"
    Token
CNot -> String
"!"
    Token
And -> String
"and"
    Token
CAnd -> String
"&&"
    Token
Or -> String
"or"
    Token
COr -> String
"||"
    Token
Function -> String
"function"
    Token
Local -> String
"local"
    Token
If -> String
"if"
    Token
Then -> String
"then"
    Token
Elseif -> String
"elseif"
    Token
Else -> String
"else"
    Token
For -> String
"for"
    Token
In -> String
"in"
    Token
Do -> String
"do"
    Token
While -> String
"while"
    Token
Until -> String
"until"
    Token
Repeat -> String
"repeat"
    Token
Continue -> String
"continue"
    Token
Break -> String
"break"
    Token
Return -> String
"return"
    Token
End -> String
"end"
    Token
LRound -> String
"("
    Token
RRound -> String
")"
    Token
LCurly -> String
"{"
    Token
RCurly -> String
"}"
    Token
LSquare -> String
"["
    Token
RSquare -> String
"]"
    Label String
spaceBefore String
ident String
spaceAfter -> String
spaceBefore forall a. [a] -> [a] -> [a]
++ String
ident forall a. [a] -> [a] -> [a]
++ String
spaceAfter
    Identifier String
i -> String
i

-- | Whether an mtoken is a comment
isWhitespace :: MToken -> Bool
isWhitespace :: MToken -> Bool
isWhitespace = forall a. (Token -> a) -> MToken -> a
mapMtok forall a b. (a -> b) -> a -> b
$ \case
  Whitespace{} -> Bool
True
  Token
_ -> Bool
False

-- | Whether an mtoken is a comment
isComment :: MToken -> Bool
isComment :: MToken -> Bool
isComment = forall a. (Token -> a) -> MToken -> a
mapMtok forall a b. (a -> b) -> a -> b
$ \case
  DashComment{} -> Bool
True
  DashBlockComment{} -> Bool
True
  SlashComment{} -> Bool
True
  SlashBlockComment{} -> Bool
True
  Token
_ -> Bool
False

-- | Split the tokens by comments and other tokens
splitComments :: [MToken] -> ([MToken], [MToken])
splitComments :: [MToken] -> ([MToken], [MToken])
splitComments = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition MToken -> Bool
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 :: MToken -> String
tokenLabel = forall a. (Token -> a) -> MToken -> a
mapMtok forall a b. (a -> b) -> a -> b
$ \case
  Label String
_ String
ident String
_ -> String
ident
  Identifier String
ident -> String
ident
  Token
_ -> String
""

-- | The size of a token in characters
tokenSize :: Token -> Int
tokenSize :: Token -> Int
tokenSize = \case
  Whitespace String
s -> forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s
  DashComment String
c -> Int
2 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
c
  DashBlockComment Int
d String
s -> Int
6 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
* Int
d
  SlashComment String
c -> forall (t :: * -> *) a. Foldable t => t a -> Int
length String
c forall a. Num a => a -> a -> a
+ Int
2
  SlashBlockComment String
s -> forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s forall a. Num a => a -> a -> a
+ Int
2
  Token
Semicolon -> Int
1
  TNumber String
n -> forall (t :: * -> *) a. Foldable t => t a -> Int
length String
n
  DQString String
s -> forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s forall a. Num a => a -> a -> a
+ Int
2
  SQString String
s -> forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s forall a. Num a => a -> a -> a
+ Int
2
  MLString String
s -> forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s
  Token
TTrue -> Int
4
  Token
TFalse -> Int
5
  Token
Nil -> Int
3
  Token
VarArg -> Int
3
  Token
Plus -> Int
1
  Token
Minus -> Int
1
  Token
Multiply -> Int
1
  Token
Divide -> Int
1
  Token
Modulus -> Int
1
  Token
Power -> Int
1
  Token
TEq -> Int
2
  Token
TNEq -> Int
2
  Token
TCNEq -> Int
2
  Token
TLEQ -> Int
2
  Token
TGEQ -> Int
2
  Token
TLT -> Int
1
  Token
TGT -> Int
1
  Token
Equals -> Int
1
  Token
Concatenate -> Int
2
  Token
Colon -> Int
1
  Token
Dot -> Int
1
  Token
Comma -> Int
1
  Token
Hash -> Int
1
  Token
Not -> Int
3
  Token
CNot -> Int
1
  Token
And -> Int
3
  Token
CAnd -> Int
2
  Token
Or -> Int
2
  Token
COr -> Int
2
  Token
Function -> Int
8
  Token
Local -> Int
5
  Token
If -> Int
2
  Token
Then -> Int
4
  Token
Elseif -> Int
6
  Token
Else -> Int
4
  Token
For -> Int
3
  Token
In -> Int
2
  Token
Do -> Int
2
  Token
While -> Int
5
  Token
Until -> Int
5
  Token
Repeat -> Int
6
  Token
Continue -> Int
8
  Token
Break -> Int
5
  Token
Return -> Int
6
  Token
End -> Int
3
  Token
LRound -> Int
1
  Token
RRound -> Int
1
  Token
LCurly -> Int
1
  Token
RCurly -> Int
1
  Token
LSquare -> Int
1
  Token
RSquare -> Int
1
  Label String
spaceBefore String
ident String
spaceAfter -> Int
2 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
spaceBefore forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
ident forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
spaceAfter forall a. Num a => a -> a -> a
+ Int
2
  Identifier String
i -> forall (t :: * -> *) a. Foldable t => t a -> Int
length String
i