Arith.hs

------------------------------------------------------------------
-- |
-- Module      :  Language.JSMW.Arith
-- Copyright   :  (c) Dmitry Golubovsky, 2009
-- License     :  BSD-style
-- 
-- Maintainer  :  golubovsky@gmail.com
-- Stability   :  experimental
-- Portability :  portable
-- 
--
--
-- Encoding of Javascript arithmetic and mathematic operations.
------------------------------------------------------------------

module Language.JSMW.Arith (
 -- * Arithmetic operators
 -- $arith
 -- $comp
  lt, le, gt, ge, eq, ne, (===), (=/=),
 -- * Logical operators
 -- $logic
  land, lor
 -- * Tests for being a number
 ,isNAN
 -- * Primitive conversions
 ,toString
 ,parseInt
 ,parseFloat) where

import BrownPLT.JavaScript
import Data.DOM
import Language.JSMW.Monad

-- $arith Instance of the 'Num' class can be defined for Javascript expressions
-- provided that their type annotation also belongs to the 'Num' class. Therefore
-- it is possible to overload the '+', '-', etc. operators so that using them
-- in JSMW code would result in correct Javascript code:
--
-- @'number' 5 - ('number' 1 - 'number' 4)@ 
--
-- results in
--
-- @(5.0 - (1.0 - 4.0))@.
--
-- Also, addition is defined for String expressions, so this is possible:
--
-- @'alert' (g + 'string' \" Greater than 3\")@
--
-- Unlike the methods of the 'Num' class, comparison operators (members of the 'Ord'
-- class) cannot be overloaded in suitable manner. For Javascript expressions,
-- the following infix operators are provided, with the same fixity as the corresponding
-- Haskell operators.

arithBin op x y = let et = exprType x in ParenExpr et (InfixExpr et op x y)

arithPfx op x = let et = exprType x in ParenExpr et (PrefixExpr et op x)

arithFun fn x = let et = exprType x in ParenExpr et (CallExpr et (VarRef et $ Id et fn) [x])

boolBin op x y = (arithBin op x y) /\ (undefined :: Bool)

instance Num (Expression Double) where
  (+) = arithBin OpAdd
  (-) = arithBin OpSub
  (*) = arithBin OpMul
  negate = arithPfx PrefixMinus
  abs = arithFun "Math.abs"
  signum = arithFun "(function(x){return (x<0)?(-1):(x>0)?1:0})"
  fromInteger n = NumLit (undefined :: a) (fromIntegral n)

instance Num (Expression String) where
  (+) = arithBin OpAdd
  (*) x y = error "(*) undefined on strings"
  abs x = error "abs undefined on strings"
  signum x = error "signum undefined on strings"
  fromInteger = string . show

instance Fractional (Expression Double) where
  (/) = arithBin OpDiv
  fromRational n = NumLit (undefined :: a) (fromRational n)

lt :: Expression a -> Expression a -> Expression Bool
le :: Expression a -> Expression a -> Expression Bool
gt :: Expression a -> Expression a -> Expression Bool
ge :: Expression a -> Expression a -> Expression Bool
eq :: Expression a -> Expression a -> Expression Bool
ne :: Expression a -> Expression a -> Expression Bool
(===) :: Expression a -> Expression a -> Expression Bool
(=/=) :: Expression a -> Expression a -> Expression Bool

lt = boolBin OpLT
le = boolBin OpLEq
gt = boolBin OpGT
ge = boolBin OpGEq
eq = boolBin OpEq
ne = boolBin OpNEq

(===) = boolBin OpStrictEq
(=/=) = boolBin OpStrictNEq

infix 4 `lt`, `le`, `gt`, `ge`, `eq`, `ne`, ===, =/=

-- $logic Similarly, logical operators for Javascript expressions are provided.

land :: Expression Bool -> Expression Bool -> Expression Bool
lor  :: Expression Bool -> Expression Bool -> Expression Bool

land = arithBin OpLAnd
lor = arithBin OpLOr

infixr 3 `land`
infixr 2 `lor`

-- | Test if a given value is a number.

isNAN :: Expression Double -> JSMW e (Expression Bool)

isNAN n = do
  let dt = undefined :: Bool
  nx <- once =<< return n
  once =<< return (CallExpr dt (VarRef dt (Id dt "isNaN")) [nx /\ dt])

-- | Obtain a string representation of an arbitrary Javascript expression.

toString :: Expression a -> JSMW e (Expression String)

toString x = do
  vx <- once =<< return x
  once =<< return (CallExpr "" (DotRef "" (vx /\ "") (Id "" "toString")) [])

-- | Parse an integer.

parseInt :: Expression String -> Expression Double -> JSMW e (Expression Double)

parseInt s r = do
  let dt = undefined :: Double
  str <- once =<< return s
  rdx <- once =<< return r
  once =<< return (CallExpr dt (VarRef dt (Id dt "parseInt")) [str /\ dt, rdx /\ dt])

-- | Parse a floating point number.

parseFloat :: Expression String -> JSMW e (Expression Double)

parseFloat s = do
  let dt = undefined :: Double
  str <- once =<< return s
  once =<< return (CallExpr dt (VarRef dt (Id dt "parseFloat")) [str /\ dt])