Parser refactoring and replaced stdlib sqrt function with mySqrtHEADmaster

3 files changed, 24 insertions, 31 deletions

diff --git a/src/equation.hs b/src/equation.hs
index 040812f..f332131 100644
--- a/src/equation.hs
+++ b/src/equation.hs
@@ -69,8 +69,8 @@ solveDegree2 :: Float -> Float -> Float -> [Float]
 solveDegree2 a b c
     | phi < 0   = []
     | phi == 0  = [(-b) / (2.0 * a)]
-    | phi > 0   = [ (-b + sqrt phi) / (2.0 * a) -- not alowed
-                  , (-b - sqrt phi) / (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
 
@@ -82,3 +82,14 @@ 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/main.hs b/src/main.hs
index f0a83e5..5d809aa 100644
--- a/src/main.hs
+++ b/src/main.hs
@@ -7,6 +7,7 @@ import Data.List
 import Parser
 import Equation
 
+
 main :: IO ()
 main = catchIOError tryMain handler
     where handler e
diff --git a/src/parser.hs b/src/parser.hs
index bfab053..d523001 100644
--- a/src/parser.hs
+++ b/src/parser.hs
@@ -40,34 +40,23 @@ instance Alternative Parser where
         where new_p s = p1 s <|> p2 s
 
 
-charP :: Char -> Parser Char
-charP x = Parser p
-    where p ""     = Nothing
-          p (c:cs) = if c == x then Just (c, cs)
-                               else Nothing
-
 satisfy :: (Char -> Bool) -> Parser Char
 satisfy f = Parser p
     where p []     = Nothing
           p (c:cs) = if f c then Just (c, cs)
                             else Nothing
 
+charP :: Char -> Parser Char
+charP c = satisfy (c ==)
+
 digitsP :: Parser String
 digitsP = some (satisfy isDigit) -- at least one digit to avoid read exception
 
 spacesP :: Parser String
 spacesP = many (satisfy isSpace)
 
-sepBy :: Parser a -> Parser b -> Parser [a]
-sepBy x sep = many (sep *> x)
-
-prefixedIntP :: Parser Int
-prefixedIntP = read <$> numStr
-    where numStr = ((:) <$> charP '-' <*> (spacesP *> digitsP))
-                    <|> (charP '+' *> spacesP *> digitsP)
-
-intP :: Parser Int
-intP = prefixedIntP <|> (read <$> digitsP)
+sepBy :: Parser b -> Parser a -> Parser [a]
+sepBy sep x = many (sep *> x)
 
 naturalP :: Parser Int
 naturalP = read <$> digitsP
@@ -76,13 +65,6 @@ floatPositiveP :: Parser Float
 floatPositiveP = (f <$> digitsP <*> charP '.' <*> digitsP) <|> (read <$> digitsP)
     where f pos dot dec = read $ pos ++ [dot] ++ dec
 
-signP :: Parser Char
-signP = charP '-' <|> charP '+'
-
-optionnal :: Parser a -> a -> Parser a
-optionnal p placeholder = p <|> pure placeholder
-
-
 -- Equation parsers
 
 unsignedTermP :: Parser Term
@@ -102,15 +84,14 @@ unsignedTermP = fullP <|> varExpP <|> varConstP <|> constP
         expP = spacesP *> charP '^' *> spacesP
 
 signedTermP :: Parser Term
-signedTermP = signF <$> signP <*> (spacesP *> unsignedTermP)
-    where signF '-' (Term c e) = Term (-c) e
+signedTermP = signF <$> signP <* spacesP <*> unsignedTermP
+    where signP = charP '-' <|> charP '+'
+          signF '-' (Term c e) = Term (-c) e
           signF _   t          = t
 
-firstTermP :: Parser Term
-firstTermP = signedTermP <|> unsignedTermP
-
 polynomialP :: Parser Polynomial
-polynomialP = ((:) <$> firstTermP <*> (spacesP *> (sepBy signedTermP spacesP)))
+polynomialP = (:) <$> firstTermP <* spacesP <*> (sepBy spacesP signedTermP)
+    where firstTermP = signedTermP <|> unsignedTermP
 
 equationP :: Parser Equation
 equationP = (\l r -> Equation l r)