Yhc/Javascript/Programmers guide/Echo demo source

module Echo where

-- This program demonstrates the lowest possible level of interaction 
-- with Javascript. No extra libraries, no programming paradigms:
-- just some helper functions defined directly via unsafeJS.

-- Import the UnsafeJS module to get access to the low-level Javascript,
-- that is, ability to wrap arbitrary Javascript expressions into
-- a Haskell-callable function. See a special section of ycr2js 
-- Programmers guide where usage of unsafeJS is discussed in details.

import UnsafeJS
import Char

-- Import this module for decimal to Roman and Roman to decimal conversions.
-- This also serves as a primitive benchmark, and shows that third-party code
-- may also be brought into web browser.

import Roman

-- Import this module to be able to define a monad which provides
-- correct ordering of Javascript execution.

import Control.Monad

-- Opaque type for Javascript objects. No values of this type are constructed
-- in the Haskell code. But every object returned from Javascript belongs to
-- this type.

newtype JSObject = JSObject ()

-- A simple monad used for enforcing actions order only.
-- Both its bind operations (>>=, >>) should evaluate their
-- left-hand-side expression to make sure all Javascript computations
-- associated to that expression have been completed before execution
-- goes to the right-hand-side expression.
-- Even >> should evaluate its LHS argument although it is "lost"
-- for the RHS expression. This is achieved via pattern-matching.
-- The same holds for return.

data JS a = JS a

instance Monad JS where

-- bind: execute the LHS expression, extract result from the monad,
-- pass on to the RHS expression.

  (JS a) >>= fn = fn a

-- anomymous bind: execute the LHS expression, then the RHS expression
-- that is, enforce correct execution order only.

  (JS a) >> fn = fn

-- The return function must evaluate its argument before wrapping it into
-- monad. This is important e. g. for exception handlers, otherwise
-- nothing may be evaluated within exception handler, and actual exception
-- will occur outside of the exception handler and will not be caught properly.

  return a = a `seq` (JS a)

-- Here are the functions to access web-browser's DOM structures.
-- In the absence of the standardized framework, these functions 
-- are coded on ad-hoc basis, and their interface may be imperfect,
-- but this is a good demonstration what kind of stuff may be needed
-- for a real framework.

-- Get the document interface reference

getDocument :: JS JSObject

-- This (and other) examples show how to return data (including monadic) values
-- from Javascript to Haskell. The HSData constructor finction is used allover
-- the Javascript code generated form Haskell source to create data objects.
-- Its first argument is data constructor name index, and its second argument
-- is an array of data object member values in proper order. To obtain
-- data constructor name index, one has to refer to the conIdx global variable
-- which is indexed by constructor qualified name. Since the JS monad is defined
-- in this module named Echo, qualified name of the constructor is Echo.JS.
-- Web browser DOM interface defines a global name for the document interface
-- access, that is, `document'. Its value is wrapped into the JS monad
-- and returned.

getDocument = unsafeJS "return new HSData(conIdx['Echo.JS'],[document]);"

-- Obtain a property of an object

getProperty :: JSObject -> String -> JS JSObject

-- Similarly, return a value wrapped into the IO monad. The `a' argument
-- is the reference to a Javascript object, and the `b' argument is
-- a string containing name of the property to be retrieved. The function
-- evaluates both of its arguments and retrieves the property name of `a'
-- as an associative array element using the value of `b'.

getProperty a b = unsafeJS
  "return new HSData(conIdx['Echo.JS'],[exprEval(a)[exprEval(b).toString()]]);"

-- Modify a property of an object

setProperty :: JSObject -> String -> a -> JS ()

-- Set property named `b' of the object refered to as `a' to the value of `c'.
-- The third argument may be of any type, but its evaluation should terminate.

-- As a side note: this function returns a `void' value (unit, ()). Its type signature
-- might be rearranged, like this:
--
-- String -> a -> JSObject -> JS JSObject -- that is, returns the same object with
--                                        -- property modified
--
-- then operations of setting object property might be chained in the JS monad:
--
-- obj' <- setProperty "prop1" val1 obj >>= 
--         setProperty "prop2" val2 >>= 
--         setProperty "prop3" val3

setProperty a b c = unsafeJS
  "exprEval(a)[exprEval(b).toString()]=exprEval(c);return new HSData(conIdx['Echo.JS'],[]);"

-- Invoke a method of an object

runMethod :: JSObject -> String -> a -> JS JSObject

-- This function obtains reference to an object's method similarly 
-- to obtaining reference to a property, using the method name string.
-- Its third argument `c' must be a list. It is converted into an array
-- of function arguments and the method is applied to this array.
-- This function uses `cbrApply' rather than the Javascript function object's
-- `apply' method for cross-browser compatibility: MSIE DOM functions do not have
-- the `apply' method, so cbrApply detects that and works around this issue.
-- Evaluation of expressions in `c' is done by the `toArray' method which is properly
-- overloaded for Haskell lists as they are unmarshalled to Javascript.

runMethod a b c = unsafeJS
  "var a1=exprEval(a); return new HSData(conIdx['Echo.JS'],[cbrApply(a1[exprEval(b).toString()],a1,c._toArray())]);"

-- Output string representation of an object into the status line

putStatLn :: a -> JS ()

-- This is a helper function which sets the `window.status' global object to
-- the stringified value of the function's argument. Note how a unit value ()
-- is returned: an empty array is used as the second argument to HSData. While
-- to be exact, one should retrieve an index of the () data constructor and
-- construct another data object, the practice shown is acceptable in most cases,
-- except for the situation when pattern matching is done on the unit value.

putStatLn a = unsafeJS "window.status=exprEval(a).toString(); return new HSData(conIdx['Echo.JS'],[]);"

-- Output source representation of an object into the status line

putStatLnSrc :: a -> JS ()

-- Similarly to the function above, but `toSource' method is used.

putStatLnSrc a = unsafeJS "window.status=exprEval(a).toSource(); return new HSData('Echo_46JS',[]);"


-- Register an event handler (old DOM0 style)

regEventHandler :: JSObject -> String -> (JSObject -> JS ()) -> JS ()

-- This function attaches an old-style event handler `c' to a DOM object
-- (such as an input field) `a'. Name of the event is passed in `b' as string
-- (e. g. "onkeypress"). This function works around browser incompatibility.
-- Mozilla/Netscape/FireFox pass event information as an event handler's
-- argument. MSIE passes it in a global object named `event'. This function
-- wrap the Haskell handler function into an anonymous function which checks
-- for its argument, and if unavailable, tries to get the information
-- from the global `event' object.

regEventHandler a b c = unsafeJS
  "exprEval(a)[exprEval(b).toString()]=function(e){if(!e){e=window.event;}; return exprEval(exprEval(c)._ap([e]));}; return new HSData(conIdx['Echo.JS'],[]);"

-- Get the numeric representation of an object

asInt :: JSObject -> JS Int

-- This function (ab)uses the untypedness of Javascript and coerces
-- any object to a numeric value.

asInt a = unsafeJS
  "return new HSData(conIdx['Echo.JS'],[new Number(exprEval(a))]);"

-- Get the String representation of an object

asString :: JSObject -> JS String

-- This function (ab)uses the untypedness of Javascript and coerces
-- any object to a stringified value.

asString a = unsafeJS
  "return new HSData(conIdx['Echo.JS'],[new String(exprEval(a))]);"

-- Catch exceptions using Javascript exception machinery

catchJS :: JS a -> (JSObject -> JS a) -> JS a

-- This function installs an exception handler `b' while executing an expression
-- in `a'. If an exception occurs, it will be passed to the handler which should
-- return a "replacement" value.

catchJS a b = unsafeJS
  "try {return exprEval(a);} catch(_e) {return exprEval(b)._ap([_e]);}"

-- Get current time in ms since 1970 (for performance measurements)

getTime :: Int -> JS Int

-- This function obtains current time from the browser. The first argument
-- is not used but is necessary in order to have this function evaluated
-- more than once. In its absence, evaluation result will be stored in the
-- getTime's function descriptor, and it will always return time of the first
-- evaluation.

getTime a = unsafeJS
  "return new HSData(conIdx['Echo.JS'],[(new Date()).getTime()]);"


-- Key press handler

--       element     event       void
inkey :: JSObject -> JSObject -> JS ()

-- An event handler function has its first argument
-- to pass the reference to the object which generates an event. Thus,
-- although this builds a circular structure with a DOM object involved (may be harmful
-- for MSIE garbage collection), this works around some incompatibilities
-- between browsers regarding how event source is encoded in the event.
-- As an alternative, object "id" property value might be passed instead of
-- reference to an object itself. This would avoid creation of a circular link,
-- but would make execution of the event handler slightly longer.

-- As a side note: Event handler's type signature might be modified to return
-- a modified event. Using this approach, event handlers might be chained
-- using the monadic `bind' function which passes output from its LHS expression
-- to its RHS expression.

-- This handler analyzes code of the key pressed.
-- If it is Enter (13) then the input value is placed into a
-- dynamically created div and inserted above the input field.

inkey o e = do

-- Obtain numeric code of the key pressed

  kcs <- getProperty e "keyCode" >>= asInt

-- If `Enter' was pressed

  when (kcs == (13::Int)) $ do

-- Obtain the time when `Enter' was pressed

    t1 <- getTime 0

-- Get the document interface

    doc <- getDocument

-- Get the document body element interface

    body <- getProperty doc "body"

-- Create a div dynamically

    mydiv <- runMethod doc "createElement" ["div"]

-- Obtain the string typed: it is the value of the input element

    v <- getProperty o "value" >>= asString

-- If the string was not empty

    when (length v > 0) $ do

-- Conversion functions of the Roman module raise error 
-- when conversion cannot be done. In this case, empty string
-- should be returned.

      rom <- catchJS (return $ (show . fromRoman) v) (\_ -> return "")
      dec <- catchJS (return $ toRoman (read v)) (\_ -> return "")

-- Obtain the time after possible conversion is done

      t2 <- getTime 0

-- Format the result

      let dt = t2 - t1
      let vr = v ++ " " ++ rom ++ " " ++ dec ++ " " ++ show dt ++ " ms"

-- Output the result into the div element

      setProperty mydiv "innerHTML" vr

-- Make the div visible right above the input element

      runMethod body "insertBefore" [mydiv, o]

-- Clear the input element

      setProperty o "value" ""

-- Return from the handler

      return ()
    return ()
  return ()

-- Main program. As in "traditional" Haskell programming, it has a monadic type.
-- But since there is no "traditional" input/output in a web browser, the IO monad
-- is useless here; use the JS monad.

main :: JS ()

main = do

-- Get the document interface

  doc <- getDocument

-- Get the document body element interface

  body <- getProperty doc "body"

-- Create the input field.

  inp <- runMethod doc "createElement" ["input"]

-- Set the "id" property. It is unused in this demo, but
-- might be helpful in general.

  setProperty inp "id" "input-echo"

-- Append the input element ot the list of body's children
-- thus visualizing it.

  runMethod body "appendChild" [inp]

-- Register an event handler on the input field. Note that
-- (inkey inp) is passed as an event handler; thus, its closure
-- will contain reference to the input element that generates an event.

  regEventHandler inp "onkeypress" (inkey inp)

-- Set input focus.

  runMethod inp "focus" []
  return ()