hascal-3.0: Hascal.hs

-- |Hascal is a simple, minimalistic, tiny calculator library and program.
--
-- * Hascal only understands single-character operators.
-- * Hascal only understands infix operators.
-- * Hascal does not understand parantheses.
-- * @_@ is hard-coded as single prefix for negating numbers.
-- * By default, Hascal understands the operators @+@, @-@, @*@, @/@, @^@, and
-- @?@ (logarithm).
-- * By default, Hascal understands the constants @pi@, @e@, and @i@.
-- * Using Hascal as a library, you can add new operators and new constants
-- using a configuration data type.
--
-- The hascal executable program is easy to use. In a shell, type:
-- 
-- >>> hascal 1+2-3*4/5^6?7
-- -1.7263530417152033
--
-- Given a configuration, the 'hascal' function similarly evaluates an
-- expression of type 'String'. In a Haskell interpreter like GHCI, type:
--
-- >>> hascal def "1+2-3*4/5^6?7"
-- Right (0.2736469582847967 :+ 0.0)
--
-- >>> hascal def "1++2"
-- Left "Error at \"\"."

--------------------------------------------------------------------------------

module Hascal
  ( Config(..)
  , Data.Default.Default(..)
  , hascal
  , showHascal
  , showNumber
  ) where


--------------------------------------------------------------------------------

import Data.Complex
import Data.Default
import Data.List
import Data.List.Split


--------------------------------------------------------------------------------
-- | The result of an evaluation of a string is either a String containing an
-- error message or a complex number.

type Result   t = Either String (Complex t)


--------------------------------------------------------------------------------
-- | An operator is a pair of
-- * a 'Char' containing its identifier; and
-- * a binary numeral function.

type Operator t = (Char, Complex t -> Complex t -> Complex t)


--------------------------------------------------------------------------------

-- | A constant is a pair of
-- * a 'String' containing its identifier; and
-- * a 'Complex' number containing its value.

type Constant t = (String, Complex t)


--------------------------------------------------------------------------------

-- | A configuration. 'def' is the default configuration.

data Config t = Config
    { operators :: [Operator t] -- ^ A list of operators. The order in this list also determines the order of evaluation.
    , constants :: [Constant t] -- ^ A list of constants.
    }


instance (Read t, RealFloat t) => Default (Config t) where
    def = Config
        [ ('+', (+))
        , ('-', (-))
        , ('*', (*))
        , ('/', (/))
        , ('^', (**))
        , ('?', flip logBase)
        ]
        [ ("pi", pi   :+0)
        , ("e" , exp 1:+0)
        , ("i" , 0    :+1)
        ]


--------------------------------------------------------------------------------

-- | Given a configuration and a 'String'-expression, returns a 'String'
-- containing the error message or the resulting complex number.

showHascal :: (Show t, Read t, RealFloat t)
           => Config t
           -> String
           -> String
showHascal conf s = either id showNumber (hascal conf s)


--------------------------------------------------------------------------------

-- | Given a configuration and a 'String'-expression, returns 'Either' a
-- 'String' containing an error message; or a 'Complex' number.

hascal :: (Read t, RealFloat t) => Config t -> String -> Result t
hascal conf = calc (operators conf) (constants conf)


--------------------------------------------------------------------------------

-- Given a list of operators, a list of constants, and a 'String'-expression,
-- returns 'Either' a 'String' containing an error message; or a 'Complex'
-- number.

calc :: (Read t, RealFloat t)
     => [Operator t]
     -> [Constant t]
     -> String
     -> Result t
calc []             cs s = readNumber cs s
calc ((c, f) : ops) cs s =
    foldl1 apply (map (calc ops cs) (splitOn [c] s))
  where
    apply x y = case (x, y) of
        (Right rx, Right ry) -> Right (f rx ry)
        (Left  rx, _       ) -> Left rx
        (_       , Left  ry) -> Left ry


--------------------------------------------------------------------------------

-- 'Either' returns a 'String' containing an error message or returns a
-- complex number represented in the given 'String' as a 'Constant' or as a
-- number. It’s a wrapper around 'findOrRead', adding the underscore prefix
-- operator for negation.

readNumber :: (Read t, RealFloat t)
           => [Constant t]
           -> String
           -> Result t
readNumber cs ('_':s) = fmap negate (findOrRead cs s)
readNumber cs      s  = findOrRead cs s


--------------------------------------------------------------------------------

-- 'Either' returns a 'String' containing an error message or returns a
-- complex number represented in the given 'String' as a 'Constant' or as a
-- number.

findOrRead :: (Read t, Floating t)
           => [Constant t]
           -> String
           -> Result t
findOrRead cs s = maybe (maybeRead s) (Right . snd) (find ((==s) . fst) cs)
  where
    maybeRead s
      | any (null . snd) (reads s :: [(Double,String)]) -- TODO: solve this better
      = Right (read s:+0)
      | otherwise
      = Left ("Error at \"" ++ s ++ "\".")


--------------------------------------------------------------------------------

-- | Show a 'Complex' number a little bit more human-readable by matching both
-- the real and the imaginery part against zero and one.

showNumber :: (Show t, RealFloat t)
           => Complex t
           -> String
showNumber (r:+0) = show r
showNumber (r:+1) = show r ++ " + i"
showNumber (0:+i) = show i ++ " * i"
showNumber (r:+i) = show r ++ " + " ++ show i ++ " * i"