husky 0.3 → 0.4
raw patch · 18 files changed
+1006/−349 lines, 18 filesdep ~parsec
Dependency ranges changed: parsec
Files
- ChangeLog +17/−3
- Makefile +2/−2
- doc/usage.html +54/−3
- doc/usage.rst +65/−3
- husky.cabal +4/−4
- src/CalculatorParser.hs +241/−82
- src/CalculatorState.hs +43/−26
- src/ExtraFunctions.hs +27/−3
- src/HelpParser.hs +27/−14
- src/InfoRoutines.hs +32/−4
- src/Messages.hs +12/−7
- src/Parser.hs +5/−5
- src/TokenParser.hs +63/−33
- src/UnitConversionParser.hs +35/−38
- src/UnitConverter.hs +2/−2
- src/husky.hs +33/−21
- test/CalculatorTest.hs +297/−55
- test/ConverterTest.hs +47/−44
ChangeLog view
@@ -1,5 +1,19 @@-2008-03-08 Markus Dittrich <haskelladdict@gmail.com>+2009-04-04 Markus Dittrich <haskelladdict@gmail.com> + * 0.4 release++ * lots of internal improvements and bugfixes; + parser is now almost completely applicative instead of + monadic++ * added ability to define and use custom functions++ * improved help system ++++2009-03-08 Markus Dittrich <haskelladdict@gmail.com>+ * 0.3 release * lots of bug fixes. In particular, operations@@ -14,7 +28,7 @@ * added basic help system -2008-02-22 Markus Dittrich <haskelladdict@gmail.com>+2009-02-22 Markus Dittrich <haskelladdict@gmail.com> * 0.2 release @@ -31,6 +45,6 @@ -2008-02-18 Markus Dittrich <haskelladdict@gmail.com>+2009-02-18 Markus Dittrich <haskelladdict@gmail.com> * 0.1 release
Makefile view
@@ -1,14 +1,14 @@ # Copyright 2008 Markus Dittrich <markusle@gmail.com> # Distributed under the terms of the GNU General Public License v3 -VERSION=0.3+VERSION=0.4 DESTDIR= mandir=$(DESTDIR)/usr/share/man/man1 docdir=$(DESTDIR)/usr/share/doc/husky-$(VERSION) htmldir=$(docdir)/html bindir=$(DESTDIR)/usr/bin -GHC_FLAGS_DEVEL = -O -Wall -Werror -fwarn-simple-patterns -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction -fwarn-implicit-prelude +GHC_FLAGS_DEVEL = -O -Wall -fwarn-simple-patterns -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction -fwarn-implicit-prelude -Werror -fno-warn-orphans GHC_FLAGS_RELEASE = -O2 OBJECTS = src/husky.hs src/CalculatorParser.hs src/CalculatorState.hs \
doc/usage.html view
@@ -294,7 +294,7 @@ <tr><th class="docinfo-name">Author:</th> <td>Markus Dittrich</td></tr> <tr><th class="docinfo-name">Version:</th>-<td>0.3 (03/08/2008)</td></tr>+<td>0.4 (04/04/2009)</td></tr> </tbody> </table> <div class="section" id="introduction">@@ -313,6 +313,8 @@ <p>The following sections describe in detail each functionality.</p> <div class="section" id="calculator"> <h2>Calculator</h2>+<div class="section" id="basic-functionality">+<h3>Basic Functionality</h3> <p>Currently, the mathematical operations "+", "-", "*", and "/" are supported with arbitrary nesting of parenthesised expressions. All calculations are performed in double@@ -325,19 +327,67 @@ <li><em>ln, log2, log10</em> : natural, base2, and base10 logarithm</li> <li><em>cos, sin, tan, acos, asin, atan</em>: trigonometric functions and inverse</li> <li><em>cosh, sinh, tanh, acosh, asinh, atanh</em>: hyperbolic trigonometric functions and inverse</li>+<li><em>fact n</em>: factorial function. NOTE: <em>n</em> has to be an integer or be convertible to an integer type, i.e., <em>fact 2</em> and <em>fact 2.0</em> are fine but <em>fact 2.1</em> is not.</li> </ul>-<p>Furthermore, users can define any number of variables via</p>+</div>+<div class="section" id="variables">+<h3>Variables</h3>+<p>Users can define any number of variables via</p> <blockquote> <em>variable name</em> = value</blockquote> <p>where variable name can be any combination of alphanumeric characters but has to begin with a letter. Hence, <em>foobar1</em> is fine, but <em>1foobar</em> is not. Defined variables can be-used in expressions and definition of other variables.</p>+used in expressions and definition of other variables. Users+can list all currently defined variables via \v (see+<a class="reference internal" href="#command-shortcuts">Command Shortcuts</a>)</p> <p>Since husky uses the GNU readline library all readline related functionality is available at husky's interactive prompt (including command history). See <a class="footnote-reference" href="#id2" id="id1">[1]</a> for more detail.</p> </div>+<div class="section" id="functions">+<h3>Functions</h3>+<p>Users can define their own custom functions via the syntax</p>+<blockquote>+<em>function <function name> <list of variables> = <expression></em></blockquote>+<p>Here, the list of variables can either be a comma separated list+of variable names enclosed in parentheses or a simple list of+variables separated by whitespace without parentheses like in+Haskell. The following expressions are valid and equivalent+function definitions</p>+<pre class="literal-block">+f(x,y) = x * y+f x y = x * x+</pre>+<p>Several restrictions currently apply to function definitions:</p>+<ul class="simple">+<li><em><expression></em> can only span a single line and will be parsed+until the end of the line.</li>+<li><em><expression></em> has to be a single expression, i.e., it can <strong>not</strong>+contain a list of semicolon separated expressions.</li>+</ul>+<p>Functions which have been defined can then be called according to+the same conventions used for function definitions. Hence, function+f as defined above can be called via</p>+<blockquote>+f(3,2) or f 3 2</blockquote>+<p>Here, the calling method does not depend on the way the function+was defined, i.e., a function could be defined the Haskell way and+then be called via f(x,y). The function arguments can either be+literals or constants that have been defined previously. Hence,+the following husky session is valid</p>+<pre class="literal-block">+a = 3+b = 4+function f x y = x * y+f(a,b)+</pre>+<p>will yield the value "12.0".</p>+<p>Users can list all presently defined function via \f (see+<a class="reference internal" href="#command-shortcuts">Command Shortcuts</a>).</p>+</div>+</div> <div class="section" id="unit-converter"> <h2>Unit Converter</h2> <p>The unit conversion functionality of husky can be used via the@@ -367,6 +417,7 @@ <ul class="simple"> <li>\q : quit husky</li> <li>\v : list all currently defined variables</li>+<li>\f : list all currently defined functions</li> <li>\t : current time</li> <li>\h[elp] : available help</li> </ul>
doc/usage.rst view
@@ -4,7 +4,7 @@ :Author: Markus Dittrich -:Version: 0.3 (03/08/2008)+:Version: 0.4 (04/04/2009) Introduction@@ -28,6 +28,9 @@ Calculator ========== +Basic Functionality+###################+ Currently, the mathematical operations "+", "-", "*", and "/" are supported with arbitrary nesting of parenthesised expressions. All calculations are performed in double @@ -40,22 +43,80 @@ - *ln, log2, log10* : natural, base2, and base10 logarithm - *cos, sin, tan, acos, asin, atan*: trigonometric functions and inverse - *cosh, sinh, tanh, acosh, asinh, atanh*: hyperbolic trigonometric functions and inverse+- *fact n*: factorial function. NOTE: *n* has to be an integer or be convertible to an integer type, i.e., *fact 2* and *fact 2.0* are fine but *fact 2.1* is not. -Furthermore, users can define any number of variables via+Variables+######### +Users can define any number of variables via+ *variable name* = value where variable name can be any combination of alphanumeric characters but has to begin with a letter. Hence, *foobar1* is fine, but *1foobar* is not. Defined variables can be-used in expressions and definition of other variables.+used in expressions and definition of other variables. Users+can list all currently defined variables via \\v (see +`Command Shortcuts`_) Since husky uses the GNU readline library all readline related functionality is available at husky's interactive prompt (including command history). See [1]_ for more detail. ++Functions+#########++Users can define their own custom functions via the syntax++ *function <function name> <list of variables> = <expression>*++Here, the list of variables can either be a comma separated list+of variable names enclosed in parentheses or a simple list of+variables separated by whitespace without parentheses like in+Haskell. The following expressions are valid and equivalent+function definitions++::+ + f(x,y) = x * y+ f x y = x * x++Several restrictions currently apply to function definitions:++- *<expression>* can only span a single line and will be parsed+ until the end of the line.+- *<expression>* has to be a single expression, i.e., it can **not**+ contain a list of semicolon separated sub-expressions.++Functions which have been defined can then be called according to+the same conventions used for function definitions. Hence, function+f as defined above can be called via++ f(3,2) or f 3 2++Here, the calling method does not depend on the way the function +was defined, i.e., a function could be defined the Haskell way and+then be called via f(x,y). The function arguments can either be+literals or constants that have been defined previously. Hence,+the following husky session is valid++::++ a = 3+ b = 4+ function f x y = x * y+ f(a,b)++will yield the value "12.0".++Users can list all currently defined function via \\f (see+`Command Shortcuts`_).+++ Unit Converter ============== @@ -88,6 +149,7 @@ - \\q : quit husky - \\v : list all currently defined variables+- \\f : list all currently defined functions - \\t : current time - \\h[elp] : available help
husky.cabal view
@@ -1,5 +1,5 @@ Name: husky-Version: 0.3+Version: 0.4 License: GPL license-file: COPYING copyright: (C) 2009 Markus Dittrich@@ -10,15 +10,15 @@ interactive shells of python, octave, or ruby. Author: Markus Dittrich <haskelladdict@gmail.com> Maintainer: Markus Dittrich <haskelladdict@gmail.com>-stability: alpha+stability: beta build-type: Simple Homepage: http://github.com/markusle/husky/tree/master-cabal-version: >= 1.2.1+cabal-version: >= 1.6 extra-source-files: README Executable husky Build-Depends: base, readline >= 1.0.1.0, containers >= 0.1.0.0,- parsec >= 2.1.0.0, mtl >= 1.1.0.0, + parsec == 2.1.*, mtl >= 1.1.0.0, old-locale >= 1.0.0.0, time >= 1.0.0.0 ghc-options: -O2 Main-Is: husky.hs
src/CalculatorParser.hs view
@@ -32,70 +32,59 @@ import Prelude import TokenParser +--import Debug.Trace -- | grammar description for calculator parser-calculator_parser :: CharParser CalcState (Double, String)-calculator_parser = try ( define_variable >>= \x -> return (x,"") )- <|> (add_term >>= \x -> end_of_line >> return (x,"") )- <?> "math expression, variable definition, " ++- "variable name"+calculator_parser :: CharParser CalcState ParseResult+calculator_parser = parse_statements <* eof + <?> "math expression, variable definition, " + ++ "variable name" +-- | parse individual statements separated by semicolon+-- NOTE: 'sepBy1' as opposed to 'sepBy' is crucial here to+-- guarantee the list is not empty; otherwise head will die+-- on us.+parse_statements :: CharParser CalcState ParseResult+parse_statements = (head . reverse) <$> individual_statement + `sepBy1` semi+ <?> "statement"+ ++-- | parse an individual statement, i.e. either a computation+-- , a function definition, or a variable definition+individual_statement :: CharParser CalcState ParseResult+individual_statement = try define_function+ <|> try (DblResult <$> define_variable) + <|> (DblResult <$> add_term) + <?> "expression or variable definition"+++ -- | if the line starts off with a string we either -- have a variable definition or want to show the value -- stored in a variable define_variable :: CharParser CalcState Double-define_variable = (whiteSpace- >> variable- >>= \varName -> variable_def varName )+define_variable = variable_def_by_value <?> "variable definition" --- | check that we are at the end of the line; otherwise--- parsing failed since we always expect to parse the --- full expression-end_of_line :: CharParser CalcState ()-end_of_line = getInput >>= \input ->- case length input of- 0 -> return ()- _ -> pzero----- | define a variable-variable_def :: String -> CharParser CalcState Double-variable_def varName = ( whiteSpace- >> reservedOp "=" - >> whiteSpace - >> ( variable_def_by_value varName - <|> variable_def_by_var varName) )- <?> "variable"-- -- | define a variable via a literal double-variable_def_by_value :: String -> CharParser CalcState Double-variable_def_by_value varName = ( add_term- >>= \value -> updateState (insert_variable value varName)- >> return value )- <?> "variable from value"+variable_def_by_value :: CharParser CalcState Double+variable_def_by_value = update_var (whiteSpace *> variable) + (whiteSpace *> reservedOp "=" *> whiteSpace *> add_term)+ <?> "variable from value" --- | define a variable via the value of another variable-variable_def_by_var :: String -> CharParser CalcState Double-variable_def_by_var varName = parse_variable - >>= \value -> updateState (insert_variable value varName)- >> return value- +-- | update the state of a variable+update_var :: CharParser CalcState String + -> CharParser CalcState Double+ -> CharParser CalcState Double+update_var name_p val_p = name_p+ >>= \name -> val_p+ >>= \val -> updateState (insert_variable name val)+ >> return val --- | look for the value of a given variable if any-parse_variable :: CharParser CalcState Double-parse_variable = ( variable - >>= \val -> whiteSpace- >> get_variable_value val- >>= \result -> case result of- Just a -> return a - Nothing -> pzero )- <?> "variable"- -- | parser for expressions chained via "+" or "-" add_term :: CharParser CalcState Double@@ -109,71 +98,241 @@ -- | parser for potentiation operations "^" exp_term :: CharParser CalcState Double-exp_term = (whiteSpace >> factor) `chainl1` exp_action+exp_term = (whiteSpace *> factor) `chainl1` exp_action -- | parser for individual factors, i.e, numbers, -- variables or operations factor :: CharParser CalcState Double factor = try signed_parenthesis- <|> parse_keywords- <|> parse_number- <|> parse_variable+ <|> try parse_user_functions+ <|> parse_functions+ <|> parse_functions_int + <|> try parse_single_number -- need try because of possible+ -- unitary '-'+ <|> try parse_stack -- always parse stack first since+ -- local variables hide global ones+ <|> parse_variable <?> "token or variable" -- | parse a potentially signed expression enclosed in parenthesis. -- In the case of parenzised expressions we parse -() as (-1.0)*() signed_parenthesis :: CharParser CalcState Double-signed_parenthesis = parse_sign- >>= \sign -> parens add_term- >>= \result -> return (sign * result)+signed_parenthesis = (*) <$> parse_sign <*> parens add_term --- | parse all operations we currently know about-parse_keywords :: CharParser CalcState Double-parse_keywords = msum $ extract_ops builtinFunctions+-- | parse all operations of type (Double -> Double)+-- we currently know about+parse_functions :: CharParser CalcState Double+parse_functions = msum $ extract_ops builtinFunctions - where- extract_ops = foldr (\(x,y) acc -> - ((reserved x >> execute y):acc)) [] + where+ extract_ops = foldr (\(x,y) acc -> + ((reserved x *> execute y):acc)) [] + execute op = op <$> ( parens add_term + <|> parse_single_number+ <|> parse_variable )+ <?> "function parsing" --- | execute the requested operator on the term enclosed--- in parentheses -execute :: OperatorAction -> CharParser CalcState Double-execute op = parens add_term >>= return . op+-- | parse all operations of type (Int -> Int) we currently know about+-- NOTE: They way we do things right now to deal with Integers+-- in the framework of our Double parser is somewhat of a +-- hack. In a nutshell, we check if a Double can be interpreted+-- as an Integer and then use (of fail the parse)+parse_functions_int :: CharParser CalcState Double+parse_functions_int = msum $ extract_ops_int builtinFunctionsInt - + where+ extract_ops_int :: [(String, Integer -> Integer)] + -> [CharParser CalcState Double]+ extract_ops_int = foldr (\(x,y) acc -> + ((reserved x *> execute_int y):acc)) []++ execute_int op = fromInteger . op <$> ( parens add_term + <|> parse_single_number + <|> parse_variable + >>= evaluate_int )++ evaluate_int = \val -> case is_non_negative_int val of+ Just a -> return a+ Nothing -> pzero + <?> "non-negative integer value" +++-- | chain multiplicative of divisive statements multiply_action :: CharParser CalcState (Double -> Double -> Double)-multiply_action = (reservedOp "*" >> return (*))- <|> (reservedOp "/" >> return (/))+multiply_action = (reservedOp "*" *> pure (*))+ <|> (reservedOp "/" *> pure (/)) +-- | chain additive or subtractive statements add_action :: CharParser CalcState (Double -> Double -> Double)-add_action = (reservedOp "+" >> return (+))- <|> (reservedOp "-" >> return (-))+add_action = (reservedOp "+" *> pure (+))+ <|> (reservedOp "-" *> pure (-)) +-- | parse an exponentiation term exp_action :: CharParser CalcState (Double -> Double -> Double)-exp_action = reservedOp "^" >> return real_exp+exp_action = reservedOp "^" *> pure real_exp +-- | parse a single number; integers are automatically promoted +-- to double+-- NOTE: Due to the notFollowedBy this parser can not be used+-- with 'many' and other parser combinators.+parse_single_number :: CharParser CalcState Double+parse_single_number = parse_number <* notFollowedBy alphaNum+ <?> "signed single integer or double"+++-- | parse a number, can be used with 'many' and other parser+-- combinators; integers are automatically promoted to double parse_number :: CharParser CalcState Double-parse_number = parse_sign- >>= \sign -> naturalOrFloat - >>= \num -> notFollowedBy alphaNum- >> case num of - Left i -> return $ sign * (fromInteger i)- Right x -> return (sign * x)+parse_number = converter <$> (parse_sign <* whiteSpace) <*> + naturalOrFloat + <?> "signed integer or double"+ where + converter sign val = case val of+ Left i -> sign * (fromInteger i)+ Right x -> sign * x +-- | parse the sign of a numerical expression parse_sign :: CharParser CalcState Double-parse_sign = option 1.0 ( whiteSpace >> char '-' >> return (-1.0) )+parse_sign = option 1.0 ( whiteSpace *> char '-' *> pure (-1.0) ) +-- | look for the value of a given variable if any+parse_variable :: CharParser CalcState Double+parse_variable = (*) <$> (parse_sign <* whiteSpace) <*>+ (get_variable_value variable <* whiteSpace)+ <?> "variable"++ -- | function retrieving a variable from the database if -- present -get_variable_value :: String -> CharParser CalcState (Maybe Double)-get_variable_value name = getState - >>= \(CalcState { varMap = myMap }) -> return $ M.lookup name myMap+get_variable_value :: CharParser CalcState String + -> CharParser CalcState Double+get_variable_value name_parser = getState + >>= \(CalcState { varMap = myMap }) -> name_parser+ >>= \name -> case M.lookup name myMap of+ Nothing -> pzero+ Just a -> return a+ ++-- | this is how valid variable names have to look like+variable :: CharParser CalcState String+variable = (:) <$> letter <*> many alphaNum+++-- | look for the value of a given stack variable+parse_stack :: CharParser CalcState Double+parse_stack = (*) <$> (parse_sign <* whiteSpace) <*>+ (get_stack_variable variable <* whiteSpace)+ <?> "variable"+++-- | function retrieving a variable from the database if+-- present +get_stack_variable :: CharParser CalcState String + -> CharParser CalcState Double+get_stack_variable name_parser = getState + >>= \(CalcState { funcStack = stack }) -> name_parser+ >>= \name -> case M.lookup name stack of+ Nothing -> pzero+ Just a -> return a+ ++-- | this is how valid function Strings have to look like+functionString :: CharParser CalcState String+functionString = many anyChar+++-- | parser for a function definition+-- TODO: It might be a good idea to check the user defined+-- function somewhat, e.g., do the parameters match etc+define_function :: CharParser CalcState ParseResult+define_function = add_function parse_function_name parse_vars + parse_function_def + *> pure (StrResult "<function>")+ + where+ add_function name_parser var_parser expr_parser =+ join $ updateState <$> + (insert_function <$> name_parser <*> var_parser <*> expr_parser) +++ parse_function_name = (whiteSpace *> reserved "function" + *> whiteSpace *> variable <* whiteSpace)+++ -- | we allow both f(x,y) and haskell style f x y function + -- definitions+ parse_vars = (parens ((variable <* whiteSpace) `sepBy` comma))+ <|> many (variable <* whiteSpace)+++ parse_function_def = (whiteSpace *> reservedOp "=" *> whiteSpace + *> functionString)+++-- | parse available user function; the way we deal with user+-- functions for now goes like this:+-- 1) Check if a user function of the given name exists+-- 2) If yes, check if the user supplied the proper number of+-- arguments (for now we only allow literals, not variables)+-- 3) If yes, replace the variables by the literals in the function+-- string.+-- 4) Insert the so manipulated and parenthesized function +-- expression into the current parser and parse it+parse_user_functions :: CharParser CalcState Double +parse_user_functions = + substitute_function parse_function_name parse_arguments++ where+ -- | arguments can either be applied via f(x,y) or the haskell+ -- way f x y+ parse_arguments = parens ((parse_arg <* whiteSpace) `sepBy` comma) + <|> many ( parse_arg <* whiteSpace )+ + where+ parse_arg = (parse_number <|> parse_variable)+++ parse_function_name = (whiteSpace *> variable <* whiteSpace)+++ -- | substitute a function expression into the current parse+ -- string+ substitute_function name_parser var_parser = name_parser+ >>= get_function_expression+ >>= \(Function { f_vars = target_vars+ , f_expression = expr } ) -> var_parser+ >>= \vars -> push_vars_to_stack vars target_vars+ >> getInput+ >>= \inp -> setInput ("(" ++ expr ++ ")" ++ inp)+ >> parens add_term + >>= \result -> updateState clear_stack+ >> return result++ + -- | retrieve the function expression corresponding to a+ -- particular function name+ get_function_expression name = getState+ >>= \(CalcState { funcMap = myMap }) -> + case M.lookup name myMap of+ Nothing -> pzero+ Just a -> return a+++ -- | check if the number of expected and provided arguments+ -- match and push the variables on the local stack so the+ -- parser can replace the parameters while parsing + push_vars_to_stack vars target_vars = + if length vars /= length target_vars+ then pzero+ else mapM_ (updateState . push_to_stack) + (zip target_vars vars)+
src/CalculatorState.hs view
@@ -22,11 +22,12 @@ -- the calculator. Eventually, these might all find a home -- in their separate modules module CalculatorState ( CalcState(..)- , have_special_error+ , clear_stack , defaultCalcState - , insert_error+ , Function(..)+ , insert_function , insert_variable- , reset_state+ , push_to_stack ) where @@ -35,6 +36,16 @@ import Prelude +-- | this data structure holds information for user defined+-- functions+data Function = Function + {+ f_vars :: [String]+ , f_expression :: String+ }+ deriving(Show)++ -- | this data structure provides some state information -- to the calculator (variables, etc ...) -- Currently, we thread the following pieces of information:@@ -45,43 +56,49 @@ -- errValue : [String] holding all special error messages data CalcState = CalcState { - varMap :: M.Map String Double - , errValue :: [String]+ varMap :: M.Map String Double + , funcMap :: M.Map String Function + , funcStack :: M.Map String Double -- local stack for passing+ -- function parameters } defaultCalcState :: CalcState defaultCalcState = CalcState { - varMap = M.fromList constantList - , errValue = []+ varMap = M.fromList constantList + , funcMap = M.empty+ , funcStack = M.empty } --- | function returning special error message if present-have_special_error :: CalcState -> Maybe String-have_special_error (CalcState { errValue = msg }) =- if (null msg)- then Nothing- else Just . unlines $ msg +-- | function pushing a variable on the stack+push_to_stack :: (String,Double) -> CalcState -> CalcState+push_to_stack (name,val) state@(CalcState {funcStack = stack}) =+ state { funcStack = M.insert name val stack } --- | function adding a new variable to the database-insert_variable :: Double -> String -> CalcState -> CalcState-insert_variable num name state@(CalcState { varMap = theMap }) =- state { varMap = M.insert name num theMap } +-- | function for clearing the stack+clear_stack :: CalcState -> CalcState+clear_stack state = state { funcStack = M.empty } --- | function inserting a new special error message into--- the error queue-insert_error :: String -> CalcState -> CalcState-insert_error err state@(CalcState { errValue = val }) = - state { errValue = err:val } - --- | function resetting the special error queue -reset_state :: CalcState -> CalcState-reset_state state = state { errValue = [] }+-- | function adding a new variable into the calculator state+-- database+insert_variable :: String -> Double -> CalcState -> CalcState+insert_variable name num state@(CalcState {varMap = theMap}) =+ state { varMap = M.insert name num theMap } +++-- | insert a user definied function into the calculator state+-- database+insert_function :: String -> [String] -> String -> CalcState + -> CalcState+insert_function name vars expr state@(CalcState {funcMap = theMap}) =+ state { funcMap = M.insert name theFunc theMap }+ where+ theFunc = Function { f_vars = vars, f_expression = expr } -- | provide a few useful mathematical constants that we
src/ExtraFunctions.hs view
@@ -19,9 +19,11 @@ --------------------------------------------------------------------} --- | definition of a few additional helper function (e.g. from libc)-module ExtraFunctions ( real_exp +-- | definition of additional math and helper functions+module ExtraFunctions ( fact , is_equal+ , is_non_negative_int+ , real_exp ) where @@ -35,11 +37,27 @@ dbl_epsilon :: Double dbl_epsilon = 2.2204460492503131e-16 + -- | comparison function for doubles via dbl_epsion is_equal :: Double -> Double -> Bool is_equal x y = abs(x-y) <= abs(x) * dbl_epsilon +-- | function checking if a Double can be interpreted as a non+-- negative Integer. We need this since all parsing of numbers +-- is done with Doubles but some functions only work for +-- non-negative integers such as factorial.+-- To check if we are dealing with Double, we convert to an+-- Integer via floor and the compare if the numbers are identical.+-- If yes, the number seems to be an Integer and we return it,+-- otherwise Nothing+is_non_negative_int :: Double -> Maybe Integer+is_non_negative_int x = + case is_equal (fromInteger . floor $ x) x of+ True -> Just $ floor x+ False -> Nothing++ -- | helper function for defining real powers -- NOTE: We use glibc's pow function since it is more -- precise than implementing it ourselves via, e.g.,@@ -47,5 +65,11 @@ foreign import ccall "math.h pow" c_pow :: CDouble -> CDouble -> CDouble -real_exp :: Double -> Double -> Double+real_exp :: Double -> Double -> Double real_exp a x = realToFrac $ c_pow (realToFrac a) (realToFrac x)+++-- | factorial function+fact :: Integer -> Integer+fact 0 = 1+fact n = n * fact (n-1)
src/HelpParser.hs view
@@ -27,6 +27,7 @@ -- local imports import CalculatorState+import Messages import Prelude import PrettyPrint import TokenParser@@ -36,13 +37,13 @@ -- | main help parser entry point help :: CharParser CalcState String-help = ( help_keyword - >> optionMaybe parse_help_option - >>= \opt -> case opt of- Nothing -> return help_info- Just r -> return r )+help = eval_request <$> (help_keyword + *> optionMaybe parse_help_option) <?> "help"-+ where+ eval_request x = case x of+ Nothing -> help_info+ Just r -> r -- | parser for help keyword@@ -61,22 +62,33 @@ -- | retrieve unit conversion information unit_info :: CharParser CalcState String-unit_info = ( string "units"- >> optionMaybe parse_unit_type- >>= \unitType -> return $ retrieve_unit_string unitType)+unit_info = retrieve_unit_string <$> (string "units" + *> optionMaybe parse_unit_type) <?> "unit info" -- | return about info about_info :: CharParser CalcState String about_info = string "about"- >> return about_string+ >> return infoString <?> "about info"- where- about_string = "husky (v0.3) (C) 2009 Markus Dittrich\n"- ++ "husky is licenced under the GPL V3\n" +-- | return info about available commands+command_info :: CharParser CalcState String+command_info = string "commands" *> pure commandString+ <?> "command info"+++-- | currently available commands+commandString :: String+commandString = (color_string Yellow $ "Available commands:\n")+ ++ "\\q - quit\n"+ ++ "\\t - show current date and time\n"+ ++ "\\v - list currently defined variables\n"+ ++ "\\f - list currently defined functions\n"++ -- | return all currently available help options help_info :: String help_info = (color_string Yellow $ "Available help options"@@ -90,6 +102,7 @@ -- together with a parser for that particular help option helpOptions :: [(String, CharParser CalcState String)] helpOptions = [ ("about - about husky", about_info)- , ("units [:: <unit type>] - list available unit "+ , ("commands - list commands", command_info)+ , ("conversion [:: <type>] - list available unit " ++ "conversions", unit_info) ]
src/InfoRoutines.hs view
@@ -21,15 +21,19 @@ -- | routines called from the toplevel readline instance without -- before any parsing is done, aka info routines of any sort and -- shape-module InfoRoutines ( list_variables +module InfoRoutines ( confirm_and_exit+ , list_functions+ , list_variables , show_time ) where -- imports+import Data.List import Data.Map import Data.Time import Prelude+import System.IO import System.Locale @@ -39,13 +43,27 @@ -- | list all currently defined variables list_variables :: CalcState -> IO ()-list_variables (CalcState { varMap = theMap }) = +list_variables (CalcState {varMap = theMap}) = mapM_ print_variable (assocs theMap) where- print_variable x = putStrLn (fst x ++ " == " ++ (show $ snd x)) + print_variable (x,y) = putStrLn (x ++ " == " ++ (show y)) +-- | list all currently defined functions+list_functions :: CalcState -> IO ()+list_functions (CalcState {funcMap = theMap} ) = + mapM_ print_function (assocs theMap)++ where+ print_function ( x+ , (Function { f_vars = vars + , f_expression = expr } + )+ ) =+ putStrLn (x ++ "(" ++ intercalate [','] vars ++ ") = " ++ expr)++ -- | display the current localtime show_time :: IO () show_time = getCurrentTime@@ -54,7 +72,17 @@ let localTime = utcToLocalTime zone utcTime timeString = formatTime defaultTimeLocale - "%a %b %m %Y <> %T %Z " localTime + "%a %b %d %Y <> %T %Z " localTime in putStrLn timeString ++-- | ask user for confirmation before exiting+confirm_and_exit :: IO Bool+confirm_and_exit = putStr "Really quit (y/n)? "+ >> hFlush stdout+ >> getLine+ >>= \answer -> case answer of + "y" -> return True+ "n" -> return False+ _ -> confirm_and_exit
src/Messages.hs view
@@ -20,6 +20,7 @@ -- | Messages provides common messages module Messages ( husky_result+ , infoString , print_error_message , show_greeting ) where@@ -32,11 +33,17 @@ import PrettyPrint --- current version+-- | current version version :: String-version = "0.3"+version = "0.4" +-- | info string+infoString :: String+infoString = "Welcome to husky (v" ++ version ++ ")\n" + ++ "(C) 2009 Markus Dittrich, licensed under the GPL-3\n"+ ++ "husky comes WITHOUT ANY WARRANTY\n" + -- | display output somewhat colorful husky_result :: [String] -> IO () husky_result items = do@@ -46,11 +53,9 @@ -- | greeting show_greeting :: IO () -show_greeting = do - putStrLn $ "Welcome to husky (v" ++ version - ++ ") (C) 2009 Markus Dittrich"- putStrLn "-------------------------------------------------"-+show_greeting = putStrLn $ banner ++ "\n" ++ infoString ++ banner+ where+ banner = replicate 60 '*' -- | helpful message after bad parse print_error_message :: String -> IO ()
src/Parser.hs view
@@ -31,17 +31,17 @@ -- | main parser entry point-main_parser :: CharParser CalcState ((Double,String), CalcState)-main_parser = parser_dispatch- >>= \val -> getState- >>= \state -> return (val, state)+main_parser :: CharParser CalcState (ParseResult, CalcState)+main_parser = (,) <$> parser_dispatch <*> getState+ <?> "main parser" -- | grammar description for parser -- presently we either dispatch to unit_conversion parser -- or calculator parser-parser_dispatch :: CharParser CalcState (Double,String)+parser_dispatch :: CharParser CalcState ParseResult parser_dispatch = try unit_conversion <|> calculator_parser <?> "unit conversion or calculator expression"+
src/TokenParser.hs view
@@ -19,69 +19,82 @@ --------------------------------------------------------------------} -- | functionality related to parsing tokens-module TokenParser ( module Text.ParserCombinators.Parsec+module TokenParser ( module Control.Applicative+ , module Text.ParserCombinators.Parsec , builtinFunctions+ , builtinFunctionsInt+ , comma+ , charLiteral , float- , identifier , integer , parens+ , keywords , lexer , naturalOrFloat- , keywords , OperatorAction+ , ParseResult(..) , operators , reservedOp , reserved+ , semi , stringLiteral- , unit_value- , unit_type- , variable , whiteSpace ) where -- imports-import Text.ParserCombinators.Parsec +import Control.Applicative+import Control.Monad (ap, MonadPlus (..))+import Prelude+import Text.ParserCombinators.Parsec hiding (many,optional, (<|>)) import qualified Text.ParserCombinators.Parsec.Token as PT import Text.ParserCombinators.Parsec.Language (haskellDef , opLetter , reservedOpNames , reservedNames )-import Prelude -- local imports-import CalculatorState+import ExtraFunctions -{- | some basic definitions for the calculator -}+{- Definitions for Applicative Parsec instance -} --- | this is how valid variable names have to look like-variable :: CharParser CalcState String-variable = letter - >>= \first -> many alphaNum- >>= \rest -> return $ [first] ++ rest+-- | Applicative instance for Monad+instance Applicative (GenParser s a) where+ pure = return+ (<*>) = ap --- | an identifier for a unit_value and unit_type is just a variable --- (at least for now). -unit_value :: CharParser CalcState String-unit_value = variable+-- |Alternative instance for MonadPlus+instance Alternative (GenParser s a) where+ empty = mzero+ (<|>) = mplus -unit_type :: CharParser CalcState String-unit_type = variable +{- define possible Parse Results -}+data ParseResult = + DblResult Double -- double result+ | UnitResult (Double,String) -- unit conversion result+ | StrResult String -- no result (e.g. function def)+ | ErrResult String -- error occured, has error message+ deriving(Eq,Show,Ord)+++{- set up the Token Parser -}+ -- | these are all the names and corresponding functions -- of keywords we know about-type OperatorAction = (Double -> Double)+type OperatorAction = (Double -> Double)+type OperatorActionInt = (Integer -> Integer) --- | builtin functions of the form (a -> b)+-- | builtin functions of the form (Double -> Double) builtinFunctions :: [(String, OperatorAction)] builtinFunctions = [ ("sqrt",sqrt)- , ("exp",exp)+ , ("exp",exp) , ("log",log) , ("log2", logBase 2) , ("log10", logBase 10)@@ -96,27 +109,34 @@ , ("tanh", tanh) , ("asinh", sinh) , ("acosh", cosh)- , ("atanh", atanh)]+ , ("atanh", atanh)] +-- | builtin function of the type (Integer -> Double) that need+-- type conversion from Int to Double. This is a separate category+-- since in the parser we need to explicitly check the the+-- user entered an Int and fail otherwise+builtinFunctionsInt :: [(String, OperatorActionInt)]+builtinFunctionsInt = [("fact", fact)]++ -- | all other keywords that are not regular functions keywords :: [String]-keywords = ["\\convert","\\c"]+keywords = ["convert","conv","function","end"] operators :: [String] operators = ["*","/","+","-","="] -{- | prepare needed parsers from Parsec.Token -}- -- | function generating a token parser based on a -- lexical parser combined with a language record definition lexer :: PT.TokenParser st lexer = PT.makeTokenParser ( haskellDef { reservedOpNames = operators- , opLetter = oneOf "*+/^"- , reservedNames = keywords - ++ map fst builtinFunctions + , opLetter = oneOf "*+/^"+ , reservedNames = keywords + ++ map fst builtinFunctions + ++ map fst builtinFunctionsInt } ) @@ -136,8 +156,8 @@ -- | token parser for Char-identifier :: CharParser st String-identifier = PT.stringLiteral lexer+charLiteral :: CharParser st Char+charLiteral = PT.charLiteral lexer -- | token parser for Double@@ -161,3 +181,13 @@ -- | token parser for whitespace whiteSpace :: CharParser st () whiteSpace = PT.whiteSpace lexer++-- | token parser for semicolon+semi :: CharParser st String+semi = PT.semi lexer+++-- | token parser for comma+comma :: CharParser st String+comma = PT.comma lexer+
src/UnitConversionParser.hs view
@@ -31,68 +31,65 @@ import UnitConverter +-- | an identifier for a unit_value and unit_type +unit_value :: CharParser CalcState String+unit_value = unit_variable++unit_type :: CharParser CalcState String+unit_type = unit_variable++unit_variable :: CharParser CalcState String+unit_variable = letter + >>= \first -> many alphaNum+ >>= \rest -> return $ [first] ++ rest++ -- | parser for unit conversions -- the user can request a conversion between two compatible -- unit-full values (temperatures, lengths, ...). -- The command spec is -- conv <value in unit1> <unit1> <unit2> [ :: <unit type> ] -- and returns <value in unit2>-unit_conversion :: CharParser CalcState (Double,String)-unit_conversion = (whiteSpace- >> conversion_keyword- >> whiteSpace- >> parse_unit_value- >>= \value -> whiteSpace- >> unit_value- >>= \unit1 -> whiteSpace- >> unit_value- >>= \unit2 -> whiteSpace- >> optionMaybe parse_unit_type - >>= \unitType ->- case convert_unit unit1 unit2 unitType value of- Left err -> add_error_message err - >> return (0,"") - Right (conv, unit) -> return (conv,unit) )- <?> "unit conversion"- +unit_conversion :: CharParser CalcState ParseResult+unit_conversion = whiteSpace *> conversion_keyword *> + ( converter + <$> (whiteSpace *> parse_unit_value) + <*> (whiteSpace *> unit_value) + <*> (whiteSpace *> unit_value) + <*> (whiteSpace *> optionMaybe parse_unit_type) ) + where+ converter val u1 u2 utype = case convert_unit val u1 u2 utype of+ Left err -> ErrResult err+ Right (conv,unit) -> UnitResult (conv,unit)++ -- | parse a unit value -- We can't use parse_number since we'd like to explictly allow -- things like 1m or 2yd which parse_number rejects parse_unit_value :: CharParser CalcState Double-parse_unit_value = parse_sign - >>= \sign -> naturalOrFloat - >>= \num -> case num of - Left i -> return $ sign * (fromInteger i)- Right d -> return (sign * d) +parse_unit_value = converter <$> parse_sign <*> naturalOrFloat + where + converter sign val = case val of+ Left i -> sign * (fromInteger i)+ Right x -> sign * x -- | parse the optional sign in front of a unit value parse_sign :: CharParser CalcState Double-parse_sign = option 1.0 ( whiteSpace >> char '-' >> return (-1.0) )+parse_sign = option 1.0 ( whiteSpace *> char '-' *> pure (-1.0) ) -- | parse for all acceptable conversion keywords conversion_keyword :: CharParser CalcState ()-conversion_keyword = reserved "\\c" - <|> reserved "\\convert"+conversion_keyword = reserved "conv" + <|> reserved "convert" <?> "(c)onv keyword" --- | this function adds an error message to the queue of--- special (outside of parsing errors) to the error--- queue-add_error_message :: String -> CharParser CalcState ()-add_error_message = updateState . insert_error-- -- | this parser parses an (optional) unit type signature following -- a unit conversion statement. It should be of the form -- (a la Haskell ;) ) " :: unit_type " parse_unit_type :: CharParser CalcState String-parse_unit_type = (whiteSpace- >> string "::"- >> whiteSpace- >> unit_type )+parse_unit_type = whiteSpace *> string "::" *> whiteSpace *> unit_type <?> "unit_type"-
src/UnitConverter.hs view
@@ -40,9 +40,9 @@ -- with a hopefully useful error message. -- 2) If a user supplies a unit type specifier we directly look -- through the corresponding map for a conversion-convert_unit :: String -> String -> Maybe String -> Double +convert_unit :: Double -> String -> String -> Maybe String -> Either String (Double,String) -convert_unit unit1 unit2 unitType value = +convert_unit value unit1 unit2 unitType = case unitType of -- no unit type specifier: look through all unit maps
src/husky.hs view
@@ -51,23 +51,34 @@ input <- readline $ color_string Red "husky> " case input of Nothing -> parse_it state- Just "" -> parse_it state -- continue without parsing- Just "\\q" -> return () -- quit- Just "\\v" -> list_variables state -- list all defined variables- >> parse_it state- Just "\\t" -> show_time -- show current time++ Just "" -> parse_it state -- continue w/o parsing++ Just "\\q" -> confirm_and_exit + >>= \ans -> case ans of -- quit after confirmation+ True -> return () -- otherwise continue+ False -> parse_it state++ Just "\\v" -> list_variables state -- list all defined + >> parse_it state -- variables++ Just "\\f" -> list_functions state -- list all defined+ >> parse_it state -- functions++ Just "\\t" -> show_time -- show current time >> parse_it state- Just line -> do -- otherwise calculate + Just line -> do -- otherwise calculate + addHistory line - -- parse it as a potential help request- -- if it succeeds we parse the next command line, otherwise- -- we channel it into the calculator parser+ {- parse it as a potential help request if it succeeds we + parse the next command line, otherwise we channel it + into the calculator parser -} case runParser help state "" line of Right helpMsg -> putStr helpMsg >> parse_it state - Left _ ->+ Left _ -> -- parse it as a calculation or unit conversion case runParser main_parser state "" line of@@ -75,16 +86,17 @@ Left er -> print_error_message (show er) >> parse_it state - -- if the parser succeeds we still check for special- -- error conditions in our parse state that may have- -- been triggered by errors outside the parser (e.g.,- -- unit conversion may have failed for lack of proper- -- conversion function etc.)- Right ((result,unit), newState) -> - case have_special_error newState of- Just err -> (putStr $ "Error: " ++ err)- Nothing -> husky_result $ (show result):[unit]+ {- if the parser succeeds we do one of the following:+ 1) If the return value is a DblResult or UnitResult we + just print it+ 2) If the return value is a ErrResult we print the+ the associated error string -}+ Right (result, newState) -> + case result of+ DblResult d -> husky_result $ (show d):[""]+ UnitResult (v,u) -> husky_result $ (show v):[u]+ ErrResult err -> (putStrLn $ "Error: " ++ err)+ StrResult str -> husky_result $ str:[""] - >> let cleanState = reset_state newState in- parse_it cleanState+ >> parse_it newState
test/CalculatorTest.hs view
@@ -47,18 +47,27 @@ simpleTests status1 <- examine_output simple + putStr $ color_string Cyan "\nFunction parsing tests:\n"+ let vars = execWriter $ good_test_driver defaultCalcState + functionTests+ status2 <- examine_output vars+ putStr $ color_string Cyan "\nVariable tests:\n" let vars = execWriter $ good_test_driver defaultCalcState variableTests- status2 <- examine_output vars+ status3 <- examine_output vars putStr $ color_string Cyan "\nFailure tests:\n" let failing = execWriter $ failing_test_driver defaultCalcState failingTests- status2 <- examine_output failing+ status4 <- examine_output failing + putStr $ color_string Cyan "\nUser defined function tests:\n"+ let userFuncs = execWriter $ good_test_driver defaultCalcState + userFunctionTests+ status5 <- examine_output userFuncs - let status = status1 && status2 + let status = status1 && status2 && status3 && status4 && status5 if status == True then exitWith ExitSuccess else@@ -105,24 +114,40 @@ let expected = snd x case runParser main_parser state "" tok of Left er -> tell [TestResult False tok (show expected) (show er)]- Right ((result,_), newState) -> examine_result expected result tok+ Right (result, newState) -> examine_result expected result tok where- -- NOTE: when we compare target and actual result we- -- probably need to be more careful and can't use ==- -- if we are dealing with Doubles!!!- examine_result :: Double -> Double -> String + -- for comparing doubles we use is_equal otherwise we+ -- go with good old ==+ examine_result :: ParseResult -> ParseResult -> String -> Writer [TestResult] ()- examine_result target actual tok = + examine_result (DblResult target) (DblResult actual) tok = if (is_equal target actual) - then do+ then success target actual+ else failure target actual++ examine_result target actual tok = + if target == actual + then success target actual+ else failure target actual+ ++ {- then do tell [TestResult True tok (show target) (show actual)] good_test_driver newState xs else do tell [TestResult False tok (show target) (show actual)]- good_test_driver newState xs+ good_test_driver newState xs -} + success target actual = do+ tell [TestResult True tok (show target) (show actual)]+ good_test_driver newState xs + failure target actual = do+ tell [TestResult False tok (show target) (show actual)]+ good_test_driver newState xs ++ -- | main test routine for "failing tests" failing_test_driver :: CalcState -> [FailingTestCase] -> Writer [TestResult] ()@@ -151,7 +176,7 @@ -- | a good test case consists of an expression and an -- expected result-type GoodTestCase = (String, Double)+type GoodTestCase = (String, ParseResult) -- | a failing test case currently consists only of an@@ -178,141 +203,240 @@ , simpleTest15, simpleTest16, simpleTest17 , simpleTest18, simpleTest19, simpleTest20 , simpleTest21, simpleTest22, simpleTest23- , simpleTest24, simpleTest25, simpleTest26]-+ , simpleTest24, simpleTest25, simpleTest26+ , simpleTest27, simpleTest28, simpleTest29+ , simpleTest30, simpleTest31, simpleTest32+ , simpleTest33, simpleTest34] -- list of simple tests simpleTest1 :: GoodTestCase-simpleTest1 = ("3+4", 7.0)+simpleTest1 = ("3+4", DblResult 7.0) simpleTest2 :: GoodTestCase-simpleTest2 = ("3*3", 9.0)+simpleTest2 = ("3*3", DblResult 9.0) simpleTest3 :: GoodTestCase-simpleTest3 = ("(3*3)+(3*4)", 21.0)+simpleTest3 = ("(3*3)+(3*4)", DblResult 21.0) simpleTest4 :: GoodTestCase-simpleTest4 = ("(3.0*3.0)+(3.0*4.0)", 21.0)+simpleTest4 = ("(3.0*3.0)+(3.0*4.0)", DblResult 21.0) simpleTest5 :: GoodTestCase-simpleTest5 = ("(3+3)*(9+8)", 102.0)+simpleTest5 = ("(3+3)*(9+8)", DblResult 102.0) simpleTest6 :: GoodTestCase-simpleTest6 = ("(3.0+3.0)*(9.0+8.0)", 102.0)+simpleTest6 = ("(3.0+3.0)*(9.0+8.0)", DblResult 102.0) simpleTest7 :: GoodTestCase-simpleTest7 = ("(((((((3.0+3.0)*(9.0+8.0)))))))", 102.0)+simpleTest7 = ("(((((((3.0+3.0)*(9.0+8.0)))))))", DblResult 102.0) simpleTest8 :: GoodTestCase-simpleTest8 = ("(((((((3.0+3.0)))))*(((((9.0+8.0)))))))", 102.0)+simpleTest8 = ("(((((((3.0+3.0)))))*(((((9.0+8.0)))))))"+ , DblResult 102.0) simpleTest9 :: GoodTestCase-simpleTest9 = ("3+3*99.0", 300.0)+simpleTest9 = ("3+3*99.0", DblResult 300.0) simpleTest10 :: GoodTestCase-simpleTest10 = ("3+3*8+4*3*2+1*4*3+5", 68.0)+simpleTest10 = ("3+3*8+4*3*2+1*4*3+5", DblResult 68.0) simpleTest11 :: GoodTestCase-simpleTest11 = ("(3+3)*(8+4)*3*(2+1)*4*(3+5)", 20736.0)+simpleTest11 = ("(3+3)*(8+4)*3*(2+1)*4*(3+5)", DblResult 20736.0) simpleTest12 :: GoodTestCase-simpleTest12 = (" 3 +3* 99.0", 300.0)+simpleTest12 = (" 3 +3* 99.0", DblResult 300.0) simpleTest13 :: GoodTestCase-simpleTest13 = (" 3 + 3*8+4 *3 *2+1* 4*3+5 ", 68.0)+simpleTest13 = (" 3 + 3*8+4 *3 *2+1* 4*3+5 ", DblResult 68.0) simpleTest14 :: GoodTestCase-simpleTest14 = ("(3+3) *(8+4)*3 * (2+1 )*4*( 3+5)", 20736.0)+simpleTest14 = ("(3+3) *(8+4)*3 * (2+1 )*4*( 3+5)"+ , DblResult 20736.0) simpleTest15 :: GoodTestCase-simpleTest15 = ("3*-4", -12.0)+simpleTest15 = ("3*-4", DblResult (-12.0)) simpleTest16 :: GoodTestCase-simpleTest16 = ("3* -4", -12.0)+simpleTest16 = ("3* -4", DblResult (-12.0)) simpleTest17 :: GoodTestCase-simpleTest17 = ("-3*4", -12.0)+simpleTest17 = ("-3*4", DblResult (-12.0)) simpleTest18 :: GoodTestCase-simpleTest18 = ("-3*-4", 12.0)+simpleTest18 = ("-3*-4", DblResult 12.0) simpleTest19 :: GoodTestCase-simpleTest19 = ("3*(-4)", -12.0)+simpleTest19 = ("3*(-4)", DblResult (-12.0)) simpleTest20 :: GoodTestCase-simpleTest20 = ("(-3)*(-4)", 12.0)+simpleTest20 = ("(-3)*(-4)", DblResult 12.0) simpleTest21 :: GoodTestCase-simpleTest21 = ("3/-4", -0.75)+simpleTest21 = ("3/-4", DblResult (-0.75)) simpleTest22 :: GoodTestCase-simpleTest22 = ("3^-4", 1/81)+simpleTest22 = ("3^-4", DblResult (1/81)) simpleTest23 :: GoodTestCase-simpleTest23 = ("-3*-4^-4", -3/256)+simpleTest23 = ("-3*-4^-4", DblResult (-3/256)) simpleTest24 :: GoodTestCase-simpleTest24 = ("-3+-4", -7)+simpleTest24 = ("-3+-4", DblResult (-7)) simpleTest25 :: GoodTestCase-simpleTest25 = ("-1/-1/-1/-1", 1.0)+simpleTest25 = ("-1/-1/-1/-1", DblResult 1.0) simpleTest26 :: GoodTestCase-simpleTest26 = ("-(-(-1))", -1)+simpleTest26 = ("-(-(-1))", DblResult (-1)) +simpleTest27 :: GoodTestCase+simpleTest27 = ("3/-4; -1/-1/-1/-1; -3*-4^-4", DblResult (-3/256)) +simpleTest28 :: GoodTestCase+simpleTest28 = ("3*3; 4+5; 34 * 34 ; 3^-4", DblResult (1/81))++simpleTest29 :: GoodTestCase+simpleTest29 = ("3*3;4*4;-3*-4^-4", DblResult (-3/256))++simpleTest30 :: GoodTestCase+simpleTest30 = (" 3; 3+4; 4*2 ; -3+-4", DblResult (-7))++simpleTest31 :: GoodTestCase+simpleTest31 = ("3*1;3;3;3;3 ;-1/-1/-1/-1", DblResult 1.0)++simpleTest32 :: GoodTestCase+simpleTest32 = ("4^4;-(-(-1))", DblResult (-1))++simpleTest33 :: GoodTestCase+simpleTest33 = ("-3", DblResult (-3))++simpleTest34 :: GoodTestCase+simpleTest34 = (" - 9 ", DblResult (-9))++ -- a few tests involving variables variableTests :: [GoodTestCase] variableTests = [ variableTest1, variableTest2, variableTest3 , variableTest4, variableTest5, variableTest6 , variableTest7, variableTest8, variableTest9- , variableTest10, variableTest11, variableTest12 ] + , variableTest10, variableTest11, variableTest12 + , variableTest13, variableTest14, variableTest15+ , variableTest16, variableTest17, variableTest18+ , variableTest19, variableTest20 ] --- list of failing tests+-- list of variable tests variableTest1 :: GoodTestCase-variableTest1 = ("b = 4", 4)+variableTest1 = ("b = 4", DblResult 4) variableTest2 :: GoodTestCase-variableTest2 = ("3 * b ", 12)+variableTest2 = ("3 * b ", DblResult 12) variableTest3 :: GoodTestCase-variableTest3 = ("(b*b)", 16)+variableTest3 = ("(b*b)", DblResult 16) variableTest4 :: GoodTestCase-variableTest4 = ("a = 12", 12)+variableTest4 = ("a = 12", DblResult 12) variableTest5 :: GoodTestCase-variableTest5 = ("a * b", 48)+variableTest5 = ("a * b", DblResult 48) variableTest6 :: GoodTestCase-variableTest6 = ("a - b * b", (-4))+variableTest6 = ("a - b * b", DblResult (-4)) variableTest7 :: GoodTestCase-variableTest7 = ("3 * b - a", 0)+variableTest7 = ("3 * b - a", DblResult 0) variableTest8 :: GoodTestCase-variableTest8 = ("kjhdskfsd123hjksdf = a * b", 48)+variableTest8 = ("kjhdskfsd123hjksdf = a * b", DblResult 48) variableTest9 :: GoodTestCase-variableTest9 = ("(a*b) - kjhdskfsd123hjksdf", 0)+variableTest9 = ("(a*b) - kjhdskfsd123hjksdf", DblResult 0) variableTest10 :: GoodTestCase-variableTest10 = ("c = 2", 2) +variableTest10 = ("c = 2", DblResult 2) variableTest11 :: GoodTestCase-variableTest11 = ("a-b-c + ( a + b + c ) + (a*a)", 168)+variableTest11 = ("a-b-c + ( a + b + c ) + (a*a)", DblResult 168) variableTest12 :: GoodTestCase-variableTest12 = ("b^a - c", 16777214)+variableTest12 = ("b^a - c", DblResult 16777214) +variableTest13 :: GoodTestCase+variableTest13 = ("a=3; b=4; c=a/b; c*b", DblResult 3) +variableTest14 :: GoodTestCase+variableTest14 = ("x= 10; y = log(x); exp(y)", DblResult 10) +variableTest15 :: GoodTestCase+variableTest15 = ("x=5; x=6; x=7; 3*x; y = x*3", DblResult 21)++variableTest16 :: GoodTestCase+variableTest16 = ("x = 2; y = 10^x; log10(y)", DblResult 2)++variableTest17 :: GoodTestCase+variableTest17 = ("c = 2; d = c; d", DblResult 2) ++variableTest18 :: GoodTestCase+variableTest18 = (" x = pi; y = cos(x); acos(y)", DblResult pi)++variableTest19 :: GoodTestCase+variableTest19 = ("a = 5; -a", DblResult (-5.0)) ++variableTest20 :: GoodTestCase+variableTest20 = ("b= 15; 3*( - b)", DblResult (-45))++++-- a few tests involving builtin functions, mostly to check+-- for proper parsing rather than proper math+functionTests :: [GoodTestCase]+functionTests = [ functionTest1, functionTest2, functionTest3+ , functionTest4, functionTest5, functionTest6+ , functionTest7, functionTest8, functionTest9+ , functionTest10, functionTest11]++-- list of variable tests+functionTest1 :: GoodTestCase+functionTest1 = ("sqrt 2", DblResult 1.4142135623730951)++functionTest2 :: GoodTestCase+functionTest2 = ("sqrt 2 * 2", DblResult 2.8284271247461903)++functionTest3 :: GoodTestCase+functionTest3 = ("sqrt 2*2", DblResult 2.8284271247461903)++functionTest4 :: GoodTestCase+functionTest4 = ("sqrt(2*2)", DblResult 2)++functionTest5 :: GoodTestCase+functionTest5 = ("cos 0.5", DblResult 0.8775825618903728)++functionTest6 :: GoodTestCase+functionTest6 = ("cos 0.5 +0.5", DblResult 1.3775825618903728)++functionTest7 :: GoodTestCase+functionTest7 = ("cos 0.5 - 0.5", DblResult 0.37758256189037276)++functionTest8 :: GoodTestCase+functionTest8 = ("cos(0.5 -0.5)", DblResult 1.0)++functionTest9 :: GoodTestCase+functionTest9 = ("cos -0.5", DblResult 0.8775825618903728)++functionTest10 :: GoodTestCase+functionTest10 = ("cos(-0.5)", DblResult 0.8775825618903728) ++functionTest11 :: GoodTestCase+functionTest11 = ("cos 0.5 - cos -0.5", DblResult 0)++ -- a few tests that are failing failingTests :: [FailingTestCase] failingTests = [ failingTest1, failingTest2, failingTest3 , failingTest4, failingTest5, failingTest6 , failingTest7, failingTest8, failingTest9- , failingTest10, failingTest11, failingTest12 ]+ , failingTest10, failingTest11, failingTest12+ , failingTest13, failingTest14, failingTest15 ] -- list of failing tests failingTest1 :: FailingTestCase@@ -351,3 +475,121 @@ failingTest12 :: FailingTestCase failingTest12 = ("b") +failingTest13 :: FailingTestCase+failingTest13 = ("3+3;;3+4")++failingTest14 :: FailingTestCase+failingTest14 = ("(3+3;4+4)")++failingTest15 :: FailingTestCase+failingTest15 = ("3+3, 3+3")+++-- a few tests for testing proper parsing of user defined+-- functions+userFunctionTests :: [GoodTestCase]+userFunctionTests = [ userFunctionTest1, userFunctionTest2+ , userFunctionTest3, userFunctionTest4 + , userFunctionTest5, userFunctionTest6+ , userFunctionTest7, userFunctionTest8+ , userFunctionTest9, userFunctionTest10+ , userFunctionTest11, userFunctionTest12 + , userFunctionTest13, userFunctionTest14+ , userFunctionTest15, userFunctionTest16+ , userFunctionTest17, userFunctionTest18+ , userFunctionTest19, userFunctionTest20+ , userFunctionTest21, userFunctionTest22+ , userFunctionTest23, userFunctionTest24+ , userFunctionTest25, userFunctionTest26+ , userFunctionTest27, userFunctionTest28] + ++-- list of user defined function tests+userFunctionTest1 :: GoodTestCase+userFunctionTest1 = ("function f(x , y )= x * y", StrResult "<function>")++userFunctionTest2 :: GoodTestCase+userFunctionTest2 = ("f ( 5, 6)", DblResult 30)++userFunctionTest3 :: GoodTestCase+userFunctionTest3 = ("x=2.0; y = 3.0", DblResult 3.0)++userFunctionTest4 :: GoodTestCase+userFunctionTest4 = ("x * f( 5, 6)+ f(5,6) + y", DblResult 93)++userFunctionTest5 :: GoodTestCase+userFunctionTest5 = ("f(5,6) ^ 2", DblResult 900)++userFunctionTest6 :: GoodTestCase+userFunctionTest6 = ("function g(a, b, c) = a * b + c"+ , StrResult "<function>")++userFunctionTest7 :: GoodTestCase+userFunctionTest7 = ("a = 100; b = 77; c = 300; g( 1, 2, 3)"+ , DblResult 5)++userFunctionTest8 :: GoodTestCase+userFunctionTest8 = ("a * b + c", DblResult 8000)++userFunctionTest9 :: GoodTestCase+userFunctionTest9 = ("f( 5, 6) * g( 1, 2, 3)", DblResult 150)++userFunctionTest10 :: GoodTestCase+userFunctionTest10 = ("sqrt( f( 5, 6) )", DblResult 5.477225575051661)++userFunctionTest11 :: GoodTestCase+userFunctionTest11 = ("f( 5, 6) + g( 1, 2, 3) + f( 1, 2) - 37", DblResult 0)++userFunctionTest12 :: GoodTestCase+userFunctionTest12 = ("function d x y = x * y", StrResult "<function>")++userFunctionTest13 :: GoodTestCase+userFunctionTest13 = ("d 5 6", DblResult 30)++userFunctionTest14 :: GoodTestCase+userFunctionTest14 = ("x=2.0; y = 3.0", DblResult 3.0)++userFunctionTest15 :: GoodTestCase+userFunctionTest15 = ("x * d 5 6 + f(5,6) + y", DblResult 93)++userFunctionTest16 :: GoodTestCase+userFunctionTest16 = ("d 5 6 ^ 2", DblResult 900)++userFunctionTest17 :: GoodTestCase+userFunctionTest17 = ("function foo a b c = a * b + c"+ , StrResult "<function>")++userFunctionTest18 :: GoodTestCase+userFunctionTest18 = ("a = 100; b = 77; c = 300; foo 1 2 3"+ , DblResult 5)++userFunctionTest19 :: GoodTestCase+userFunctionTest19 = ("a * b + c", DblResult 8000)++userFunctionTest20 :: GoodTestCase+userFunctionTest20 = ("d 5 6 * g( 1, 2, 3)", DblResult 150)++userFunctionTest21 :: GoodTestCase+userFunctionTest21 = ("sqrt( d 5 6 )", DblResult 5.477225575051661)++userFunctionTest22 :: GoodTestCase+userFunctionTest22 = ("f( 5, 6) + foo 1 2 3 + (d 1 2) - 37", DblResult 0)++userFunctionTest23 :: GoodTestCase+userFunctionTest23 = ("a = 10; b = 5", DblResult 5)++userFunctionTest24 :: GoodTestCase+userFunctionTest24 = ("function bar a b c = a * b + c"+ , StrResult "<function>")++userFunctionTest25 :: GoodTestCase+userFunctionTest25 = ("bar a a b", DblResult 105)++userFunctionTest26 :: GoodTestCase+userFunctionTest26 = ("bar(a,b,b)", DblResult 55)++userFunctionTest27 :: GoodTestCase+userFunctionTest27 = ("bar(a,1,2) * bar(b,4,a)", DblResult 360)++userFunctionTest28 :: GoodTestCase+userFunctionTest28 = ("sqrt( bar 1 1 1 )", DblResult 1.4142135623730951)
test/ConverterTest.hs view
@@ -106,7 +106,7 @@ let expected = snd x case runParser main_parser state "" tok of Left er -> tell [TestResult False tok (show expected) (show er)]- Right (result, newState) -> examine_result expected result tok+ Right (UnitResult result, newState) -> examine_result expected result tok where -- NOTE: when we compare target and actual result we@@ -135,15 +135,18 @@ failing_test_driver state (x:xs) = do case runParser main_parser state "" x of- Left er -> tell [TestResult True x "Failure" "Failure"]- >> failing_test_driver state xs- Right (_,status) -> case have_special_error status of- Just err -> tell [TestResult True x - "Failure" "Failure"]- >> failing_test_driver state xs- Nothing -> tell [TestResult False x - "Failure" "Success"]+ Left er -> + tell [TestResult True x "Failure" "Failure"]+ >> failing_test_driver state xs++ Right (ErrResult _,_) -> + tell [TestResult True x "Failure" "Failure"]+ >> failing_test_driver state xs++ _ -> + tell [TestResult False x "Failure" "Success"] + -- | our test results consist of a bool indicating success -- or failure, the test token as well as the expected and -- received result@@ -189,64 +192,64 @@ -- list of simple tests simpleTest1 :: GoodTestCase-simpleTest1 = ("\\c 0F C", (-17.77777777777778,"C") )+simpleTest1 = ("conv 0F C", (-17.77777777777778,"C") ) simpleTest2 :: GoodTestCase-simpleTest2 = ("\\c 0C F", (32,"F"))+simpleTest2 = ("conv 0C F", (32,"F")) simpleTest3 :: GoodTestCase-simpleTest3 = ("\\c -12C K", (261.15,"K"))+simpleTest3 = ("conv -12C K", (261.15,"K")) simpleTest4 :: GoodTestCase-simpleTest4 = ("\\c -12K C", (-285.15,"C"))+simpleTest4 = ("conv -12K C", (-285.15,"C")) simpleTest5 :: GoodTestCase-simpleTest5 = ("\\c 23F K", (268.15,"K"))+simpleTest5 = ("conv 23F K", (268.15,"K")) simpleTest6 :: GoodTestCase-simpleTest6 = ("\\c 45K F", (-378.67,"F"))+simpleTest6 = ("conv 45K F", (-378.67,"F")) simpleTest7 :: GoodTestCase-simpleTest7 = ("\\c 1ft m", (0.3048,"m"))+simpleTest7 = ("conv 1ft m", (0.3048,"m")) simpleTest8 :: GoodTestCase-simpleTest8 = ("\\c 4m ft", (13.123359580052492,"ft"))+simpleTest8 = ("conv 4m ft", (13.123359580052492,"ft")) simpleTest9 :: GoodTestCase-simpleTest9 = ("\\c 1km mi", (0.621371192237334,"mi"))+simpleTest9 = ("conv 1km mi", (0.621371192237334,"mi")) simpleTest10 :: GoodTestCase-simpleTest10 = ("\\c 5km nmi", (2.6997840172786174, "nmi"))+simpleTest10 = ("conv 5km nmi", (2.6997840172786174, "nmi")) simpleTest11 :: GoodTestCase-simpleTest11 = ("\\c 23.1m ft", (75.78740157480314, "ft"))+simpleTest11 = ("conv 23.1m ft", (75.78740157480314, "ft")) simpleTest12 :: GoodTestCase-simpleTest12 = ("\\c 0.45mi km", (0.7242048, "km"))+simpleTest12 = ("conv 0.45mi km", (0.7242048, "km")) simpleTest13 :: GoodTestCase-simpleTest13 = ("\\c 43.2mi m", (69523.66080000001, "m"))+simpleTest13 = ("conv 43.2mi m", (69523.66080000001, "m")) simpleTest14 :: GoodTestCase-simpleTest14 = ("\\c 4.2m in", (165.35433070866142, "in"))+simpleTest14 = ("conv 4.2m in", (165.35433070866142, "in")) simpleTest15 :: GoodTestCase-simpleTest15 = ("\\c 34.2m mi", (2.125089477451682e-2, "mi"))+simpleTest15 = ("conv 34.2m mi", (2.125089477451682e-2, "mi")) simpleTest16 :: GoodTestCase-simpleTest16 = ("\\c 123.3m nmi", (6.657667386609072e-2, "nmi"))+simpleTest16 = ("conv 123.3m nmi", (6.657667386609072e-2, "nmi")) simpleTest17 :: GoodTestCase-simpleTest17 = ("\\c 1.23m yd", (1.3451443569553807, "yd"))+simpleTest17 = ("conv 1.23m yd", (1.3451443569553807, "yd")) simpleTest18 :: GoodTestCase-simpleTest18 = ("\\c 0.23nmi km", (0.42596, "km"))+simpleTest18 = ("conv 0.23nmi km", (0.42596, "km")) simpleTest19 :: GoodTestCase-simpleTest19 = ("\\c 1.2nmi m", (2222.4, "m"))+simpleTest19 = ("conv 1.2nmi m", (2222.4, "m")) simpleTest20 :: GoodTestCase-simpleTest20 = ("\\c 1.23yd m", (1.124712, "m"))+simpleTest20 = ("conv 1.23yd m", (1.124712, "m")) -- a few tests that are failing @@ -258,40 +261,40 @@ -- list of failing tests failingTest1 :: FailingTestCase-failingTest1 = ("\\c 1F F")+failingTest1 = ("conv 1F F") failingTest2 :: FailingTestCase-failingTest2 = ("\\c 1C D")+failingTest2 = ("conv 1C D") failingTest3 :: FailingTestCase-failingTest3 = ("\\c C F")+failingTest3 = ("conv C F") failingTest4 :: FailingTestCase-failingTest4 = ("\\c 1F mi")+failingTest4 = ("conv 1F mi") failingTest5 :: FailingTestCase-failingTest5 = ("\\c 1mi mi")+failingTest5 = ("conv 1mi mi") failingTest6 :: FailingTestCase-failingTest6 = ("\\c 1mi 1K")+failingTest6 = ("conv 1mi 1K") failingTest7 :: FailingTestCase-failingTest7 = ("\\c 1nmi yd")+failingTest7 = ("conv 1nmi yd") failingTest8 :: FailingTestCase-failingTest8 = ("\\c 1yd yd")+failingTest8 = ("conv 1yd yd") failingTest9 :: FailingTestCase-failingTest9 = ("\\c 1K K")+failingTest9 = ("conv 1K K") failingTest10 :: FailingTestCase-failingTest10 = ("\\c 1F F")+failingTest10 = ("conv 1F F") failingTest11 :: FailingTestCase failingTest11 = ("c 1C yd") failingTest12 :: FailingTestCase-failingTest12 = ("\\c c c 1")+failingTest12 = ("conv c c 1") -- | list of unit conversion pairs for inversion test@@ -343,11 +346,11 @@ prop_invert u1 u2 i = case runParser main_parser defaultCalcState "" $ test_to i of Left _ -> False- Right ((x,_),_) -> + Right (UnitResult (x,_),_) -> case runParser main_parser defaultCalcState "" $ test_from x of Left _ -> False- Right ((y,_),_) -> is_equal (fromInteger i) y+ Right (UnitResult (y,_),_) -> is_equal (fromInteger i) y where- test_to z = "\\c " ++ (show z) ++ u1 ++ " " ++ u2- test_from z = "\\c " ++ (show z) ++ u2 ++ " " ++ u1+ test_to z = "conv " ++ (show z) ++ u1 ++ " " ++ u2+ test_from z = "conv " ++ (show z) ++ u2 ++ " " ++ u1