------------------------------------------------------------------
-- |
-- Module      :  Language.JSMW.Type
-- Copyright   :  (c) Dmitry Golubovsky, 2009
-- License     :  BSD-style
-- 
-- Maintainer  :  golubovsky@gmail.com
-- Stability   :  experimental
-- Portability :  portable
-- 
--
--
-- Type operations wrt WebBits Javascript expressions.
------------------------------------------------------------------

{-# LANGUAGE TypeSynonymInstances #-}

module Language.JSMW.Type (
  -- * Functions to manipulate Javascript expression types
  castExpr
 ,exprType
 ,stmtType
 ,(/\)
 -- * Property accessors
 ,setjsProperty
 ,getjsProperty
 ,getjsIndex
 ,dotRef
  -- * Display WebIDL types for proper IDL generation from Haskell
 ,IDLTypeable (..)
  -- * Functions to construct Javascript values
 ,string
 ,number
 ,bool
 ,true
 ,false
 ,unit
 ,lvalue
 ,assign
 ,incr
 ,decr
) where

import BrownPLT.JavaScript
import BrownPLT.JavaScript.Syntax
import BrownPLT.JavaScript.PrettyPrint
import qualified Data.Foldable as F
import Control.Monad

-- | Cast a BrownPLT Javascript expression to the given type. Type is represented
-- by a value of the desired type (ofter "undefined").

castExpr :: (Functor x) => b -> x a -> x b

castExpr b e = fmap (const b) e

-- | Extract a type from an expression.

exprType :: Expression a -> a

exprType e =
  let f y z = NullLit (undefined :: a)
      (NullLit x) = F.foldr f undefined e
  in  x

-- | Extract a type from a statement.

stmtType :: Statement a -> a

stmtType s =
  let f y z = EmptyStmt (undefined :: a)
      (EmptyStmt x) = F.foldr f undefined s
  in  x

-- | An infix version of "castExpr" provided for convenience.

(/\) :: (Functor x) => x a -> b -> x b

(/\) = flip castExpr

-- | A helper function to encode a property setter. This function is mostly called
-- from converted IDL files for DOM interfaces.

setjsProperty :: (Monad m) => String -> Expression a -> Expression this -> m (Expression this)

setjsProperty pn pv this = do
  let tht = exprType this
      fun = FuncExpr tht [Id tht "x"] blk
      thv = VarRef tht (Id tht "x")
      blk = BlockStmt tht [setp, retx]
      setp = ExprStmt tht $ AssignExpr tht OpAssign (LDot tht thv pn) (pv /\ tht)
      retx = ReturnStmt tht (Just thv)
  return $ ParenExpr tht $ CallExpr tht fun [this]

-- | A helper function to retrieve a property by name (not too much type safe).
-- May return null if the property does not exist.

getjsProperty :: (Monad m) => Expression String -> Expression this -> m (Expression a)

getjsProperty pn this = do
  let at = undefined :: a
      r = BracketRef at (this /\ at) (pn /\ at)
  return r

-- | Same as above, but the retrieval is done by numeric index (not too much type safe either).
-- May return null if the property does not exist.

getjsIndex :: (Monad m) => Expression Double -> Expression this -> m (Expression a)

getjsIndex pn this = do
  let at = undefined :: a
      r = BracketRef at (this /\ at) (pn /\ at)
  return r


-- | A helper function to retrieve a property by name (not too much type safe).
-- The property name must be a constant. May return null if the property does not exist.

dotRef :: (Monad m) => String -> Expression this -> m (Expression a)

dotRef pn this = do
  let at = undefined :: a
      r = DotRef at (this /\ at) (Id at pn)
  return r

-- | A class whose instances can display their IDL types.

class IDLTypeable a where
  idlType :: a -> String
  defValue :: a -> Expression a
  defValue x = NullLit x


instance IDLTypeable t => IDLTypeable (Expression t) where
  idlType x = idlType (exprType x)


instance IDLTypeable t => IDLTypeable (Statement t) where
  idlType x = idlType (stmtType x)


instance IDLTypeable Bool where
  idlType _ = "boolean"
  defValue = bool

instance IDLTypeable () where
  idlType _ = "void"

instance IDLTypeable String where
  idlType _ = "DOMString"
  defValue s = StringLit s s

-- | Create a Javascript string literal out of a string.

string :: String -> Expression String

string s = StringLit s s

-- | Create a Javascript numeric literal out of a numeric value.

number :: (Integral n) => n -> Expression Double

number n = let d = fromIntegral n in NumLit d d

-- | Create a Javascript boolean literal out of a Boolean.

bool :: Bool -> Expression Bool

bool b = BoolLit b b

-- | Javascript True value

true :: Expression Bool

true = bool True

-- | Javascript False value

false :: Expression Bool

false = bool False

-- | A null-expression of type ()

unit :: Expression ()

unit = NullLit undefined

-- | Obtain a left-hand side value out of an 'Expression'. Not every expression
-- qualifies: only variable references, dot-references, and bracked references may be
-- converted.

lvalue :: Expression x -> LValue x

lvalue (VarRef x (Id _ v)) = LVar x v
lvalue (DotRef x e (Id _ f)) = LDot x e f
lvalue (BracketRef x e i) = LBracket x e i
lvalue z = error $ show (expr z) ++ " cannot be converted to a lvalue"

-- | Assign a lvalue-convertable expression. This comes out as a statement.

assign :: Expression x -> Expression x -> Statement x

ex `assign` ey = let ux = undefined :: x 
                 in  ExprStmt ux $ AssignExpr ux OpAssign (lvalue ex) ey

-- | Increment a value (prefix ++). The value should be convertable
-- to a 'LValue' (see 'lvalue').

incr :: Expression Double -> Expression Double

incr e = UnaryAssignExpr undefined PrefixInc (lvalue e)

-- | Decrement a value (prefix --). The value should be convertable
-- to a 'LValue' (see 'lvalue').

decr :: Expression Double -> Expression Double

decr e = UnaryAssignExpr undefined PrefixDec (lvalue e /\ undefined)