Калькулятор на Хаскеле

Решил в рамках укрепления навыков работы с Хаскеллем написать простенький калькулятор.
При этом без предаврительного лексического разбора и перевода в обратную польскую нотацию. Задача получилось интересной.
Но так я до конца её не решил, так как при таком подходе не получается сделать функции сложения и вычитания левоассоциативными. То есть выражение 1 - 3 +2 у меня считается как 1 - (3+2).
Что-то я туплю, знаю что решение есть у этой задачи. Но найти его не могу.

А пока попробую сделать каклькулятор с предаврительным лексическим разбором и последующей синтаксической обработкой. Думаю, это поможет немного освоить систему типов в Haskell.

Вот код с грамматикой:

module Calculator where

-- epxression grammar 
--                        
-- expression  ::= <addsub_expr> | <muldiv_expr> | <term> 
-- addsub_expr ::= <term2> + <expression> | <term2> - <expression>
-- muldiv_expr ::= <term> * <term2> | <term> / <term2>
-- term2       ::= <muldiv_expr> | <term>
-- term        ::= -<term>  | (<expression>) | unary_func | binary_func | <number> | const
-- unary_func  ::= (ln | exp | sin | cos | ...) (<expression>)
-- binary_func ::= (pow| add | sub | mul | div | ...) (<expression>, <expression>)
-- const       :: = pi | e | ...


type ExprParser = String -> (Float, String, Bool)

-- external functions tables
unary_functions = [("ln",log), ("exp", exp), ("sin", sin), ("cos", cos), ("inc", (+) 1)]
binary_functions= [("pow", (**)), ("add", (+)), ("sub",(-)), ("mul", (*)), ("div",(/))]
constants      = [("pi", pi), ("e", exp 1)]

-- syntax parsers
expr            :: ExprParser
parentheses     :: ExprParser
number          :: ExprParser
muldiv_expr     :: ExprParser
addsub_expr     :: ExprParser
minus_term      :: ExprParser
term            :: ExprParser
term2           :: ExprParser
const_p         :: ExprParser
unary_func      :: ExprParser
binary_func     :: ExprParser

-- entry function
calc :: String -> Float

-- useful functions
find_table_element :: String -> [(String, a)] -> a -> (a, String, Bool)

failParse s = (0, s, False)
isSucceed (val, s, res) = res
getVal (val, s, res) = val
getEndStr (val, s, res) = s

check_str :: String -> String -> (Bool, String)
check_str [] s2 = (True, s2)
check_str s1 [] = (False, [])
check_str s1 s2 = if (head(s1) == head(s2) ) then check_str (tail s1) (tail s2)
                        else (False, s2)
                        
-- parsers selection
infixr 4 >|
(>|) :: ExprParser -> ExprParser -> ExprParser
(p1 >| p2) s = if isSucceed (p1 s) then p1 s else p2 s

------------------------------------------------------------
calc s = getVal (expr (filter (\x-> x /= ' ') s))

------------------------------------------------------------
expr s = (addsub_expr >| term2) s
                
------------------------------------------------------------
number s = case readsPrec 10 s of
                x:xs -> (fst x, snd x, True)
                [] -> failParse s

------------------------------------------------------------
parentheses s@(x:xs) = if (x /= '(') then failParse s
                       else case expr xs of
                        (_, fs, False) -> failParse fs
                        (val, xr:sr, True) -> if (xr == ')') then (val, sr, True) else error "parse error: incorent parentheses"
                        (_, [], _) -> error "parse error: expression parsing failed"                                                
                                
------------------------------------------------------------
minus_term s@(x:xs) = if (x == '-') then
                        if isSucceed (term xs) then
                            ((-1.0)*getVal(term xs), getEndStr(term xs), True)
                        else error ("parse error: expression parsing failed " ++ getEndStr(term xs))
                    else failParse s                           
                                                               
------------------------------------------------------------
term [] = failParse []
term s  = (minus_term >| parentheses >| unary_func >| binary_func >| number >| const_p) s
          
------------------------------------------------------------
term2 s = if isSucceed (muldiv_expr s) then muldiv_expr s
            else term s
        
------------------------------------------------------------
muldiv_expr s = let (v1, s1, r1) = term s
                    (v2, s2, r2) = term2 (drop 1 s1)
                in if r1 && r2 
                        then case head s1 of
                                '*' -> (v1*v2, s2, True)
                                '/' -> (v1/v2, s2, True)
                                otherwise -> failParse s1
                        else if r1 then failParse s2 else failParse s1
                        
------------------------------------------------------------               
addsub_expr s = let (v1, s1, r1) = term2 s
                    (v2, s2, r2) = expr (drop 1 s1)
                in if r1 && r2
                        then case head s1 of
                                '+' -> (v1 + v2, s2, True)
                                '-' -> (v1 - v2, s2, True)
                                otherwise -> failParse s1
                        else if r1 then failParse s2 else failParse s1
                        
------------------------------------------------------------
find_table_element s table df = let sl = map (\x -> (x, check_str (fst x) s)) table
                                    found = filter (fst.snd) sl
                                        in case found of
                                        [] -> (df, [], False)
                                        otherwise -> ((snd.fst.head) found, (snd.snd.head) found, True)
                                        
------------------------------------------------------------
const_p s = find_table_element s constants 0.0
                                        
------------------------------------------------------------
get_unary_func s = find_table_element s unary_functions (\_->0)
get_binary_func s = find_table_element s binary_functions (\_ _->0)
                                                                                        
------------------------------------------------------------                                                   
unary_func s = let (f, s1, r) = get_unary_func s
                   (var, s2, r2) = expr (drop 1 s1) 
                in if r && r2 && head s1 == '(' && head s2 == ')' 
                        then (f(var), drop 1 s2, True)
                        else failParse s1
                
                
binary_func s = let (f, s1, r) = get_binary_func s
                    (var1, s2, r2) = expr (drop 1 s1)
                    (var2, s3, r3) = expr (drop 1 s2) 
                in if r && r2 && r3 && head s1 == '(' && head s2 == ',' && head s3 == ')' 
                        then (f var1 var2, drop 1 s3, True)
                        else failParse s1