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

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

import Data.Aeson
import Data.List
import GHC.Generics
import GLua.AG.Token
import Text.ParserCombinators.UU.BasicInstances

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 Eq LineColPos where
  (LineColPos Int
l Int
c Int
p) == :: LineColPos -> LineColPos -> Bool
== (LineColPos Int
l' Int
c' Int
p') = Int
l forall a. Eq a => a -> a -> Bool
== Int
l' Bool -> Bool -> Bool
&& Int
c forall a. Eq a => a -> a -> Bool
== Int
c' Bool -> Bool -> Bool
&& Int
p forall a. Eq a => a -> a -> Bool
== Int
p'

instance Ord LineColPos where
  compare :: LineColPos -> LineColPos -> Ordering
compare (LineColPos Int
l Int
c Int
_) (LineColPos Int
l' Int
c' Int
_) =
    forall a. Ord a => a -> a -> Ordering
compare Int
l Int
l' forall a. Monoid a => a -> a -> a
`mappend` forall a. Ord a => a -> a -> Ordering
compare Int
c Int
c'

instance ToJSON LineColPos where
  -- this generates a Value
  toJSON :: LineColPos -> Value
toJSON (LineColPos Int
line Int
col Int
p) =
    [Pair] -> Value
object [Key
"line" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
line, Key
"column" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
col, Key
"pos" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
p]

#if MIN_VERSION_aeson(0,10,0)
  -- this encodes directly to a bytestring Builder
  toEncoding :: LineColPos -> Encoding
toEncoding (LineColPos Int
line Int
col Int
p) =
    Series -> Encoding
pairs (Key
"line" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
line forall a. Semigroup a => a -> a -> a
<> Key
"column" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
col forall a. Semigroup a => a -> a -> a
<> Key
"pos" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
p)
#endif

instance FromJSON LineColPos where
  parseJSON :: Value -> Parser LineColPos
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"LineColPos" forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Int -> Int -> Int -> LineColPos
LineColPos
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"line"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"column"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pos"

instance Eq Region where
  Region LineColPos
s LineColPos
e == :: Region -> Region -> Bool
== Region LineColPos
s' LineColPos
e' = LineColPos
s forall a. Eq a => a -> a -> Bool
== LineColPos
s' Bool -> Bool -> Bool
&& LineColPos
e forall a. Eq a => a -> a -> Bool
== LineColPos
e'

instance Ord Region where
  compare :: Region -> Region -> Ordering
compare (Region LineColPos
s LineColPos
e) (Region LineColPos
s' LineColPos
e') =
    forall a. Ord a => a -> a -> Ordering
compare LineColPos
s LineColPos
s' forall a. Monoid a => a -> a -> a
`mappend` forall a. Ord a => a -> a -> Ordering
compare LineColPos
e LineColPos
e'

instance ToJSON Region
instance FromJSON Region

instance ToJSON Token
instance FromJSON Token

-- | Metatoken algebra
type MTokenAlgebra mtok = Region -> Token -> mtok

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

emptyRg :: Region
emptyRg :: Region
emptyRg = LineColPos -> LineColPos -> Region
Region (Int -> Int -> Int -> LineColPos
LineColPos Int
0 Int
0 Int
0) (Int -> Int -> Int -> LineColPos
LineColPos Int
0 Int
0 Int
0)

rgOr :: Region -> Region -> Region
rgOr :: Region -> Region -> Region
rgOr Region
l Region
r
  | Region
l forall a. Eq a => a -> a -> Bool
== Region
emptyRg = Region
r
  | Bool
otherwise = Region
l

----------------------------------------
--  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)

-- | Whether the first region ends strictly before the second region starts
before :: Region -> Region -> Bool
before :: Region -> Region -> Bool
before (Region LineColPos
_ (LineColPos Int
_ Int
_ Int
p)) (Region (LineColPos Int
_ Int
_ Int
p') LineColPos
_) = Int
p forall a. Ord a => a -> a -> Bool
< Int
p'

-- | Whether the first region ends before or on the same line as the second region
beforeOrOnLine :: Region -> Region -> Bool
beforeOrOnLine :: Region -> Region -> Bool
beforeOrOnLine (Region LineColPos
_ (LineColPos Int
l Int
_ Int
_)) (Region (LineColPos Int
l' Int
_ Int
_) LineColPos
_) = Int
l forall a. Ord a => a -> a -> Bool
<= Int
l'

-- | Whether the first region ends before the second region ends
beforeEnd :: Region -> Region -> Bool
beforeEnd :: Region -> Region -> Bool
beforeEnd (Region LineColPos
_ (LineColPos Int
_ Int
_ Int
p)) (Region LineColPos
_ (LineColPos Int
_ Int
_ Int
p')) = Int
p forall a. Ord a => a -> a -> Bool
< Int
p'

-- | Whether the first region ends before or on the same line as the END of the second region
beforeEndLine :: Region -> Region -> Bool
beforeEndLine :: Region -> Region -> Bool
beforeEndLine (Region LineColPos
_ (LineColPos Int
l Int
_ Int
_)) (Region LineColPos
_ (LineColPos Int
l' Int
_ Int
_)) = Int
l forall a. Ord a => a -> a -> Bool
<= Int
l'

rgStart :: Region -> LineColPos
rgStart :: Region -> LineColPos
rgStart (Region LineColPos
s LineColPos
_) = LineColPos
s

rgEnd :: Region -> LineColPos
rgEnd :: Region -> LineColPos
rgEnd (Region LineColPos
_ LineColPos
e) = LineColPos
e

-- | Returns a region that starts at the start of the first region
-- and ends BEFORE the start of the second region
upto :: Region -> Region -> Region
upto :: Region -> Region -> Region
upto Region
lr Region
rr = case (Region -> LineColPos
rgEnd Region
lr, Region -> LineColPos
rgStart Region
rr) of
  (LineColPos
_, LineColPos Int
0 Int
0 Int
0) -> Region
lr
  (LineColPos Int
l Int
c Int
_, LineColPos Int
l' Int
c' Int
_)
    | Int
l' forall a. Ord a => a -> a -> Bool
> Int
l Bool -> Bool -> Bool
|| (Int
l' forall a. Eq a => a -> a -> Bool
== Int
l Bool -> Bool -> Bool
&& Int
c' forall a. Ord a => a -> a -> Bool
> Int
c) -> Region
lr
    | Bool
otherwise -> LineColPos -> LineColPos -> Region
Region (Region -> LineColPos
rgStart Region
lr) (Region -> LineColPos
rgStart Region
rr)

-- | Fold over metatoken
foldMToken :: MTokenAlgebra t -> MToken -> t
foldMToken :: forall t. MTokenAlgebra t -> MToken -> t
foldMToken MTokenAlgebra t
alg (MToken Region
p Token
t) = MTokenAlgebra t
alg Region
p Token
t

-- | mFold: Apply a TokenAlgebra to an MToken
mFold :: TokenAlgebra a -> MToken -> a
mFold :: forall a. TokenAlgebra a -> MToken -> a
mFold TokenAlgebra a
alg = forall t. MTokenAlgebra t -> MToken -> t
foldMToken forall {p}. p -> Token -> a
f
  where
    f :: p -> Token -> a
f p
_ = forall t. TokenAlgebra t -> Token -> t
foldToken TokenAlgebra a
alg

-- | Huge token algebra
type TokenAlgebra token =
  ( ( -- Comments and whitespace
      String -> token
    , String -> token -- DashComment
    , Int -> String -> token -- DashBlockComment
    , String -> token -- SlashComment
    , String -> token -- SlashBlockComment
    , token -- Semicolon
    )
  , ( -- Constants
      String -> token -- TNumber
    , String -> token -- DQString
    , String -> token -- SQString
    , String -> token -- MLString
    , token -- TTrue
    , token -- TFalse
    , token -- Nil
    , token -- VarArg
    ) -- operators
  , ( token -- Plus
    , token -- Minus
    , token -- Multiply
    , token -- Divide
    , token -- Modulus
    , token -- Power
    , token -- TEq
    , token -- TNEq
    , token -- TCNEq
    , token -- TLEQ
    , token -- TGEQ
    , token -- TLT
    , token -- TGT
    , token -- Equals
    , token -- Concatenate
    , token -- Colon
    , token -- Dot
    , token -- Comma
    , token -- Hash
    , token -- Not
    , token -- CNot
    , token -- And
    , token -- CAnd
    , token -- Or
    , token -- COr
    )
  , ( -- Keywords
      token -- Function
    , token -- Local
    , token -- If
    , token -- Then
    , token -- Elseif
    , token -- Else
    , token -- For
    , token -- In
    , token -- Do
    , token -- While
    , token -- Until
    , token -- Repeat
    , token -- Continue
    , token -- Break
    , token -- Return
    , token -- End
    )
  , ( -- Brackets
      token -- LRound
    , token -- RRound
    , token -- LCurly
    , token -- RCurly
    , token -- LSquare
    , token -- RSquare
    )
  , ( -- Other
      String -> String -> String -> token -- Label
    , String -> token -- Identifier
    )
  )

-- | Fold over token definition
foldToken :: TokenAlgebra t -> Token -> t
foldToken :: forall t. TokenAlgebra t -> Token -> t
foldToken ((String -> t
tWhitespace, String -> t
tDashComment, Int -> String -> t
tDashBlockComment, String -> t
tSlashComment, String -> t
tSlashBlockComment, t
tSemicolon), (String -> t
tTNumber, String -> t
tDQString, String -> t
tSQString, String -> t
tMLString, t
tTTrue, t
tTFalse, t
tNil, t
tVarArg), (t
tPlus, t
tMinus, t
tMultiply, t
tDivide, t
tModulus, t
tPower, t
tTEq, t
tTNEq, t
tTCNEq, t
tTLEQ, t
tTGEQ, t
tTLT, t
tTGT, t
tEquals, t
tConcatenate, t
tColon, t
tDot, t
tComma, t
tHash, t
tNot, t
tCNot, t
tAnd, t
tCAnd, t
tOr, t
tCOr), (t
tFunction, t
tLocal, t
tIf, t
tThen, t
tElseif, t
tElse, t
tFor, t
tIn, t
tDo, t
tWhile, t
tUntil, t
tRepeat, t
tContinue, t
tBreak, t
tReturn, t
tEnd), (t
tLRound, t
tRRound, t
tLCurly, t
tRCurly, t
tLSquare, t
tRSquare), (String -> String -> String -> t
tLabel, String -> t
tIdentifier)) = Token -> t
fold
  where
    fold :: Token -> t
fold (Whitespace String
str) = String -> t
tWhitespace String
str
    fold (DashComment String
str) = String -> t
tDashComment String
str
    fold (DashBlockComment Int
depth String
str) = Int -> String -> t
tDashBlockComment Int
depth String
str
    fold (SlashComment String
str) = String -> t
tSlashComment String
str
    fold (SlashBlockComment String
str) = String -> t
tSlashBlockComment String
str
    fold (TNumber String
str) = String -> t
tTNumber String
str
    fold (Label String
whitespaceBefore String
str String
whitespaceAfter) = String -> String -> String -> t
tLabel String
whitespaceBefore String
str String
whitespaceAfter
    fold (Identifier String
str) = String -> t
tIdentifier String
str
    fold (DQString String
str) = String -> t
tDQString String
str
    fold (SQString String
str) = String -> t
tSQString String
str
    fold (MLString String
str) = String -> t
tMLString String
str
    fold Token
And = t
tAnd
    fold Token
CAnd = t
tCAnd
    fold Token
Break = t
tBreak
    fold Token
Do = t
tDo
    fold Token
Else = t
tElse
    fold Token
Elseif = t
tElseif
    fold Token
End = t
tEnd
    fold Token
TFalse = t
tTFalse
    fold Token
For = t
tFor
    fold Token
Function = t
tFunction
    fold Token
If = t
tIf
    fold Token
In = t
tIn
    fold Token
Local = t
tLocal
    fold Token
Nil = t
tNil
    fold Token
Not = t
tNot
    fold Token
CNot = t
tCNot
    fold Token
Or = t
tOr
    fold Token
COr = t
tCOr
    fold Token
Repeat = t
tRepeat
    fold Token
Continue = t
tContinue
    fold Token
Return = t
tReturn
    fold Token
Then = t
tThen
    fold Token
TTrue = t
tTTrue
    fold Token
Until = t
tUntil
    fold Token
While = t
tWhile
    fold Token
Plus = t
tPlus
    fold Token
Minus = t
tMinus
    fold Token
Multiply = t
tMultiply
    fold Token
Divide = t
tDivide
    fold Token
Modulus = t
tModulus
    fold Token
Power = t
tPower
    fold Token
Hash = t
tHash
    fold Token
TEq = t
tTEq
    fold Token
TNEq = t
tTNEq
    fold Token
TCNEq = t
tTCNEq
    fold Token
TLEQ = t
tTLEQ
    fold Token
TGEQ = t
tTGEQ
    fold Token
TLT = t
tTLT
    fold Token
TGT = t
tTGT
    fold Token
Equals = t
tEquals
    fold Token
LRound = t
tLRound
    fold Token
RRound = t
tRRound
    fold Token
LCurly = t
tLCurly
    fold Token
RCurly = t
tRCurly
    fold Token
LSquare = t
tLSquare
    fold Token
RSquare = t
tRSquare
    fold Token
Semicolon = t
tSemicolon
    fold Token
Colon = t
tColon
    fold Token
Comma = t
tComma
    fold Token
Dot = t
tDot
    fold Token
Concatenate = t
tConcatenate
    fold Token
VarArg = t
tVarArg

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

-- | Whether an mtoken is a comment
isWhitespace :: MToken -> Bool
isWhitespace :: MToken -> Bool
isWhitespace = forall a. TokenAlgebra a -> MToken -> a
mFold ((forall a b. a -> b -> a
const Bool
True, forall a b. a -> b -> a
const Bool
False, \Int
_ String
_ -> Bool
False, forall a b. a -> b -> a
const Bool
False, forall a b. a -> b -> a
const Bool
False, Bool
False), (forall a b. a -> b -> a
const Bool
False, forall a b. a -> b -> a
const Bool
False, forall a b. a -> b -> a
const Bool
False, forall a b. a -> b -> a
const Bool
False, Bool
False, Bool
False, Bool
False, Bool
False), (Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False), (Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False), (Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False), (\String
_ String
_ String
_ -> Bool
False, forall a b. a -> b -> a
const Bool
False))

-- | Whether an mtoken is a comment
isComment :: MToken -> Bool
isComment :: MToken -> Bool
isComment = forall a. TokenAlgebra a -> MToken -> a
mFold ((forall a b. a -> b -> a
const Bool
False, forall a b. a -> b -> a
const Bool
True, \Int
_ String
_ -> Bool
True, forall a b. a -> b -> a
const Bool
True, forall a b. a -> b -> a
const Bool
True, Bool
False), (forall a b. a -> b -> a
const Bool
False, forall a b. a -> b -> a
const Bool
False, forall a b. a -> b -> a
const Bool
False, forall a b. a -> b -> a
const Bool
False, Bool
False, Bool
False, Bool
False, Bool
False), (Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False), (Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False), (Bool
False, Bool
False, Bool
False, Bool
False, Bool
False, Bool
False), (\String
_ String
_ String
_ -> Bool
False, forall a b. a -> b -> a
const 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

tokenLabel :: MToken -> String
tokenLabel :: MToken -> String
tokenLabel = forall a. TokenAlgebra a -> MToken -> a
mFold ((forall a b. a -> b -> a
const String
"", forall a b. a -> b -> a
const String
"", \Int
_ String
_ -> String
"", forall a b. a -> b -> a
const String
"", forall a b. a -> b -> a
const String
"", String
""), (forall a b. a -> b -> a
const String
"", forall a b. a -> b -> a
const String
"", forall a b. a -> b -> a
const String
"", forall a b. a -> b -> a
const String
"", String
"", String
"", String
"", String
""), (String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
""), (String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
"", String
""), (String
"", String
"", String
"", String
"", String
"", String
""), (\String
_ String
ident String
_ -> String
ident, forall a. a -> a
id))

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

isSingleLineComment :: Token -> Bool
isSingleLineComment :: Token -> Bool
isSingleLineComment = \case
  DashComment String
_ -> Bool
True
  SlashComment String
_ -> Bool
True
  Token
_ -> Bool
False