Refactoring parsing, Fixing builtin, rewrite everything else

11 files changed, 245 insertions, 407 deletions

diff --git a/src/Assignment.hs b/src/Assignment.hs
deleted file mode 100644
index 2dc7aef..0000000
--- a/src/Assignment.hs
+++ /dev/null
@@ -1,48 +0,0 @@
-module Assignment where
-
-import Data.List
-import qualified Expr as E
-
-data Assignment
-    = Variable String E.Expr
-    | Function String String E.Expr
-
-instance Eq Assignment where
-    (Variable n1 _) == (Variable n2 _) = n1 == n2
-    (Function n1 _ _) == (Function n2 _ _) = n1 == n2
-    _ == _ = False
-
-name :: Assignment -> String
-name (Variable n _) = n
-name (Function n _ _) = n
-
--- data Context a =  Context { vars :: [Assignment], payload :: a }
-type Context = [Assignment]
-
--- instance Functor Context where
---     fmap f (Context as x) = Context as (f x)
---
--- instance Applicative Context where
---     pure x = Context [] x
---     (Context a1 f) <*> (Context a2 x) = Context (a1 `union` a2) (f x)
---
--- instance Monad Context where
---     return = pure
---     (Context a1 x) >>= f = Context (vars res `union` a1) (payload res)
---         where res = f x
-
-
-update :: Context -> Assignment -> Context
-update context a
-  | a `elem` context = map replaceIf context
-  | otherwise = a:context
-  where replaceIf a' = if a' == a then a else a'
-
-get :: Context -> String -> Maybe Assignment
-get context n = case found of [] -> Nothing
-                              [a] -> Just a
-    where found = filter (\a -> name a == n) context
-
-instance Show Assignment where
-    show (Variable name e) = name ++ " = " ++ show e
-    show (Function name arg e) = name ++ "(" ++ arg ++ ") = " ++ show e
diff --git a/src/Builtin.hs b/src/Builtin.hs
deleted file mode 100644
index 8287d5a..0000000
--- a/src/Builtin.hs
+++ /dev/null
@@ -1,66 +0,0 @@
-module Builtin where
-
-
-builtinAdd :: Expr -> Expr -> Maybe Expr
-
-builtinAdd (Rational a)    (Rational b)    = Just $ Rational (a + b)
-builtinAdd (Rational a)    (Imaginary b)   = Just $ Complex a b
-builtinAdd (Rational a)    (Complex br bi) = Just $ Complex (br + a) bi
-
-builtinAdd (Imaginary a)   (Imaginary b)   = Just $ Imaginary (a + b)
-builtinAdd (Imaginary a)   (Rational b)    = Just $ Complex b a
-builtinAdd (Imaginary a)   (Complex br bi) = Just $ Complex br (a + bi)
-
-builtinAdd (Complex ar ai) (Complex br bi) = Just $ Complex (ar + br) (ai + bi)
-builtinAdd (Complex ar ai) (Rational b)    = Just $ Complex (ar + b) ai
-builtinAdd (Complex ar ai) (Imaginary b)   = Just $ Complex ar (ai + b)
-
-builtinAdd _ _ = Nothing
-
-
-builtinSub :: Expr -> Expr -> Maybe Expr
-builtinSub a b = a `builtinAdd` ((Rational (-1)) `builtinMul` b)
-builtinSub _ _ = Nothing
-
-
--- could be derived from addition
-builtinMul :: Expr -> Expr -> Maybe Expr
-builtinMul (Rational a) (Rational b)    = Just $ Ratinal (a * b)
-builtinMul (Rational a) (Imaginary b)   = Just $ Imaginary (a * b)
-builtinMul (Rational a) (Complex br bi) = Just $ Complex (a * br) (a * bi)
-
-builtinMul (Imaginary a) (Imaginary b)   = Just $ Imaginary (a * b)
-builtinMul (Imaginary a) (Rational b)    = Just $ Complex b a
-builtinMul (Imaginary a) (Complex br bi) = Just $ Complex (a * br) (a * bi)
-
-builtinMul _ _ = Nothing
-
-
-builtinDiv :: Expr -> Expr -> Maybe Expr
-builtinDiv _ (Rational 0)  = Nothing
-builtinDiv _ (Imaginary 0) = Nothing
-builtinDiv _ (Complex 0 0) = Nothing
-builtinDiv a b = Just $ a `builtinMul` (b `builtinExp` (Rational -1))
-builtinDiv _ _ = Nothing
-
-
-builtinMod :: Expr -> Expr -> Maybe Expr
-builtinMod _ _ = Nothing
-
-
--- could be derived from multiplication
-builtinExp :: Expr -> Expr -> Maybe Expr
-builtinExp (Rational a)  (Rational b) = Just $ Rational (a ** b)
-
-builtinExp (Imaginary a) (Rational b)
-  | b < 0     = Just $ (Rational 1) `builtinDiv` ((Imaginary a) `builtinExp` (Rational b)
-  | b == 0    = Just $ Rational a
-  | b == 1    = Just $ Imaginary a
-  | b == 2    = Just $ Rational (-a)
-  | b == 3    = Just $ Imaginary (-a)
-  | otherwise = Imaginary a `builtinExp` (Rational (b - 4))
-
-builtinExp _ _ = Nothing
-
-builtinDot :: Expr -> Expr -> Maybe Expr
-_ **? _ = Nothing
diff --git a/src/Evaluation.hs b/src/Evaluation.hs
index f0db71c..5356b30 100644
--- a/src/Evaluation.hs
+++ b/src/Evaluation.hs
@@ -1,25 +1,24 @@
 module Evaluation where
 
 import Expr
-import qualified Assignment as A
 
-eval :: A.Context -> Expr -> Maybe Expr
-eval c (Variable n) = do (A.Variable _ e) <- A.get c n
-                         eval c e
-eval c (Function n e) = do x <- eval c e
-                           (A.Function _ param fe) <- A.get c n
-                           let tmp = A.update c (A.Variable param x)
-                           eval tmp fe
-eval c (Add e1 e2) = evalInfix c e1 e2 (+?)
-eval c (Sub e1 e2) = evalInfix c e1 e2 (-?)
-eval c (Mul e1 e2) = evalInfix c e1 e2 (*?)
-eval c (Div e1 e2) = evalInfix c e1 e2 (/?)
-eval c (Mod e1 e2) = evalInfix c e1 e2 (%?)
-eval c (Exp e1 e2) = evalInfix c e1 e2 (^?)
-eval c (Dot e1 e2) = evalInfix c e1 e2 (**?)
-eval c x = Just x
-
-evalInfix :: A.Context -> Expr -> Expr -> (Expr -> Expr -> Maybe Expr) -> Maybe Expr
-evalInfix c e1 e2 f = do a <- eval c e1
-                         b <- eval c e2
-                         f a b
+-- eval :: A.Context -> Expr -> Maybe Expr
+-- eval c (Variable n) = do (A.Variable _ e) <- A.get c n
+--                          eval c e
+-- eval c (Function n e) = do x <- eval c e
+--                            (A.Function _ param fe) <- A.get c n
+--                            let tmp = A.update c (A.Variable param x)
+--                            eval tmp fe
+-- eval c (Add e1 e2) = evalInfix c e1 e2 (builtinAdd)
+-- eval c (Sub e1 e2) = evalInfix c e1 e2 (builtinSub)
+-- eval c (Mul e1 e2) = evalInfix c e1 e2 (builtinMul)
+-- eval c (Div e1 e2) = evalInfix c e1 e2 (builtinDiv)
+-- eval c (Mod e1 e2) = evalInfix c e1 e2 (builtinMod)
+-- eval c (Exp e1 e2) = evalInfix c e1 e2 (builtinExp)
+-- eval c (Dot e1 e2) = evalInfix c e1 e2 (builtinDot)
+-- eval c x = Just x
+--
+-- evalInfix :: A.Context -> Expr -> Expr -> (Expr -> Expr -> Maybe Expr) -> Maybe Expr
+-- evalInfix c e1 e2 f = do a <- eval c e1
+--                          b <- eval c e2
+--                          f a b
diff --git a/src/Expr.hs b/src/Expr.hs
index 4bf2c70..e427b65 100644
--- a/src/Expr.hs
+++ b/src/Expr.hs
@@ -18,19 +18,7 @@ data Expr
     | Function String Expr
     deriving (Eq)
 
-data Expr
-    = Atom
-    | BinOp
-    | Variable String
-    | Function String Expr
-
-
 instance Show Expr where
-    show (Rational r) = show r
-    show (Imaginary i) = show i ++ "i"
-    show (Complex a b) = show a ++ " + " ++ show b ++ "i"
-    show (Matrix m) = intercalate "\n" (map showRow m)
-        where showRow r = "[ " ++ intercalate ", " (map show r) ++ " ]"
     show (Add e1 e2) = show e1 ++ " + " ++ show e2
     show (Sub e1 e2) = show e1 ++ " - " ++ show e2
     show (Mul e1 e2) = show e1 ++ " * " ++ show e2
@@ -41,3 +29,71 @@ instance Show Expr where
     show (Variable name) = name
     show (Function name e) = name ++ "(" ++ show e ++ ")"
 
+
+-------------------------------------------------------------------------------
+-- Operators
+-------------------------------------------------------------------------------
+
+builtinAdd :: Expr -> Expr -> Maybe Expr
+
+builtinAdd (Rational a)    (Rational b)    = Just $ Rational (a + b)
+builtinAdd (Rational a)    (Imaginary b)   = Just $ Complex a b
+builtinAdd (Rational a)    (Complex br bi) = Just $ Complex (br + a) bi
+
+builtinAdd (Imaginary a)   (Imaginary b)   = Just $ Imaginary (a + b)
+builtinAdd (Imaginary a)   (Rational b)    = Just $ Complex b a
+builtinAdd (Imaginary a)   (Complex br bi) = Just $ Complex br (a + bi)
+
+builtinAdd (Complex ar ai) (Complex br bi) = Just $ Complex (ar + br) (ai + bi)
+builtinAdd (Complex ar ai) (Rational b)    = Just $ Complex (ar + b) ai
+builtinAdd (Complex ar ai) (Imaginary b)   = Just $ Complex ar (ai + b)
+
+builtinAdd _ _ = Nothing
+
+
+builtinSub :: Expr -> Expr -> Maybe Expr
+builtinSub a b = builtinAdd a =<< (Rational (-1) `builtinMul` b)
+
+
+-- could be derived from addition
+builtinMul :: Expr -> Expr -> Maybe Expr
+builtinMul (Rational a) (Rational b)    = Just $ Rational (a * b)
+builtinMul (Rational a) (Imaginary b)   = Just $ Imaginary (a * b)
+builtinMul (Rational a) (Complex br bi) = Just $ Complex (a * br) (a * bi)
+
+builtinMul (Imaginary a) (Imaginary b)   = Just $ Imaginary (a * b)
+builtinMul (Imaginary a) (Rational b)    = Just $ Complex b a
+builtinMul (Imaginary a) (Complex br bi) = Just $ Complex (a * br) (a * bi)
+
+builtinMul _ _ = Nothing
+
+
+builtinDiv :: Expr -> Expr -> Maybe Expr
+builtinDiv _ (Rational 0)  = Nothing
+builtinDiv _ (Imaginary 0) = Nothing
+builtinDiv _ (Complex 0 0) = Nothing
+builtinDiv a b = builtinMul a =<< (b `builtinExp` Rational (-1))
+
+
+builtinMod :: Expr -> Expr -> Maybe Expr
+builtinMod _ _ = Nothing
+
+
+-- could be derived from multiplication
+builtinExp :: Expr -> Expr -> Maybe Expr
+builtinExp (Rational a)  (Rational b) = Just $ Rational (a ** b)
+
+builtinExp (Imaginary a) (Rational b)
+  | b < 0     =  builtinDiv (Rational 1) =<< ((Imaginary a) `builtinExp` (Rational b))
+  | b == 0    = Just $ Rational a
+  | b == 1    = Just $ Imaginary a
+  | b == 2    = Just $ Rational (-a)
+  | b == 3    = Just $ Imaginary (-a)
+  | otherwise = Imaginary a `builtinExp` (Rational (b - 4))
+
+builtinExp _ _ = Nothing
+
+
+builtinDot :: Expr -> Expr -> Maybe Expr
+builtinDot (Matrix a) (Matrix b) = undefined
+builtinDot _ _ = Nothing
diff --git a/src/Polynomial.hs b/src/Polynomial.hs
deleted file mode 100644
index cd0da4f..0000000
--- a/src/Polynomial.hs
+++ /dev/null
@@ -1,87 +0,0 @@
-module Polynomial where
-
--- import Data.List
---
---
--- data Equation = Equation { left :: Polynomial, right :: Polynomial }
--- type Polynomial = [Term]
--- data Term = Term { coefficient :: Float, exponent :: Int }
---
--- instance Eq Term where
---     (Term _ e1) == (Term _ e2) = e1 == e2
---
--- instance Ord Term where
---     compare (Term _ e1) (Term _ e2) = compare e1 e2
---
--- instance Show Term where
---     show (Term 0 e) = ""
---     show (Term c 0) = show (round c)
---     show (Term c e) = show (round c) ++ " * X^" ++ show e
---
--- instance Show Equation where
---     show (Equation l r) = showPolynomial (filterNull l)
---                           ++ " = "
---                           ++ showPolynomial (filterNull r)
---         where showPolynomial [] = "0"
---               showPolynomial p  = dropWhile (`elem` " +") $ foldl f "" (map show p)
---                 where f s "" = s
---                       f s (c:cs)
---                         | c == '-'  = s ++ " - " ++ cs
---                         | otherwise = s ++ " + " ++ (c:cs)
---
---
--- filterNull :: Polynomial -> Polynomial
--- filterNull = filter (\t -> coefficient t /= 0)
---
--- equationMap :: (Polynomial -> Polynomial) -> Equation -> Equation
--- equationMap f (Equation l r) = Equation (f l) (f r)
---
--- degree :: Polynomial -> Int
--- degree [] = 0
--- degree p  = Equation.exponent (maximum p)
---
--- reduce :: Equation -> Equation
--- reduce equ = Equation (merge (left stdForm) (right stdForm)) []
---     where stdForm = equationMap (\a -> (reducePolynomial $ sort a)) equ
---           merge [] rs = rs
---           merge ls [] = ls
---           merge (l:ls) (r:rs)
---             | l == r = (subTerm l r) : merge ls rs
---             | l < r  = l : merge ls (r:rs)
---             | r < l  = r : merge (l:ls) rs
---             where subTerm (Term c1 e) (Term c2 _) = Term (c1 - c2) e
---           reducePolynomial []         = []
---           reducePolynomial [t]        = [t]
---           reducePolynomial (t1:t2:ts)
---             | t1 == t2  = (addTerm t1 t2) : reducePolynomial ts
---             | otherwise = t1 : reducePolynomial (t2:ts)
---             where addTerm (Term c1 e) (Term c2 _) = Term (c1 + c2) e
---
--- solveDegree2 :: Float -> Float -> Float -> [Float]
--- solveDegree2 a b c
---     | phi < 0   = []
---     | phi == 0  = [(-b) / (2.0 * a)]
---     | phi > 0   = [ (-b + mySqrt phi) / (2.0 * a) -- not alowed
---                   , (-b - mySqrt phi) / (2.0 * a)
---                   ]
---     where phi = b * b - 4.0 * a * c
---
--- solveDegree1 :: Float -> Float -> Float
--- solveDegree1 b c = -c / b
---
--- solve :: Polynomial -> [Float]
--- solve [t0]         = []
--- solve [t0, t1]     = [solveDegree1 (coefficient t1) (coefficient t0)]
--- solve [t0, t1, t2] = solveDegree2 (coefficient t2) (coefficient t1) (coefficient t0)
--- solve _            = undefined
---
--- mySqrt :: Float -> Float
--- mySqrt n
---   | n < 0     = undefined
---   | otherwise = mySqrt' (n / 2)
---     where mySqrt' x = if abs (x * x - n) < 0.01
---                          then x
---                          else mySqrt' xn
---             where xn = b - (a * a) / (2 * b)
---                     where a = (n - x * x) / (2 * x)
---                           b = x + a
diff --git a/src/Statement.hs b/src/Statement.hs
deleted file mode 100644
index 75dfdb4..0000000
--- a/src/Statement.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-module Statement where
-
-import Assignment
-import Expr
-
-
-data Statement
-    = SAssignment Assignment
-    | SExpr Expr
-
-instance Show Statement where
-    show (SAssignment a) = show a
-    show (SExpr e) = show e
-
diff --git a/src/main.hs b/src/main.hs
index 569ba28..49aeb00 100644
--- a/src/main.hs
+++ b/src/main.hs
@@ -1,42 +1,39 @@
 import System.IO
-import Statement
-import Parser.Statement
 import Parser.Core
-import Statement
-import Assignment
 import Expr
-import Evaluation
 
 
-main = promptLoop []
+main = return ()
 
-promptLoop :: Context -> IO ()
-promptLoop context = do
-    line <- prompt
-    if line /= "exit"
-       then loop line context >>= promptLoop
-       else return ()
-
-loop :: String -> Context -> IO Context
-loop line context = do s <- parseIO line
-                       context <- printStatement s context
-                       putStrLn $ show context
-                       return context
-
-prompt :: IO String
-prompt = do putStr "> "
-            hFlush stdout
-            getLine
-
-parseIO :: String -> IO Statement
-parseIO input = case parseStrict statementP input of
-                  Nothing -> fail "Couldn't parse input"
-                  Just s  -> return s
-
-printStatement :: Statement -> Context -> IO Context
-printStatement (SAssignment a) context = do putStrLn $ show a
-                                            return $ update context a
-printStatement (SExpr e) context = do putStrLn evalStr
-                                      return context
-    where evalStr = case eval context e of Nothing -> "Couldn't evaluate expression"
-                                           Just a  -> show a
+-- main = promptLoop []
+--
+-- promptLoop :: Context -> IO ()
+-- promptLoop context = do
+--     line <- prompt
+--     if line /= "exit"
+--        then loop line context >>= promptLoop
+--        else return ()
+--
+-- loop :: String -> Context -> IO Context
+-- loop line context = do s <- parseIO line
+--                        context <- printStatement s context
+--                        putStrLn $ show context
+--                        return context
+--
+-- prompt :: IO String
+-- prompt = do putStr "> "
+--             hFlush stdout
+--             getLine
+--
+-- parseIO :: String -> IO Statement
+-- parseIO input = case parseStrict statementP input of
+--                   Nothing -> fail "Couldn't parse input"
+--                   Just s  -> return s
+--
+-- printStatement :: Statement -> Context -> IO Context
+-- printStatement (SAssignment a) context = do putStrLn $ show a
+--                                             return $ update context a
+-- printStatement (SExpr e) context = do putStrLn evalStr
+--                                       return context
+--     where evalStr = case eval context e of Nothing -> "Couldn't evaluate expression"
+--                                            Just a  -> show a
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 '?'