{-# LANGUAGE MultiWayIf #-}

-- | Tokenizes an input stream to a list of 'Token's
--
-- Arithmetic examples:
--
-- >>> scan "1+2"
-- Right [Number 1.0,Operator "+",Number 2.0]
--
-- >>> scan "(3/2+(1.5*2)) + 4.95"
-- Right [OpenParen,Number 3.0,Operator "/",Number 2.0,Operator "+",OpenParen,Number 1.5,Operator "*",Number 2.0,CloseParen,CloseParen,Operator "+",Number 4.95]
--
-- >>> scan "9001*29.12"
-- Right [Number 9001.0,Operator "*",Number 29.12]
--
-- Examples with units:
--
-- >>> scan "2km [m]"
-- Right [Number 2.0,Identifier "km",OpenBracket,Identifier "m",CloseBracket]
--
-- Examples with variables:
--
-- >>> scan "a = 3, b = 2 -> a + b"
-- Right [Identifier "a",Equal,Number 3.0,Comma,Identifier "b",Equal,Number 2.0,Arrow,Identifier "a",Operator "+",Identifier "b"]
--
module Math.Haskellator.Internal.Lexer (Token (..), Tokens, scan) where

import Data.Char

import Math.Haskellator.Internal.Utils.Error

data Token = Number Double     -- ^ A number (integers are also represented as floats)
           | Operator String   -- ^ An operator
           | OpenParen         -- ^ Open parenthesis "("
           | CloseParen        -- ^ Close parenthesis ")"
           | OpenBracket       -- ^ Open bracket "["
           | CloseBracket      -- ^ Close bracket "]"
           | Identifier String -- ^ Identifier (e.g. variable and function name) or unit
           | Arrow             -- ^ Arrow "->"
           | Equal             -- ^ Single equal sign "="
           | Comma             -- ^ Comma ","
  deriving (Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
/= :: Token -> Token -> Bool
Eq, 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)

-- | A simple alias for the 'Token' stream
type Tokens = [Token]

-- | Tokenizes an input stream to a list of 'Token's
scan :: String              -- ^ The input stream
     -> Either Error Tokens -- ^ Error message or the list of tokens
scan :: String -> Either Error [Token]
scan []           = [Token] -> Either Error [Token]
forall a b. b -> Either a b
Right []
scan (Char
'(':String
xs)     = (Token
OpenParen Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:)    ([Token] -> [Token])
-> Either Error [Token] -> Either Error [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either Error [Token]
scan String
xs
scan (Char
')':String
xs)     = (Token
CloseParen Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:)   ([Token] -> [Token])
-> Either Error [Token] -> Either Error [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either Error [Token]
scan String
xs
scan (Char
'[':String
xs)     = (Token
OpenBracket Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:)  ([Token] -> [Token])
-> Either Error [Token] -> Either Error [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either Error [Token]
scan String
xs
scan (Char
']':String
xs)     = (Token
CloseBracket Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:) ([Token] -> [Token])
-> Either Error [Token] -> Either Error [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either Error [Token]
scan String
xs
scan (Char
'-':Char
'>':String
xs) = (Token
Arrow Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:)        ([Token] -> [Token])
-> Either Error [Token] -> Either Error [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either Error [Token]
scan String
xs
scan (Char
'+':String
xs)     = (String -> Token
Operator String
"+" Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:) ([Token] -> [Token])
-> Either Error [Token] -> Either Error [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either Error [Token]
scan String
xs
scan (Char
'-':String
xs)     = (String -> Token
Operator String
"-" Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:) ([Token] -> [Token])
-> Either Error [Token] -> Either Error [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either Error [Token]
scan String
xs
scan (Char
'*':String
xs)     = (String -> Token
Operator String
"*" Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:) ([Token] -> [Token])
-> Either Error [Token] -> Either Error [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either Error [Token]
scan String
xs
scan (Char
'/':String
xs)     = (String -> Token
Operator String
"/" Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:) ([Token] -> [Token])
-> Either Error [Token] -> Either Error [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either Error [Token]
scan String
xs
scan (Char
'^':String
xs)     = (String -> Token
Operator String
"^" Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:) ([Token] -> [Token])
-> Either Error [Token] -> Either Error [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either Error [Token]
scan String
xs
scan (Char
'=':String
xs)     = (Token
Equal Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:)        ([Token] -> [Token])
-> Either Error [Token] -> Either Error [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either Error [Token]
scan String
xs
scan (Char
',':String
xs)     = (Token
Comma Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:)        ([Token] -> [Token])
-> Either Error [Token] -> Either Error [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either Error [Token]
scan String
xs
scan (Char
x:String
xs)       = if | Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
x [Char
' ', Char
'\t', Char
'\r', Char
'\n'] -> String -> Either Error [Token]
scan String
xs
                       | Char -> Bool
isDigit Char
x -> String -> Either Error [Token]
scanNumber (Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:String
xs)
                       | Char -> Bool
isAlpha Char
x -> String -> Either Error [Token]
scanIdentifier (Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:String
xs)
                       | Bool
otherwise -> Error -> Either Error [Token]
forall a b. a -> Either a b
Left (Error -> Either Error [Token]) -> Error -> Either Error [Token]
forall a b. (a -> b) -> a -> b
$ Kind -> String -> Error
Error Kind
ScanError (String -> Error) -> String -> Error
forall a b. (a -> b) -> a -> b
$ String
"Unexpected character: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
x]

scanNumber :: String -> Either Error Tokens
scanNumber :: String -> Either Error [Token]
scanNumber String
xs = (Double -> Token
Number (String -> Double
forall a. Read a => String -> a
read String
num)Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:) ([Token] -> [Token])
-> Either Error [Token] -> Either Error [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either Error [Token]
scan String
rest
    where (String
num, String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\Char
x -> ((Char -> Bool) -> Bool) -> [Char -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ Char
x) [Char -> Bool
isDigit, (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')]) String
xs

scanIdentifier :: String -> Either Error Tokens
scanIdentifier :: String -> Either Error [Token]
scanIdentifier String
xs = (String -> Token
Identifier String
i Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:) ([Token] -> [Token])
-> Either Error [Token] -> Either Error [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either Error [Token]
scan String
rest
    where (String
i, String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isAlpha String
xs