module Lexer
  ( Token (..),
    lexer,
  )
where

import Data.Char (isDigit, isSpace)

data Token
  = TokenLet
  | TokenType
  | TokenTypeof
  | TokenIn
  | TokenInt Integer
  | TokenBool Bool
  | TokenString String
  | TokenLiteral String
  | TokenQuote
  | TokenFatArrow
  | TokenArrow
  | TokenEq
  | TokenPlus
  | TokenMinus
  | TokenTimes
  | TokenDiv
  | TokenOB
  | TokenCB
  | TokenColon
  | TokenOr
  | TokenAnd
  | TokenPipe
  | TokenAmpersand
  | TokenIf
  | TokenThen
  | TokenElse
  | TokenLT
  | TokenGT
  deriving (Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Token -> ShowS
showsPrec :: Int -> Token -> ShowS
$cshow :: Token -> String
show :: Token -> String
$cshowList :: [Token] -> ShowS
showList :: [Token] -> ShowS
Show)

lexer :: String -> [Token]
lexer :: String -> [Token]
lexer (Char
'/' : Char
'/' : String
cs) = String -> [Token]
lexComment String
cs
lexer (Char
'=' : Char
'>' : String
cs) = Token
TokenFatArrow Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
cs
lexer (Char
'-' : Char
'>' : String
cs) = Token
TokenArrow Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
cs
lexer (Char
':' : String
cs) = Token
TokenColon Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
cs
lexer (Char
'"' : String
cs) = Token
TokenQuote Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexStr String
cs
lexer (Char
'=' : String
cs) = Token
TokenEq Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
cs
lexer (Char
'+' : String
cs) = Token
TokenPlus Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
cs
lexer (Char
'-' : String
cs) = Token
TokenMinus Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
cs
lexer (Char
'*' : String
cs) = Token
TokenTimes Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
cs
lexer (Char
'/' : String
cs) = Token
TokenDiv Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
cs
lexer (Char
'(' : String
cs) = Token
TokenOB Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
cs
lexer (Char
')' : String
cs) = Token
TokenCB Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
cs
lexer (Char
'|' : Char
'|' : String
cs) = Token
TokenOr Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
cs
lexer (Char
'|' : String
cs) = Token
TokenPipe Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
cs
lexer (Char
'&' : Char
'&' : String
cs) = Token
TokenAnd Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
cs
lexer (Char
'&' : String
cs) = Token
TokenAmpersand Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
cs
lexer (Char
'<' : String
cs) = Token
TokenLT Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
cs
lexer (Char
'>' : String
cs) = Token
TokenGT Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
cs
lexer (Char
c : String
cs)
  | Char -> Bool
isSpace Char
c = String -> [Token]
lexer String
cs
  | Char -> Bool
isDigit Char
c = String -> [Token]
lexNum (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
cs)
  | Bool
otherwise = String -> [Token]
lexLiteral (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
cs)
lexer String
_ = []

lexNum :: String -> [Token]
lexNum :: String -> [Token]
lexNum String
cs = Integer -> Token
TokenInt (String -> Integer
forall a. Read a => String -> a
read String
num) Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
rest
  where
    (String
num, String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
cs

lexStr :: String -> [Token]
lexStr :: String -> [Token]
lexStr String
cs = String -> Token
TokenString String
c Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Token
TokenQuote Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
lexer (String -> [Token]) -> String -> [Token]
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. HasCallStack => [a] -> [a]
tail String
rest)
  where
    (String
c, String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\Char
c' -> Char
c' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"') String
cs

lexLiteral :: String -> [Token]
lexLiteral :: String -> [Token]
lexLiteral String
cs =
  case String
literal of
    String
"let" -> Token
TokenLet Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
rest
    String
"type" -> Token
TokenType Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
rest
    String
"typeof" -> Token
TokenTypeof Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
rest
    String
"in" -> Token
TokenIn Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
rest
    String
"if" -> Token
TokenIf Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
rest
    String
"then" -> Token
TokenThen Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
rest
    String
"else" -> Token
TokenElse Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
rest
    String
"True" -> Bool -> Token
TokenBool Bool
True Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
rest
    String
"False" -> Bool -> Token
TokenBool Bool
False Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
rest
    String
_ -> String -> Token
TokenLiteral String
literal Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
lexer String
rest
  where
    (String
literal, String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\Char
c -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c String
specialCharacters) String
cs
    specialCharacters :: String
specialCharacters = [Char
':', Char
' ', Char
'\n', Char
'(', Char
')', Char
'=', Char
'*', Char
'/', Char
'-', Char
'+', Char
'"', Char
'|', Char
'&', Char
'>', Char
'<']

lexComment :: String -> [Token]
lexComment :: String -> [Token]
lexComment String
cs = String -> [Token]
lexer String
rest
  where
    (String
_, String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
cs