{-
-- EPITECH PROJECT, 2023
-- Parse.hs
-- File description:
-- Parse
-}
{-# LANGUAGE InstanceSigs #-}

module Parse (
    Parser (..),
    parseChar,
    parseOr,
    parseAnd,
    parseAndWith,
    parseMany,
    parseSome,
    parseUInt,
    parseInt,
    parseAnyChar,
    parseList,
    parseString,
    parseSign,
    parseDigit,
    parseBool,
    parseAst,
    parseElem,
    parseValue,
    parseLobster,
    parseAnyString,
    parseCmpString,
    parseDefineValue,
    parseProduct,
    parseSum,
    parseExpr,
    parseTrue,
    parseFalse,
    parseAstString,
    parseWhiteSpace,
    errorParsing,
    parseDefineFn,
    parseLambda,
    parseCond,
    parseFunctionValue,
    parseBracket,
    parseComment
) where

import qualified AST
import Control.Applicative
import Data.Maybe

type Position = (Int, Int)

data Parser a = Parser {
    forall a.
Parser a
-> Position -> String -> Either String (a, String, Position)
runParser :: Position -> String -> Either String (a, String, Position)
}

data Token =  Number Int
            | Sym String
            | Identifier String
    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, 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)


-- | Instance Functor of the data Parser
instance Functor Parser where
    fmap :: forall a b. (a -> b) -> Parser a -> Parser b
fmap a -> b
fct Parser a
parser =
        (Position -> String -> Either String (b, String, Position))
-> Parser b
forall a.
(Position -> String -> Either String (a, String, Position))
-> Parser a
Parser
        (
            \Position
pos String
s -> case Parser a
-> Position -> String -> Either String (a, String, Position)
forall a.
Parser a
-> Position -> String -> Either String (a, String, Position)
runParser Parser a
parser Position
pos String
s  of
                Left String
err -> String -> Either String (b, String, Position)
forall a b. a -> Either a b
Left String
err
                Right (a
a, String
b, Position
c) -> (b, String, Position) -> Either String (b, String, Position)
forall a b. b -> Either a b
Right (a -> b
fct a
a, String
b, Position
c)
        )

-- | Instance Applicative of the data Parser
instance Applicative Parser where
    pure :: forall a. a -> Parser a
pure a
result = (Position -> String -> Either String (a, String, Position))
-> Parser a
forall a.
(Position -> String -> Either String (a, String, Position))
-> Parser a
Parser (\Position
pos String
s -> (a, String, Position) -> Either String (a, String, Position)
forall a b. b -> Either a b
Right (a
result, String
s, Position
pos))

    <*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
(<*>) Parser (a -> b)
parserA Parser a
parserB =
        (Position -> String -> Either String (b, String, Position))
-> Parser b
forall a.
(Position -> String -> Either String (a, String, Position))
-> Parser a
Parser
        (
            \Position
pos String
s -> case Parser (a -> b)
-> Position -> String -> Either String (a -> b, String, Position)
forall a.
Parser a
-> Position -> String -> Either String (a, String, Position)
runParser Parser (a -> b)
parserA Position
pos String
s of
                Left String
err -> String -> Either String (b, String, Position)
forall a b. a -> Either a b
Left String
err
                Right (a -> b
a, String
b, Position
c) -> case Parser a
-> Position -> String -> Either String (a, String, Position)
forall a.
Parser a
-> Position -> String -> Either String (a, String, Position)
runParser Parser a
parserB Position
c String
b of
                    Left String
err' -> String -> Either String (b, String, Position)
forall a b. a -> Either a b
Left String
err'
                    Right (a
a', String
b', Position
c') -> (b, String, Position) -> Either String (b, String, Position)
forall a b. b -> Either a b
Right (a -> b
a a
a', String
b', Position
c')
        )

-- | Instance Alternative of the data Parser
instance Alternative Parser where
    empty :: forall a. Parser a
empty = (Position -> String -> Either String (a, String, Position))
-> Parser a
forall a.
(Position -> String -> Either String (a, String, Position))
-> Parser a
Parser (\Position
_ String
_ -> String -> Either String (a, String, Position)
forall a b. a -> Either a b
Left String
"Error on parsing")
    <|> :: forall a. Parser a -> Parser a -> Parser a
(<|>) Parser a
parserA Parser a
parserB =
        (Position -> String -> Either String (a, String, Position))
-> Parser a
forall a.
(Position -> String -> Either String (a, String, Position))
-> Parser a
Parser
        (
            \Position
pos String
s -> case Parser a
-> Position -> String -> Either String (a, String, Position)
forall a.
Parser a
-> Position -> String -> Either String (a, String, Position)
runParser Parser a
parserA Position
pos String
s of
                Left String
_ -> Parser a
-> Position -> String -> Either String (a, String, Position)
forall a.
Parser a
-> Position -> String -> Either String (a, String, Position)
runParser Parser a
parserB Position
pos String
s
                Either String (a, String, Position)
result -> Either String (a, String, Position)
result
        )


-- | Instance Monad of the data Parser
instance Monad Parser where
    (>>=) :: Parser a -> (a -> Parser b) -> Parser b
    Parser a
a >>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
>>= a -> Parser b
b =
        (Position -> String -> Either String (b, String, Position))
-> Parser b
forall a.
(Position -> String -> Either String (a, String, Position))
-> Parser a
Parser
        (
            \Position
pos String
s -> case Parser a
-> Position -> String -> Either String (a, String, Position)
forall a.
Parser a
-> Position -> String -> Either String (a, String, Position)
runParser Parser a
a Position
pos String
s of
                Left String
err -> String -> Either String (b, String, Position)
forall a b. a -> Either a b
Left String
err
                Right (a
res, String
s', Position
pos') -> Parser b
-> Position -> String -> Either String (b, String, Position)
forall a.
Parser a
-> Position -> String -> Either String (a, String, Position)
runParser (a -> Parser b
b a
res) Position
pos' String
s'
        )

errorParsing :: (Int, Int) -> String
errorParsing :: Position -> String
errorParsing (Int
row, Int
col) = String
"Error on parsing on '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
row String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
col String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"

startCharacter :: String
startCharacter :: String
startCharacter = [Char
'a'..Char
'z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'A'..Char
'Z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_"

lobsterCharacter :: String
lobsterCharacter :: String
lobsterCharacter = String
startCharacter String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'0'..Char
'9']

-- | Parse a character c
-- Takes the character that need to be parsed
-- Returns a data Parser that contain the character and the rest of the string
parseChar :: Char -> Parser Char
parseChar :: Char -> Parser Char
parseChar Char
c = (Position -> String -> Either String (Char, String, Position))
-> Parser Char
forall a.
(Position -> String -> Either String (a, String, Position))
-> Parser a
Parser (Char
-> Position -> String -> Either String (Char, String, Position)
f Char
c)
    where
        f :: Char -> Position -> String -> Either String (Char, String, Position)
        f :: Char
-> Position -> String -> Either String (Char, String, Position)
f Char
'\n' (Int
row, Int
col) (Char
x:String
xs)
            | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' = (Char, String, Position) -> Either String (Char, String, Position)
forall a b. b -> Either a b
Right (Char
'\n', String
xs, (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
0))
            | Bool
otherwise = String -> Either String (Char, String, Position)
forall a b. a -> Either a b
Left (Position -> String
errorParsing (Int
row, Int
col))
        f Char
char (Int
row, Int
col) (Char
x:String
xs)
            | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
char = (Char, String, Position) -> Either String (Char, String, Position)
forall a b. b -> Either a b
Right (Char
char, String
xs, (Int
row, Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
            | Bool
otherwise = String -> Either String (Char, String, Position)
forall a b. a -> Either a b
Left (Position -> String
errorParsing (Int
row, Int
col))
        f Char
_ (Int
row, Int
col) String
_ = String -> Either String (Char, String, Position)
forall a b. a -> Either a b
Left (Position -> String
errorParsing (Int
row, Int
col))

-- | Parse with the first or the second parser
-- Takes two parsers
-- Returns either the first parser or the second parser
parseOr :: Parser a -> Parser a -> Parser a
parseOr :: forall a. Parser a -> Parser a -> Parser a
parseOr Parser a
parserA Parser a
parserB = Parser a
parserA Parser a -> Parser a -> Parser a
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser a
parserB

-- | Parse with the first and the second parser
-- Takes two parsers
-- Returns either the first parser then use result for the second parser
parseAnd :: Parser a -> Parser b -> Parser (a, b)
parseAnd :: forall a b. Parser a -> Parser b -> Parser (a, b)
parseAnd Parser a
parserA Parser b
parserB = Parser a
parserA Parser a -> (a -> Parser (a, b)) -> Parser (a, b)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
resA -> Parser b
parserB Parser b -> (b -> Parser (a, b)) -> Parser (a, b)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
resB -> (a, b) -> Parser (a, b)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
resA, b
resB)

-- | Parse with function after the two parsers
-- Takes two parsers and a fh (\x _ -> x) unction
-- Returns the result of the function with the result of the parseAnd
parseAndWith :: (a -> b -> c) -> Parser a -> Parser b -> Parser c
parseAndWith :: forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
parseAndWith a -> b -> c
f Parser a
parserA Parser b
parserB = Parser a -> Parser b -> Parser (a, b)
forall a b. Parser a -> Parser b -> Parser (a, b)
parseAnd Parser a
parserA Parser b
parserB Parser (a, b) -> ((a, b) -> Parser c) -> Parser c
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(a
a, b
b) -> c -> Parser c
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b -> c
f a
a b
b)

-- | Parse with a parser
-- Takes a parser
-- Returns the application of the parser (if nothing, returns an empty list)
parseMany :: Parser a -> Parser [a]
parseMany :: forall a. Parser a -> Parser [a]
parseMany Parser a
parserA = (Position -> String -> Either String ([a], String, Position))
-> Parser [a]
forall a.
(Position -> String -> Either String (a, String, Position))
-> Parser a
Parser (Parser a
-> Position -> String -> Either String ([a], String, Position)
forall a.
Parser a
-> Position -> String -> Either String ([a], String, Position)
f Parser a
parserA)
    where
        f :: Parser a -> Position -> String -> Either String ([a], String, Position)
        f :: forall a.
Parser a
-> Position -> String -> Either String ([a], String, Position)
f Parser a
parser Position
pos String
s = case Parser a
-> Position -> String -> Either String (a, String, Position)
forall a.
Parser a
-> Position -> String -> Either String (a, String, Position)
runParser Parser a
parser Position
pos String
s of
            Left String
_ -> ([a], String, Position) -> Either String ([a], String, Position)
forall a b. b -> Either a b
Right ([], String
s, Position
pos)
            Right (a
res, String
s', Position
pos') -> case Parser [a]
-> Position -> String -> Either String ([a], String, Position)
forall a.
Parser a
-> Position -> String -> Either String (a, String, Position)
runParser (Parser a -> Parser [a]
forall a. Parser a -> Parser [a]
parseMany Parser a
parser) Position
pos' String
s' of
                Left String
_ -> ([a], String, Position) -> Either String ([a], String, Position)
forall a b. b -> Either a b
Right ([a
res], String
s', Position
pos')
                Right ([a]
res', String
s'', Position
pos'') -> ([a], String, Position) -> Either String ([a], String, Position)
forall a b. b -> Either a b
Right (a
res a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
res', String
s'', Position
pos'')

-- | Parse with a parser
-- Takes a parser
-- Returns the application of the parser at least one time or Returns Nothing
parseSome :: Parser a -> Parser [a]
parseSome :: forall a. Parser a -> Parser [a]
parseSome Parser a
parser = (:) (a -> [a] -> [a]) -> Parser a -> Parser ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
parser Parser ([a] -> [a]) -> Parser [a] -> Parser [a]
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a -> Parser [a]
forall a. Parser a -> Parser [a]
parseMany Parser a
parser

-- | Return a data Parser that parse a UInt
parseUInt :: Parser Int
parseUInt :: Parser Int
parseUInt = Parser Char -> Parser String
forall a. Parser a -> Parser [a]
parseSome Parser Char
parseDigit Parser String -> (String -> Parser Int) -> Parser Int
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
value -> Int -> Parser Int
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Int
forall a. Read a => String -> a
read String
value :: Int)

-- | Return a data Parser that parse a '-' or '+'
parseSign :: Parser Char
parseSign :: Parser Char
parseSign = Char -> Parser Char
parseChar Char
'-' Parser Char -> Parser Char -> Parser Char
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Char
parseChar Char
'+'

-- | Return a data Parser that parse a digit
parseDigit :: Parser Char
parseDigit :: Parser Char
parseDigit = String -> Parser Char
parseAnyChar [Char
'0'..Char
'9']

-- | Return a data Parser that parse a Int
parseInt :: Parser Int
parseInt :: Parser Int
parseInt = (Position -> String -> Either String (Int, String, Position))
-> Parser Int
forall a.
(Position -> String -> Either String (a, String, Position))
-> Parser a
Parser Position -> String -> Either String (Int, String, Position)
f
    where
        f :: Position -> String -> Either String (Int, String, Position)
        f :: Position -> String -> Either String (Int, String, Position)
f Position
pos (Char
'-':String
xs) = Parser Int
-> Position -> String -> Either String (Int, String, Position)
forall a.
Parser a
-> Position -> String -> Either String (a, String, Position)
runParser ((\Int
x -> -Int
x) (Int -> Int) -> Parser Int -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
parseUInt) Position
pos String
xs
        f Position
pos String
s = Parser Int
-> Position -> String -> Either String (Int, String, Position)
forall a.
Parser a
-> Position -> String -> Either String (a, String, Position)
runParser Parser Int
parseUInt Position
pos String
s

parseWhiteSpace :: Parser [Char]
parseWhiteSpace :: Parser String
parseWhiteSpace = Parser Char -> Parser String
forall a. Parser a -> Parser [a]
parseMany (String -> Parser Char
parseAnyChar String
"\n\t " Parser Char -> Parser Char -> Parser Char
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Char
parseComment)

-- | Parse with a parser and, if possible with a space
-- Return a Parser that parse element with the given parser and, if possible with multiple space
parseElem :: Parser a -> Parser a
parseElem :: forall a. Parser a -> Parser a
parseElem Parser a
parser = (a -> String -> a) -> Parser a -> Parser String -> Parser a
forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
parseAndWith a -> String -> a
forall a b. a -> b -> a
const Parser a
parser Parser String
parseWhiteSpace Parser a -> Parser a -> Parser a
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser a
parser


-- | Return a data Parser that parse a String
parseString :: Parser String
parseString :: Parser String
parseString = do String
value <- Parser String
parseWhiteSpace Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Char -> Parser String
forall a. Parser a -> Parser [a]
parseSome (String -> Parser Char
parseAnyChar String
startCharacter)
                 Maybe String
res <- Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Char -> Parser String
forall a. Parser a -> Parser [a]
parseMany (String -> Parser Char
parseAnyChar String
lobsterCharacter) Parser String -> (String -> Parser String) -> Parser String
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
res' -> String -> Parser String
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
value String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
res') Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
parseWhiteSpace)
                 String -> Parser String
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Parser String) -> String -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
value Maybe String
res

-- | Return a data Parser that parse a String as a Symbol
parseAstString :: Parser AST.Ast
parseAstString :: Parser Ast
parseAstString = String -> Ast
AST.String (String -> Ast) -> Parser String -> Parser Ast
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
parseChar Char
'"' Parser Char -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String -> Parser String
forall a. Parser a -> Parser a
parseElem Parser String
parseString Parser String -> Parser Char -> Parser String
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
parseChar Char
'"')

parseExpr :: Parser AST.Ast
parseExpr :: Parser Ast
parseExpr = Parser Ast
parseCombinatorOperator

parseCombinatorOperator :: Parser AST.Ast
parseCombinatorOperator :: Parser Ast
parseCombinatorOperator = do Ast
res <- Parser Ast
parseBoolOperator
                             Maybe Ast
res' <- Parser Ast -> Parser (Maybe Ast)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser String
parseWhiteSpace Parser String -> Parser Char -> Parser Char
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Char
parseChar Char
'$'
                                            Parser Char -> (Char -> Parser Ast) -> Parser Ast
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
res' -> Parser Ast
parseCombinatorOperator
                                                Parser Ast -> (Ast -> Parser Ast) -> Parser Ast
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ast
res'' -> Ast -> Parser Ast
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ast -> Parser Ast) -> Ast -> Parser Ast
forall a b. (a -> b) -> a -> b
$ String -> [Ast] -> Ast
AST.Call [Char
res'] [Ast
res, Ast
res''])
                             Ast -> Parser Ast
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ast -> Parser Ast) -> Ast -> Parser Ast
forall a b. (a -> b) -> a -> b
$ Ast -> Maybe Ast -> Ast
forall a. a -> Maybe a -> a
fromMaybe Ast
res Maybe Ast
res'

parseBoolOperator :: Parser AST.Ast
parseBoolOperator :: Parser Ast
parseBoolOperator = do Ast
res <- Parser Ast
parseCompOperator
                       Maybe Ast
res' <- Parser Ast -> Parser (Maybe Ast)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> Parser String
parseAnyString String
"&&" Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                         String -> Parser String
parseAnyString String
"||" Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                         String -> Parser String
parseAnyString String
"^^"
                                            Parser String -> (String -> Parser Ast) -> Parser Ast
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
res' -> Parser Ast
parseBoolOperator
                                                Parser Ast -> (Ast -> Parser Ast) -> Parser Ast
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ast
res'' -> Ast -> Parser Ast
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ast -> Parser Ast) -> Ast -> Parser Ast
forall a b. (a -> b) -> a -> b
$ String -> [Ast] -> Ast
AST.Call String
res' [Ast
res, Ast
res''])
                       Ast -> Parser Ast
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ast -> Parser Ast) -> Ast -> Parser Ast
forall a b. (a -> b) -> a -> b
$ Ast -> Maybe Ast -> Ast
forall a. a -> Maybe a -> a
fromMaybe Ast
res Maybe Ast
res'

parseCompOperator :: Parser AST.Ast
parseCompOperator :: Parser Ast
parseCompOperator = do Ast
res <- Parser Ast
parseSum
                       Maybe Ast
res' <- Parser Ast -> Parser (Maybe Ast)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser String
parseWhiteSpace Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser String
parseAnyString String
"==" Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                         Parser String
parseWhiteSpace Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser String
parseAnyString String
">=" Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                         Parser String
parseWhiteSpace Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser String
parseAnyString String
"!=" Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                         Parser String
parseWhiteSpace Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser String
parseAnyString String
"<=" Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                         Parser String
parseWhiteSpace Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser String
parseAnyString String
">" Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                         Parser String
parseWhiteSpace Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser String
parseAnyString String
"<"
                                            Parser String -> (String -> Parser Ast) -> Parser Ast
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
res' -> Parser Ast
parseCompOperator
                                                Parser Ast -> (Ast -> Parser Ast) -> Parser Ast
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ast
res'' -> Ast -> Parser Ast
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ast -> Parser Ast) -> Ast -> Parser Ast
forall a b. (a -> b) -> a -> b
$ String -> [Ast] -> Ast
AST.Call String
res' [Ast
res, Ast
res''])
                       Ast -> Parser Ast
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ast -> Parser Ast) -> Ast -> Parser Ast
forall a b. (a -> b) -> a -> b
$ Ast -> Maybe Ast -> Ast
forall a. a -> Maybe a -> a
fromMaybe Ast
res Maybe Ast
res'

parseSum :: Parser AST.Ast
parseSum :: Parser Ast
parseSum = do Ast
res <- Parser Ast
parseProduct
              Maybe Ast
res' <- Parser Ast -> Parser (Maybe Ast)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser String
parseWhiteSpace Parser String -> Parser Char -> Parser Char
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser Char
parseAnyChar String
"+-"
                                    Parser Char -> (Char -> Parser Ast) -> Parser Ast
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
res' -> Parser Ast
parseSum
                                        Parser Ast -> (Ast -> Parser Ast) -> Parser Ast
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ast
res'' -> Ast -> Parser Ast
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ast -> Parser Ast) -> Ast -> Parser Ast
forall a b. (a -> b) -> a -> b
$ String -> [Ast] -> Ast
AST.Call [Char
res'] [Ast
res, Ast
res''])
              Ast -> Parser Ast
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ast -> Parser Ast) -> Ast -> Parser Ast
forall a b. (a -> b) -> a -> b
$ Ast -> Maybe Ast -> Ast
forall a. a -> Maybe a -> a
fromMaybe Ast
res Maybe Ast
res'

parseProduct :: Parser AST.Ast
parseProduct :: Parser Ast
parseProduct = do Ast
res <- Parser Ast
parseListOperator
                  Maybe Ast
res' <- Parser Ast -> Parser (Maybe Ast)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser String
parseWhiteSpace Parser String -> Parser Char -> Parser Char
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser Char
parseAnyChar String
"*/%"
                                    Parser Char -> (Char -> Parser Ast) -> Parser Ast
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
res' -> Parser Ast
parseProduct
                                        Parser Ast -> (Ast -> Parser Ast) -> Parser Ast
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ast
res'' -> Ast -> Parser Ast
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ast -> Parser Ast) -> Ast -> Parser Ast
forall a b. (a -> b) -> a -> b
$ String -> [Ast] -> Ast
AST.Call [Char
res'] [Ast
res, Ast
res''])
                  Ast -> Parser Ast
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ast -> Parser Ast) -> Ast -> Parser Ast
forall a b. (a -> b) -> a -> b
$ Ast -> Maybe Ast -> Ast
forall a. a -> Maybe a -> a
fromMaybe Ast
res Maybe Ast
res'

parseListOperator :: Parser AST.Ast
parseListOperator :: Parser Ast
parseListOperator = do Ast
res <- Parser Ast
parseValue
                       Maybe Ast
res' <- Parser Ast -> Parser (Maybe Ast)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser String
parseWhiteSpace Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser String
parseAnyString String
"--" Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                         Parser String
parseWhiteSpace Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser String
parseAnyString String
"++" Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                         Parser String
parseWhiteSpace Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser String
parseAnyString String
"!!"
                                            Parser String -> (String -> Parser Ast) -> Parser Ast
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
res' -> Parser Ast
parseListOperator
                                                Parser Ast -> (Ast -> Parser Ast) -> Parser Ast
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ast
res'' -> Ast -> Parser Ast
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ast -> Parser Ast) -> Ast -> Parser Ast
forall a b. (a -> b) -> a -> b
$ String -> [Ast] -> Ast
AST.Call String
res' [Ast
res, Ast
res''])
                       Ast -> Parser Ast
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ast -> Parser Ast) -> Ast -> Parser Ast
forall a b. (a -> b) -> a -> b
$ Ast -> Maybe Ast -> Ast
forall a. a -> Maybe a -> a
fromMaybe Ast
res Maybe Ast
res'

-- | Return a data Parser that parse a Int as a Value
parseValue :: Parser AST.Ast
parseValue :: Parser Ast
parseValue = Parser String
parseWhiteSpace Parser String -> Parser Ast -> Parser Ast
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (
                                 Parser String
parseWhiteSpace Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser String
parseAnyString String
"(|" Parser String -> Parser Ast -> Parser Ast
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Ast
parseExpr Parser Ast -> Parser String -> Parser Ast
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Parser String
parseAnyString String
"|)" Parser Ast -> Parser String -> Parser Ast
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
parseWhiteSpace
                                 Parser Ast -> Parser Ast -> Parser Ast
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Ast
AST.Value (Int -> Ast) -> Parser Int -> Parser Ast
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int -> Parser Int
forall a. Parser a -> Parser a
parseElem Parser Int
parseInt
                                 Parser Ast -> Parser Ast -> Parser Ast
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Ast
parseBool
                                 Parser Ast -> Parser Ast -> Parser Ast
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Ast
parseSymbol
                                 Parser Ast -> Parser Ast -> Parser Ast
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Ast
parseAstString
                                 Parser Ast -> Parser Ast -> Parser Ast
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Ast
parseUnaryOperator
                                 Parser Ast -> Parser Ast -> Parser Ast
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Ast
parseAstList
                                )

parseUnaryOperator :: Parser AST.Ast
parseUnaryOperator :: Parser Ast
parseUnaryOperator = Parser String
parseWhiteSpace Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser String
parseAnyString String
"!"Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                     Parser String
parseWhiteSpace Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser String
parseAnyString String
"@" Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                     Parser String
parseWhiteSpace Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser String
parseAnyString String
"~"
                        Parser String -> (String -> Parser Ast) -> Parser Ast
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
op -> Parser Ast
parseValue
                                        Parser Ast -> (Ast -> Parser Ast) -> Parser Ast
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ast
value -> Ast -> Parser Ast
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ast -> Parser Ast) -> Ast -> Parser Ast
forall a b. (a -> b) -> a -> b
$ String -> [Ast] -> Ast
AST.Call String
op [Ast
value]

parseListElem :: Parser a -> Parser [a]
parseListElem :: forall a. Parser a -> Parser [a]
parseListElem Parser a
parserA = (Position -> String -> Either String ([a], String, Position))
-> Parser [a]
forall a.
(Position -> String -> Either String (a, String, Position))
-> Parser a
Parser (Parser a
-> Position -> String -> Either String ([a], String, Position)
forall a.
Parser a
-> Position -> String -> Either String ([a], String, Position)
parseFirst Parser a
parserA)
    where
        parseFirst :: Parser a -> Position -> String -> Either String ([a], String, Position)
        parseFirst :: forall a.
Parser a
-> Position -> String -> Either String ([a], String, Position)
parseFirst Parser a
parser Position
pos String
s = case Parser a
-> Position -> String -> Either String (a, String, Position)
forall a.
Parser a
-> Position -> String -> Either String (a, String, Position)
runParser Parser a
parser Position
pos String
s of
            Left String
_ -> ([a], String, Position) -> Either String ([a], String, Position)
forall a b. b -> Either a b
Right ([], String
s, Position
pos)
            Right (a
res, String
s', Position
pos') -> case Parser a
-> Position -> String -> Either String ([a], String, Position)
forall a.
Parser a
-> Position -> String -> Either String ([a], String, Position)
parseOthers Parser a
parser Position
pos' String
s' of
                Left String
err -> String -> Either String ([a], String, Position)
forall a b. a -> Either a b
Left String
err
                Right ([a]
res', String
s'', Position
pos'') -> ([a], String, Position) -> Either String ([a], String, Position)
forall a b. b -> Either a b
Right (a
res a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
res', String
s'', Position
pos'')
        parseOthers :: Parser a -> Position -> String -> Either String ([a], String, Position)
        parseOthers :: forall a.
Parser a
-> Position -> String -> Either String ([a], String, Position)
parseOthers Parser a
parser Position
pos String
s = case Parser Char
-> Position -> String -> Either String (Char, String, Position)
forall a.
Parser a
-> Position -> String -> Either String (a, String, Position)
runParser (Char -> Parser Char
parseChar Char
',') Position
pos String
s of
            Left String
_ -> ([a], String, Position) -> Either String ([a], String, Position)
forall a b. b -> Either a b
Right ([], String
s, Position
pos)
            Right (Char
_, String
s', Position
pos') -> case Parser a
-> Position -> String -> Either String (a, String, Position)
forall a.
Parser a
-> Position -> String -> Either String (a, String, Position)
runParser Parser a
parser Position
pos' String
s' of
                Left String
err -> String -> Either String ([a], String, Position)
forall a b. a -> Either a b
Left String
err
                Right (a
res, String
s'', Position
pos'') -> case Parser a
-> Position -> String -> Either String ([a], String, Position)
forall a.
Parser a
-> Position -> String -> Either String ([a], String, Position)
parseOthers Parser a
parser Position
pos'' String
s'' of
                    Left String
err -> String -> Either String ([a], String, Position)
forall a b. a -> Either a b
Left String
err
                    Right ([a]
res', String
s''', Position
pos''') -> ([a], String, Position) -> Either String ([a], String, Position)
forall a b. b -> Either a b
Right (a
res a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
res', String
s''', Position
pos''')

-- | Parse a list of element
-- Return a Parser of list `element` that start with a '(' and end with a ')'
parseList :: Parser a -> String -> String -> Parser [a]
parseList :: forall a. Parser a -> String -> String -> Parser [a]
parseList Parser a
parser String
start String
end = Parser String
parseStart Parser String -> Parser [a] -> Parser [a]
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser [a]
parseListValue Parser [a] -> Parser String -> Parser [a]
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
parseEnd
    where
        parseEnd :: Parser String
parseEnd = String -> Parser String
parseAnyString String
end Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
parseWhiteSpace
        parseListValue :: Parser [a]
parseListValue = Parser String
parseWhiteSpace Parser String -> Parser [a] -> Parser [a]
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a -> Parser [a]
forall a. Parser a -> Parser [a]
parseListElem Parser a
parser Parser [a] -> Parser String -> Parser [a]
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
parseWhiteSpace
        parseStart :: Parser String
parseStart = Parser String
parseWhiteSpace Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser String
parseAnyString String
start

-- | Parse any character from a String
-- Return a Parser that parse every character from a String
parseAnyChar :: String -> Parser Char
parseAnyChar :: String -> Parser Char
parseAnyChar String
s = (Position -> String -> Either String (Char, String, Position))
-> Parser Char
forall a.
(Position -> String -> Either String (a, String, Position))
-> Parser a
Parser (String
-> Position -> String -> Either String (Char, String, Position)
f String
s)
    where
        f :: String -> Position -> String -> Either String (Char, String, Position)
        f :: String
-> Position -> String -> Either String (Char, String, Position)
f [] (Int
row, Int
col) String
_ = String -> Either String (Char, String, Position)
forall a b. a -> Either a b
Left (Position -> String
errorParsing (Int
row, Int
col))
        f (Char
x:String
xs) Position
pos String
s' = case Either String (Char, String, Position)
parsed of
            Left String
_ -> Parser Char
-> Position -> String -> Either String (Char, String, Position)
forall a.
Parser a
-> Position -> String -> Either String (a, String, Position)
runParser (String -> Parser Char
parseAnyChar String
xs) Position
pos String
s'
            Either String (Char, String, Position)
_ -> Either String (Char, String, Position)
parsed
            where
                parsed :: Either String (Char, String, Position)
parsed = Parser Char
-> Position -> String -> Either String (Char, String, Position)
forall a.
Parser a
-> Position -> String -> Either String (a, String, Position)
runParser (Parser Char -> Parser Char -> Parser Char
forall a. Parser a -> Parser a -> Parser a
parseOr (Char -> Parser Char
parseChar Char
x) (Char -> Parser Char
parseChar Char
c)) Position
pos String
s'
                c :: Char
c = case String
xs of
                    [] -> Char
'\0'
                    String
_ -> String -> Char
forall a. HasCallStack => [a] -> a
head String
xs

parseAstList :: Parser AST.Ast
parseAstList :: Parser Ast
parseAstList = [Ast] -> Ast
AST.List ([Ast] -> Ast) -> Parser [Ast] -> Parser Ast
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Ast -> String -> String -> Parser [Ast]
forall a. Parser a -> String -> String -> Parser [a]
parseList Parser Ast
parseAst String
"[|" String
"|]"

-- | Parse a specific String
parseAnyString :: String -> Parser String
parseAnyString :: String -> Parser String
parseAnyString String
s = (Position -> String -> Either String (String, String, Position))
-> Parser String
forall a.
(Position -> String -> Either String (a, String, Position))
-> Parser a
Parser (String
-> String
-> Position
-> String
-> Either String (String, String, Position)
f String
s String
s)
    where
        f :: String -> String -> Position  -> String -> Either String (String, String, Position)
        f :: String
-> String
-> Position
-> String
-> Either String (String, String, Position)
f (Char
x:String
xs) String
str Position
pos String
s' = case Parser Char
-> Position -> String -> Either String (Char, String, Position)
forall a.
Parser a
-> Position -> String -> Either String (a, String, Position)
runParser (Char -> Parser Char
parseChar Char
x) Position
pos String
s' of
            Left String
err -> String -> Either String (String, String, Position)
forall a b. a -> Either a b
Left String
err
            Right (Char
_, String
s'', Position
pos') -> String
-> String
-> Position
-> String
-> Either String (String, String, Position)
f String
xs String
str Position
pos' String
s''
        f [] String
str Position
pos String
s' = (String, String, Position)
-> Either String (String, String, Position)
forall a b. b -> Either a b
Right (String
str, String
s', Position
pos)

parseCmpString :: String -> Parser String
parseCmpString :: String -> Parser String
parseCmpString String
s = (Position -> String -> Either String (String, String, Position))
-> Parser String
forall a.
(Position -> String -> Either String (a, String, Position))
-> Parser a
Parser (String
-> Position -> String -> Either String (String, String, Position)
f String
s)
    where
        f :: String -> Position -> String -> Either String (String, String, Position)
        f :: String
-> Position -> String -> Either String (String, String, Position)
f String
str Position
pos String
s' = case Parser String
-> Position -> String -> Either String (String, String, Position)
forall a.
Parser a
-> Position -> String -> Either String (a, String, Position)
runParser Parser String
parseString Position
pos String
s' of
            Left String
err -> String -> Either String (String, String, Position)
forall a b. a -> Either a b
Left String
err
            Right (String
res, String
s'', Position
pos') -> if String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
res then (String, String, Position)
-> Either String (String, String, Position)
forall a b. b -> Either a b
Right (String
res, String
s'', Position
pos') else String -> Either String (String, String, Position)
forall a b. a -> Either a b
Left (Position -> String
errorParsing Position
pos)

-- | Return a Parser that parse a Bool (#f or #t)
parseBool :: Parser AST.Ast
parseBool :: Parser Ast
parseBool = Bool -> Ast
AST.Boolean (Bool -> Ast) -> Parser Bool -> Parser Ast
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Bool
parseTrue Parser Bool -> Parser Bool -> Parser Bool
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Bool
parseFalse) Parser Ast -> Parser String -> Parser Ast
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
parseWhiteSpace

-- | Return a PArser that parse a True (in lisp -> #t)
parseTrue :: Parser Bool
parseTrue :: Parser Bool
parseTrue = String -> Parser String
parseCmpString String
"true" Parser String -> Parser Bool -> Parser Bool
forall a b. Parser a -> Parser b -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser Bool
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

-- | Return a PArser that parse a True (in lisp -> #f)
parseFalse :: Parser Bool
parseFalse :: Parser Bool
parseFalse = String -> Parser String
parseCmpString String
"false" Parser String -> Parser Bool -> Parser Bool
forall a b. Parser a -> Parser b -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser Bool
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

parseDefineValue :: Parser AST.Ast
parseDefineValue :: Parser Ast
parseDefineValue = Parser String
parseString
                        Parser String -> (String -> Parser Ast) -> Parser Ast
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
str -> Char -> Parser Char
parseChar Char
'='
                            Parser Char -> Parser Ast -> Parser Ast
forall a b. Parser a -> Parser b -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Parser Ast
parseAst Parser Ast -> (Ast -> Parser Ast) -> Parser Ast
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ast
ast -> Ast -> Parser Ast
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ast -> Parser Ast) -> Ast -> Parser Ast
forall a b. (a -> b) -> a -> b
$ String -> Ast -> Ast
AST.Define String
str Ast
ast)

parseSymbol :: Parser AST.Ast
parseSymbol :: Parser Ast
parseSymbol = do
                String
name <- Parser String
parseString
                Maybe Ast
args <- Parser Ast -> Parser (Maybe Ast)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser String
parseWhiteSpace Parser String -> Parser [Ast] -> Parser [Ast]
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Ast -> String -> String -> Parser [Ast]
forall a. Parser a -> String -> String -> Parser [a]
parseList Parser Ast
parseAst String
"(|" String
"|)"
                            Parser [Ast] -> ([Ast] -> Parser Ast) -> Parser Ast
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Ast]
res -> Ast -> Parser Ast
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ast -> Parser Ast) -> Ast -> Parser Ast
forall a b. (a -> b) -> a -> b
$ String -> Maybe [Ast] -> Ast
AST.Symbol String
name ([Ast] -> Maybe [Ast]
forall a. a -> Maybe a
Just [Ast]
res))
                Ast -> Parser Ast
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ast -> Parser Ast) -> Ast -> Parser Ast
forall a b. (a -> b) -> a -> b
$ Ast -> Maybe Ast -> Ast
forall a. a -> Maybe a -> a
fromMaybe (String -> Maybe [Ast] -> Ast
AST.Symbol String
name Maybe [Ast]
forall a. Maybe a
Nothing) Maybe Ast
args


parseDefineFn :: Parser AST.Ast
parseDefineFn :: Parser Ast
parseDefineFn = String -> Parser String
parseCmpString String
"fn" Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String
parseString
                    Parser String -> (String -> Parser Ast) -> Parser Ast
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
name -> Parser Ast
parseFunctionValue
                        Parser Ast -> (Ast -> Parser Ast) -> Parser Ast
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ast
value -> Ast -> Parser Ast
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ast -> Parser Ast) -> Ast -> Parser Ast
forall a b. (a -> b) -> a -> b
$ String -> Ast -> Ast
AST.Define String
name Ast
value

parseLambda :: Parser AST.Ast
parseLambda :: Parser Ast
parseLambda = (String -> Parser String
parseCmpString String
"lambda" Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser String
parseAnyString String
"λ") Parser String -> Parser Ast -> Parser Ast
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Ast
parseFunctionValue

parseFunctionValue :: Parser AST.Ast
-- parseFunctionValue = Parser parseParams
parseFunctionValue :: Parser Ast
parseFunctionValue = Parser String -> String -> String -> Parser [String]
forall a. Parser a -> String -> String -> Parser [a]
parseList Parser String
parseString String
"(|" String
"|)"
                        Parser [String] -> ([String] -> Parser Ast) -> Parser Ast
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[String]
args -> Parser Ast
parseBracket
                            Parser Ast -> (Ast -> Parser Ast) -> Parser Ast
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ast
expr -> Ast -> Parser Ast
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ast -> Parser Ast) -> Ast -> Parser Ast
forall a b. (a -> b) -> a -> b
$ [String] -> Ast -> Maybe [Ast] -> Ast
AST.FunctionValue [String]
args Ast
expr Maybe [Ast]
forall a. Maybe a
Nothing

parseBracket :: Parser AST.Ast
parseBracket :: Parser Ast
parseBracket = Parser String
parseStart Parser String -> Parser Ast -> Parser Ast
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Ast
parseAst Parser Ast -> Parser String -> Parser Ast
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
parseEnd
    where
        parseEnd :: Parser String
parseEnd = Parser String
parseWhiteSpace Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser String
parseAnyString String
"|}" Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
parseWhiteSpace
        parseStart :: Parser String
parseStart = Parser String
parseWhiteSpace Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser String
parseAnyString String
"{|" Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
parseWhiteSpace

parseCond :: Parser AST.Ast
parseCond :: Parser Ast
parseCond = do String
_ <- String -> Parser String
parseCmpString String
"if"
               Ast
expr <- Parser Ast
parseExpr
               Ast
value <- Parser Ast
parseBracket
               Maybe Ast
res <- Parser Ast -> Parser (Maybe Ast)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Ast
parseElse
               Ast -> Parser Ast
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ast -> Parser Ast) -> Ast -> Parser Ast
forall a b. (a -> b) -> a -> b
$ Ast -> Ast -> Maybe Ast -> Ast
AST.Cond Ast
expr Ast
value Maybe Ast
res
    where
        parseElse :: Parser Ast
parseElse = String -> Parser String
parseCmpString String
"else" Parser String -> Parser Ast -> Parser Ast
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Position -> String -> Either String (Ast, String, Position))
-> Parser Ast
forall a.
(Position -> String -> Either String (a, String, Position))
-> Parser a
Parser Position -> String -> Either String (Ast, String, Position)
p
            where
                p :: Position -> String -> Either String (AST.Ast, String, Position)
                p :: Position -> String -> Either String (Ast, String, Position)
p Position
pos String
s = case Parser Ast
-> Position -> String -> Either String (Ast, String, Position)
forall a.
Parser a
-> Position -> String -> Either String (a, String, Position)
runParser Parser Ast
parseCond Position
pos String
s of
                    Left String
_ -> case Parser Ast
-> Position -> String -> Either String (Ast, String, Position)
forall a.
Parser a
-> Position -> String -> Either String (a, String, Position)
runParser Parser Ast
parseBracket Position
pos String
s of
                        Left String
err -> String -> Either String (Ast, String, Position)
forall a b. a -> Either a b
Left String
err
                        Right (Ast
res, String
s', Position
pos') -> (Ast, String, Position) -> Either String (Ast, String, Position)
forall a b. b -> Either a b
Right (Ast
res, String
s', Position
pos')
                    Right (Ast
res, String
s', Position
pos') -> (Ast, String, Position) -> Either String (Ast, String, Position)
forall a b. b -> Either a b
Right (Ast
res, String
s', Position
pos')

-- | Return a Parser that parse a SExpr
parseAst :: Parser AST.Ast
parseAst :: Parser Ast
parseAst = Parser String
parseWhiteSpace Parser String -> Parser Ast -> Parser Ast
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
        (
        Parser Ast
parseDefineFn
        Parser Ast -> Parser Ast -> Parser Ast
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Ast
parseCond
        Parser Ast -> Parser Ast -> Parser Ast
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Ast
parseDefineValue
        Parser Ast -> Parser Ast -> Parser Ast
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Ast
parseLambda
        Parser Ast -> Parser Ast -> Parser Ast
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Ast
parseBool
        Parser Ast -> Parser Ast -> Parser Ast
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Ast
parseExpr
        Parser Ast -> Parser Ast -> Parser Ast
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Ast
parseAstString
        Parser Ast -> Parser Ast -> Parser Ast
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Ast
parseValue
        Parser Ast -> Parser Ast -> Parser Ast
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Ast
parseSymbol
        )

parseComment :: Parser Char
parseComment :: Parser Char
parseComment = Char -> Parser Char
parseChar Char
'#' Parser Char -> Parser Char -> Parser Char
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Position -> String -> Either String (Char, String, Position))
-> Parser Char
forall a.
(Position -> String -> Either String (a, String, Position))
-> Parser a
Parser Position -> String -> Either String (Char, String, Position)
f
    where
        f :: Position -> String -> Either String (Char, String, Position)
        f :: Position -> String -> Either String (Char, String, Position)
f (Int
row, Int
_) (Char
'\n':String
xs)  = (Char, String, Position) -> Either String (Char, String, Position)
forall a b. b -> Either a b
Right (Char
'\n', String
xs, (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
0))
        f (Int
row, Int
col) String
"" = (Char, String, Position) -> Either String (Char, String, Position)
forall a b. b -> Either a b
Right (Char
'\n', String
"", (Int
row, Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
        f (Int
row, Int
col) (Char
_:String
xs) = Position -> String -> Either String (Char, String, Position)
f (Int
row, Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
xs

parseLobster :: Parser [AST.Ast]
parseLobster :: Parser [Ast]
parseLobster = Parser Ast -> Parser [Ast]
forall a. Parser a -> Parser [a]
parseMany (Parser String
parseWhiteSpace Parser String -> Parser Ast -> Parser Ast
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Ast
parseAst)