Yhc/Javascript/Programmers guide/EchoCPS2 demo source

-- A program similar to the Echo program, written
-- without monads as the first step to Fudgets adoption.
-- The program also demonstrates use of the DOM Level2 framework
-- also implemented in CPS style.

module  EchoCPS2 where

-- This module contains useful functions to access properties of underlying
-- Javascript objects in the type-agnostic manner: proceed with caution!
import UnsafeJS

-- This module contains functions to wrap expressions in CPS style
import CPS

-- This module contains Roman-Decimal conversion funcitons
import Roman

-- The modules under DOM are autogenerated from IDL
-- The modules under CDOM are utilities to simplify the use of DOM facilities
import DOM.Level2.Dom
import DOM.Level2.Html2
import CDOM.Level2.DomUtils
import CDOM.Level2.Events
import DOM.Level2.Events
import DOM.Level2.Document
import DOM.Level2.HTMLElement
import DOM.Level2.HTMLDivElement
import DOM.Level2.HTMLInputElement
import DOM.Level2.KeyEvent

-- This module contains functions to obtain timestamps
import Debug.Profiling

-- Line-mode output: create a <div> element, place a text in it, 
-- append to the parent element (document body). The mbb argument
-- specifies whether the text will be inserted before a specific
-- element (Just) or just appended to the end of the document (Nothing).
-- The s argument is the string to output, and the c argument is
-- the continuation.

putLine s mbb c = getHTMLDocument $ \doc ->
                  documentBody doc $ \body ->
                  mkDiv doc $ \dv ->
                  mkText doc s $ \tx ->
                  addChild tx dv $ \ch ->
                  let iac = case mbb of
                              Nothing -> addChild dv
                              Just b -> insertChild b dv
                  in  iac body $ \ct -> 
                  c ct


main = getHTMLDocument $ \doc ->
       documentBody doc $ \body ->
       putLine ("*** Echo Benchmark ***") nodeNothing $ \_ ->
       mkInput doc $ \inp ->
       addChild inp body $ \_ ->
       set'id "input-echo" inp $ \_ ->
       setEventHandler "keypress" (inkey inp) inp $ \_ ->

-- The setEventHandler function still uses the "on-" element attributes,
-- but given better event type information is contained in the DOM Level2
-- definitions, the handler type signature may be set.

-- The setEventHandler itself has type:
-- setEventHandler :: (CElement zz, CEvent a) => String -> (a -> Bool) -> zz -> CPS c zz

       focus inp $ id

romdec :: String -> (String, String)

romdec v =
  let rom = (catchJS ((show . fromRoman) v) (\_ -> ""))
      dec = (catchJS ((toRoman . read) v) (\_ -> ""))
  in (rom, dec)

-- The "onkeypress" handler: it does all the job. Note the o argument:
-- it holds reference to the element a handler is attached to. This forms
-- a closure (which may not be very much desired for some browsers), but
-- makes it extremely easy to distinguish between elements that cause 
-- the handler to fire. The e argument is expected to be of the TKeyEvent
-- type (defined in DOM IDL).

inkey :: THTMLInputElement -> TKeyEvent -> Bool

-- Now it is possible to refer to event object methods and attributes
-- in type safe manner instead of unsafe getting attributes by name.
-- The KeyEvent interface defines the cDOM_VK_ENTER constant for the
-- "Enter" key.
       
inkey o e = get'keyCode e $ \kci ->
            if kci == cDOM_VK_ENTER
              then
                get'value o $ \v ->
                if length v > 0
                  then
                    getTimeStamp $ \t1 -> 
                    toCPE (romdec v) $ \(rom, dec) ->
                    rom `seq` dec `seq` getTimeStamp $ \t2 ->
                    putLine (v ++ " " ++ rom ++ " " ++ dec ++ " " ++ show (t2 - t1) ++ " ms") 
                            (Just o) $ \_ ->
                    set'value "" o $ \_ ->
                    True
                  else  
                    True
              else True