Edge case handling in parsing and equation solving

3 files changed, 50 insertions, 18 deletions

diff --git a/src/equation.hs b/src/equation.hs
index 9053fa0..040812f 100644
--- a/src/equation.hs
+++ b/src/equation.hs
@@ -5,6 +5,7 @@ module Equation
 , degree
 , reduce
 , solve
+, filterNull
 ) where
 
 import Data.List
@@ -26,19 +27,26 @@ instance Show Term where
     show (Term c e) = show (round c) ++ " * X^" ++ show e
 
 instance Show Equation where
-    show (Equation l r) = showPolynomial l ++ " = " ++ showPolynomial r
+    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 (c:cs)
+                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 p = Equation.exponent (maximum p)
+degree [] = 0
+degree p  = Equation.exponent (maximum p)
 
 reduce :: Equation -> Equation
 reduce equ = Equation (merge (left stdForm) (right stdForm)) []
diff --git a/src/main.hs b/src/main.hs
index 20815f4..a11f7fc 100644
--- a/src/main.hs
+++ b/src/main.hs
@@ -1,20 +1,31 @@
 import System.Environment
+import System.IO
+import System.IO.Error
+import Control.Exception
 import Data.List
 
 import Parser
 import Equation
 
-
 main :: IO ()
-main = do
+main = catchIOError tryMain handler
+    where handler e
+            | isUserError e = putStrLn $ trimUserError (show e)
+            | otherwise     = putStrLn "Error"
+            where trimUserError s = init $ tail $ dropWhile (/='(') s
+
+tryMain :: IO ()
+tryMain = do
     args <- getArgs
     checkArgs args
     equ <- checkParsing (head args)
     let reduced = reduce equ
+        l       = filterNull $ left reduced
     putStrLn $ "Reduced From: " ++ show reduced
-    putStrLn $ "Polynomial degree: " ++ (show $ degree $ left reduced)
-    putSolutions (left reduced)
-
+    putStrLn $ "Polynomial degree: " ++ (show $ degree l)
+    case l of []  -> putStrLn "Infinite solutions"
+              [_] -> putStrLn "No solution"
+              _   -> putSolutions l
 
 checkArgs :: [String] -> IO ()
 checkArgs args
diff --git a/src/parser.hs b/src/parser.hs
index 6c2b8af..09b0421 100644
--- a/src/parser.hs
+++ b/src/parser.hs
@@ -59,32 +59,45 @@ spacesP :: Parser String
 spacesP = many (satisfy isSpace)
 
 sepBy :: Parser a -> Parser b -> Parser [a]
-sepBy x sep = (:) <$> x <*> many (sep *> x)
+sepBy x sep = many (sep *> x)
 
-
-intP :: Parser Int
-intP = read <$> numStr
+prefixedIntP :: Parser Int
+prefixedIntP = read <$> numStr
     where numStr = ((:) <$> charP '-' <*> (spacesP *> digitsP))
                     <|> (charP '+' *> spacesP *> digitsP)
-                    <|> digitsP
+
+intP :: Parser Int
+intP = prefixedIntP <|> (read <$> digitsP)
 
 naturalP :: Parser Int
 naturalP = read <$> digitsP
 
+signP :: Parser Char
+signP = charP '-' <|> charP '+'
+
 
 -- Equation parsers
-termP :: Parser Term
-termP = notConstantP <|> constantP
-    where constantP    = (\c -> Term (fromIntegral c) 0) <$> intP
+
+unsignedTermP :: Parser Term
+unsignedTermP = notConstantP <|> constantP
+    where constantP    = (\c -> Term (fromIntegral c) 0) <$> naturalP
           notConstantP = (\coef exp -> Term (fromIntegral coef) exp)
-                          <$> intP <*> (between *> naturalP)
+                          <$> naturalP <*> (between *> naturalP)
             where between = spacesP *> charP '*' *>
                             spacesP *> charP 'X' *>
                             spacesP *> charP '^' *>
                             spacesP
 
+signedTermP :: Parser Term
+signedTermP = signF <$> signP <*> (spacesP *> unsignedTermP)
+    where signF '-' (Term c e) = Term (-c) e
+          signF _   t          = t
+
+firstTermP :: Parser Term
+firstTermP = signedTermP <|> unsignedTermP
+
 polynomialP :: Parser Polynomial
-polynomialP = sepBy termP spacesP
+polynomialP = ((:) <$> firstTermP <*> (spacesP *> (sepBy signedTermP spacesP)))
 
 equationP :: Parser Equation
 equationP = (\l r -> Equation l r)