Refactoring parsing, Fixing builtin, rewrite everything else

4 files changed, 124 insertions, 123 deletions

diff --git a/src/parser/Assignment.hs b/src/parser/Assignment.hs
deleted file mode 100644
index bb782f5..0000000
--- a/src/parser/Assignment.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-module Parser.Assignment where
-
-import Control.Applicative
-import Parser.Core
-import qualified Parser.Expr as E
-import Assignment
-
-variableP :: Parser Assignment
-variableP = Variable <$> alphaStringP <* char '=' <*> E.exprP
-
-functionP :: Parser Assignment
-functionP = Function <$> alphaStringP <*> parenthesize alphaStringP <* char '=' <*> E.exprP
-
-assignmentP :: Parser Assignment
-assignmentP = variableP <|> functionP
diff --git a/src/parser/Core.hs b/src/parser/Core.hs
index b22bcf4..8deea2f 100644
--- a/src/parser/Core.hs
+++ b/src/parser/Core.hs
@@ -1,117 +1,131 @@
+{-# LANGUAGE FlexibleInstances #-}
+
 module Parser.Core where
 
-import Control.Applicative
-import Control.Monad
-import Data.Char
+import           Control.Applicative
+import           Control.Monad
+import           Data.Char
+
+newtype Parser a = Parser { runParser :: String -> Either String (a, String) }
 
-newtype Parser a = Parser { parse :: String -> Maybe (a, String) }
+runParserStrict :: Parser a -> String -> Either String a
+runParserStrict p input = case runParser p input of
+    Right (a, "")   -> Right a
+    Right (_, rest) -> Left $ "Unconsumed input: \"" ++ rest ++ "\""
+    Left err        -> Left err
 
-parseStrict :: Parser a -> String -> Maybe a
-parseStrict p input = case parse p input of Just (a, "") -> Just a
-                                            _            -> Nothing
+
+-------------------------------------------------------------------------------
+-- Parser instances
+-------------------------------------------------------------------------------
 
 instance Functor Parser where
     -- fmap :: (a -> b) -> Parser a -> Parser b
-    fmap f (Parser p) = Parser new_p
-        where new_p s = do
-                (x, s') <- p s
-                return (f x, s')
+    fmap f (Parser p) = Parser $
+        \s -> do (x, s') <- p s
+                 return (f x, s')
 
 instance Applicative Parser where
     -- pure :: a -> Parser a
-    pure x = Parser (\s -> Just (x, s))
+    pure x = Parser (\s -> Right (x, s))
     -- (<*>) :: Parser (a -> b) -> Parser a -> Parser b
-    (Parser p1) <*> (Parser p2) = Parser new_p
-        where new_p s = do
-                (f, s') <- p1 s
-                (x, s'') <- p2 s'
-                return (f x, s'')
-
-instance Alternative Parser where
-    -- empty :: Parser a
-    empty = Parser (\_ -> Nothing)
-    -- (<|>) :: Parser a -> Parser a -> Parser a
-    (Parser p1) <|> (Parser p2) = Parser new_p
-        where new_p s = p1 s <|> p2 s
+    (Parser pf) <*> (Parser p) = Parser $
+        \s -> do (f, s')  <- pf s
+                 (x, s'') <- p s'
+                 return (f x, s'')
 
 instance Monad Parser where
     -- return :: a -> Parser a
     return x = pure x
     -- (>>=) :: Parser a -> (a -> Parser b) -> Parser b
-    (Parser p1) >>= f = Parser new_p
-        where new_p s = do
-                (x, s') <- p1 s
-                parse (f x) s'
+    (Parser p1) >>= f = Parser $
+        \s -> do (x, s') <- p1 s
+                 runParser (f x) s'
+
+-- instance for Either String so that it can be used in the Alternative for Parser
+instance Alternative (Either String) where
+    -- empty :: Either String a
+    empty = Left ""
+    -- (<|>) :: Either String a -> Either String a -> Either String a
+    Left _ <|> x2 = x2
+    x1     <|> _  = x1
 
+instance Alternative Parser where
+    -- empty :: Parser a
+    empty = Parser (\_ -> Left "Empty")
+    -- (<|>) :: Parser a -> Parser a -> Parser a
+    (Parser p1) <|> (Parser p2) = Parser $ \s -> p1 s <|> p2 s
+
+
+-------------------------------------------------------------------------------
+-- Parser creation helper
+-------------------------------------------------------------------------------
 
+-- Create a parser of one character which must respect a predicate
 satisfyChar :: (Char -> Bool) -> Parser Char
-satisfyChar f = Parser p
-    where p []     = Nothing
-          p (c:cs) = if f c then Just (c, cs)
-                            else Nothing
+satisfyChar predicate = Parser p
+    where p []     = Left "Expected input"
+          p (c:cs) = if predicate c then Right (c, cs)
+                                    else Left "Expected char"
 
-sepBy :: Parser b -> Parser a -> Parser [a]
-sepBy sep x = (:) <$> x <*> (many (sep *> x))
+char :: Char -> Parser Char
+char c = satisfyChar (c ==)
+
+string :: String -> Parser String
+string s = sequenceA $ char <$> s
+
+sepBy :: Parser a -> Parser b -> Parser [a]
+sepBy x sepatator = (:) <$> x <*> (many (sepatator *> x))
 
 -- sepByMap :: (b -> a -> a) -> Parser b -> Parser a -> Parser [a]
 -- sepByMap f sep x = (:) <$> x <*> (many (f <$> sep <*> x))
 
-chainl :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
-chainl p op a = chainl1 p op <|> pure a
+-- chainl :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
+-- chainl p op a = chainl1 p op <|> pure a
 
+-- Parse one or more occurences of p separated by op
+-- Apply op in a left associative maner on each value in p
 chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a
 chainl1 p op = p >>= rest
     where rest prev = do f <- op
-                         e <- p
-                         rest (f prev e)
+                         operand <- p
+                         rest (f prev operand)
                       <|> return prev
 
-signed :: Num a => Parser a -> Parser a
-signed p = do char '-'
-              x <- p
-              return (-x)
-           <|> p
-
-readParser :: Read a => Parser String -> Parser a
-readParser p = read <$> p
-
 infixOp :: String -> (a -> a -> a) -> Parser (a -> a -> a)
-infixOp opStr f = string opStr *> pure f
-
-parenthesize :: Parser a -> Parser a
-parenthesize p = char '(' *> p <* char ')'
+infixOp operatorStr f = string operatorStr *> pure f
 
-char :: Char -> Parser Char
-char c = satisfyChar (c ==)
+-- Surround parser with opening and closing string
+between :: String -> String -> Parser a -> Parser a
+between open close p = string open *> p <* string close
 
-string :: String -> Parser String
-string s = sequenceA $ char <$> s
+parenthesis :: Parser a -> Parser a
+parenthesis p = between "(" ")" p
 
-alphaP :: Parser Char
-alphaP = satisfyChar isAlpha
+-- try to apply parsers returns the first one that succeeds
+choice :: [Parser a] -> Parser a
+choice []     = empty
+choice (p:ps) = p <|> choice ps
 
 alphaStringP :: Parser String
-alphaStringP = some alphaP
-
-digitsP :: Parser String
-digitsP = some (satisfyChar isDigit) -- at least one digit to avoid read exception
-
-spacesP :: Parser String
-spacesP = many (satisfyChar isSpace)
-
-unsignedIntP :: Parser Int
-unsignedIntP = readParser digitsP
-
-intP :: Parser Int
-intP = signed unsignedIntP
+alphaStringP = some (satisfyChar isAlpha)
 
-unsignedFloatP :: Parser Float
-unsignedFloatP = readParser p
-    where p = do pos <- digitsP
-                 char '.'
-                 dec <- digitsP
-                 return (pos ++ "." ++ dec)
-              <|> digitsP
 
 floatP :: Parser Float
-floatP = signed unsignedFloatP
+floatP = signed unsignedP
+    where
+        unsignedP :: Parser Float
+        unsignedP = read <$> p
+            where p = do pos <- digitsP
+                         char '.'
+                         dec <- digitsP
+                         return (pos ++ "." ++ dec)
+                      <|> digitsP
+
+                  digitsP = some $ satisfyChar isDigit -- at least one digit to avoid read exception
+
+        signed :: Num a => Parser a -> Parser a
+        signed p = do char '-'
+                      x <- p
+                      return (-x)
+                     <|> p
diff --git a/src/parser/Expr.hs b/src/parser/Expr.hs
index 2d6937a..6a721f8 100644
--- a/src/parser/Expr.hs
+++ b/src/parser/Expr.hs
@@ -12,28 +12,42 @@ imaginaryP = Imaginary <$> (floatP <* char 'i')
 rationalP :: Parser Expr
 rationalP = Rational <$> floatP
 
+-- Parse a matrix in the following format:
+-- [ [a, b]; [c, d] ]
 matrixP :: Parser Expr
-matrixP = Matrix <$> (char '[' *> sepBy (char ';') matrixRowP <* char ']')
-    where matrixRowP = char '[' *> sepBy (char ',') exprP <* char ']'
+matrixP = Matrix <$> brackets (matrixRowP `sepBy` (char ';'))
+    where matrixRowP = brackets (exprP `sepBy` (char ','))
+          brackets = between "[" "]"
 
+
+-- Parse expression separated by one infix operator of the operator list
+operatorChoiceChain :: Parser a -> [Parser (a -> a -> a)] -> Parser a
+operatorChoiceChain x operators = x `chainl1` choice operators
+
+-- Parse an expression (lowest operator priority)
 exprP :: Parser Expr
-exprP = termP `chainl1` termOpP
-    where termOpP = infixOp "+" Add <|> infixOp "-" Sub
+exprP = operatorChoiceChain termP
+            [ infixOp "+" Add
+            , infixOp "-" Sub
+            ]
 
 termP :: Parser Expr
-termP =  factorP `chainl1` factorOpP
-    where factorOpP = infixOp "**" Dot <|> infixOp "*" Mul <|> infixOp "/" Div <|> infixOp "%" Mod
+termP =  operatorChoiceChain factorP
+            [ infixOp "**" Dot
+            , infixOp "*" Mul
+            , infixOp "/" Div
+            , infixOp "%" Mod
+            ]
 
 factorP :: Parser Expr
-factorP =  endpointP `chainl1` expOpP
-    where expOpP = infixOp "^" Exp
-
-          endpointP = parensExprP
-                      <|> imaginaryP
-                      <|> rationalP
-                      <|> matrixP
-                      <|> functionP
-                      <|> variableP
-              where variableP = Variable <$> alphaStringP
-                    functionP = Function <$> alphaStringP <*> parensExprP
-                    parensExprP = parenthesize exprP
+factorP =  choice [ parenthesizedExprP
+                  , imaginaryP
+                  , rationalP
+                  , matrixP
+                  , functionP
+                  , variableP
+                  ] `chainl1` (infixOp "^" Exp)
+
+    where variableP = Variable <$> alphaStringP
+          functionP = Function <$> alphaStringP <*> parenthesizedExprP
+          parenthesizedExprP = parenthesis exprP
diff --git a/src/parser/Statement.hs b/src/parser/Statement.hs
deleted file mode 100644
index 74f7f01..0000000
--- a/src/parser/Statement.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module Parser.Statement where
-
-import Control.Applicative
-import Parser.Core
-import Parser.Expr
-import Parser.Assignment
-import Statement
-
-
-statementP :: Parser Statement
-statementP = SAssignment <$> assignmentP
-             <|> SExpr <$> exprP <* char '=' <* char '?'