-- |Hascal is both a simple but extendable calculator library for Haskell -- and a command-line program using it. -- -- Also, its source code is a nice example for a minimalistic Haskell project. -- -- Some examples for the usage of the command-line program: -- -- >>> hascal 1+2 -- 3.0 -- -- >>> hascal 1+2*3-4/198^2 -- 6.99989796959493929190898887868584838281807978777676 -- -- Also, preceding exclamation marks mean that the following number is -- imaginary, that is, you have to multiply it with i. E.g.: -- -- >>> hascal _1 ^ 0.5 -- !1.0 -- -- And as you can see, negative numbers are preceded by a underscore. -- -- Although hascal itself doesn't understand brackets, you can use your shell -- to get that functionality, like this (using bash): -- -- >>> hascal e ^ $(hascal i*pi) -- -1.0 -- -- Speaking of shells, you should consider that your shell might extend an -- asterisk (*) to the files at the current directory, like here: -- -- >>> echo * -- _darcs dist hascal.cabal Hascal.hs LICENSE Main.hs README.org Setup.hs -- -- That's why this might not work: -- -- >>> hascal 1 * 2 -- Error. :( -- -- But you could do this instead: -- -- >>> hascal 1*2 -- 2 -- -- Yeah, that's it. Hascal is really minimalistic. -- And I'm not planning to extend it much. module Hascal ( -- * Operators operators, -- * Evaluators eval, hascal, -- * Pretty Printers prettyPrint ) where import Control.Arrow (second) import Data.Complex (Complex(..)) import Data.Functor ((<$>)) import Data.List (find) -- |'operators' is the default list of operators. -- -- An operator consists of one character and a function with of type -- @Number -> Number -> Number@. -- -- 'operators' includes: -- -- * addition, represented by @\'+\'@, -- -- * subtraction, represented by @\'-\'@, -- -- * multiplication, represented by @\'*\'@, -- -- * division, represented by @\'\/\'@, -- -- * exponentiation, represented by @\'^\'@, and -- -- * logarithming (with flipped arguments, see below), represented by @\'?\'@, -- -- such that these laws are held: -- -- > (a - b == c) == (a == b + c) -- > (a / b == c) == (a == b * c) -- > (a ? b == c) == (a == b ^ c) operators :: RealFloat t => [(Char, Complex t -> Complex t -> Complex t)] operators = [ ('+', (+)) , ('-', (-)) , ('/', (/)) , ('*', (*)) , ('^', (**)) , ('?', flip logBase) ] calc :: (Read t, RealFloat t) => [(Char, Complex t -> Complex t -> Complex t)] -> String -> Maybe (Complex t) calc [] a = readNumber a calc l@((c,f):s) a | z /= "" = case (calc l y,calc l z) of (Just n,Just m) -> Just (f m n) _ -> Nothing | otherwise = calc s a where (y,z) = second (drop 1) $ break (==c) a -- |'eval' gets a list of operators and a string containing a mathematical -- expression/term which only uses those operators listed in the first -- argument, and returns the result of that term. eval :: (Read t, RealFloat t) => [(Char, Complex t -> Complex t -> Complex t)] -- ^ list of operators -> String -- ^ string containing term -> Maybe (Complex t) -- ^ just result, or nothing eval = (. reverse) . calc readNumber :: (Read t, RealFloat t) => String -> Maybe (Complex t) readNumber ('!':s) = ((0:+1)*) <$> findOrRead s readNumber ('_':s) = negate <$> findOrRead s readNumber s = findOrRead s findOrRead :: (Read t, Floating t) => String -> Maybe (Complex t) findOrRead a = let s = reverse a in maybe (maybeRead s) (Just . snd) $ find ((==s) . fst) [("pi",pi :+0) ,("e" ,exp 1:+0) ,("i" ,0 :+1) ] maybeRead :: (Read t, Num t) => String -> Maybe (Complex t) maybeRead s | any (null . snd) (reads s :: [(Double,String)]) = Just (read s:+0) | otherwise = Nothing -- |'hascal' is the default evaluator: -- -- @ hascal = 'eval' 'operators' @ hascal :: (Read t, RealFloat t) => String -> Maybe (Complex t) hascal = eval operators -- |'prettyPrint' prints a number nicely. -- E.g., it doesn't show the real or imaginary part of the number if it's @0@. prettyPrint :: (Show t, RealFloat t) => Complex t -> String prettyPrint (r:+0) = show r prettyPrint (0:+i) = '!' : show i prettyPrint (r:+i) = show r ++ " + !" ++ show i