Yhc/Javascript/Programmers guide/EchoCPS demo source
< Yhc | Javascript | Programmers guide
Jump to navigation
Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.
-- 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 Level1 framework
-- also implemented in CPS style.
module EchoCPS 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.Level1.Dom
import DOM.Level1.Html
import CDOM.Level1.DomUtils
import CDOM.Level1.Events
import DOM.Level1.Document
import DOM.Level1.HTMLElement
import DOM.Level1.HTMLDivElement
import DOM.Level1.HTMLInputElement
-- 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 ->
-- body contains reference to the HTML document <body> element
-- which is the parent of all <div>'s displaying the lines being output
mkDiv doc $ \dv ->
mkText doc s $ \tx ->
addChild tx dv $ \ch ->
-- Functions whose names start with mk (mkDiv, mkText) are autogenerated
-- wrappers over DOM methods which create elements bearing appropriate
-- HTML tags. Above, a <div> and a #text elements were created, and the #text
-- element was added to the <div> as a child.
let iac = case mbb of
Nothing -> addChild dv
Just b -> insertChild b dv
-- Based on the mbb argument, decision was made whether to add the child
-- (previously created <div>) to the end of the document (addChild), or to
-- insert the <div> before the specific element (insertChild).
in iac body $ \ct ->
c ct
main = getHTMLDocument $ \doc ->
documentBody doc $ \body ->
-- The same sequence as above, to get the reference to the
-- HTML document's <body> element.
mkInput doc $ \inp ->
addChild inp body $ \_ ->
-- The <input> element was created and added to the <body> element
set'id "input-echo" inp $ \_ ->
-- The set' family of methods deal with setting nodes' properties.
-- The above expression sets the id attribute of the <input> element
-- to "input-echo", so in plain HTML this would be:
-- <input id="input-echo">
set'on "keypress" (inkey inp) inp $ \_ ->
-- The set'on "keypress" is same as specifying
-- <input id="input-echo" onkeypress="javascript:(inkey inp)">
focus inp $ id
-- The focus is a DOM method setting input focus on the element.
-- The id call at the very end "closes" the CPS chain of function calls.
-- A function to convert between Roman and Decimal presentations.
-- It also features exception handling that prevents the program
-- from crash if something wrong is entered. Input in error will be
-- converted into an empty string. The fromRoman and toRoman functions
-- call error in the situation when input cannot be processed.
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.
inkey :: THTMLInputElement -> a -> Bool
inkey o e = unsafeGetProperty "keyCode" e $ \kcs ->
unsafeToNum kcs $ \kci ->
-- Since there is no completed framework on event properties, we have
-- to use the unsafe interface. The two lines above extract the "keyCode"
-- property from the event received, and gets the numeric value of it.
-- In Javascript, this is equivalent to
-- new Number (e.keyCode)
if kci == 13
-- We are only interested in the Enter key whose code is 13.
-- Other keys just edit the value in the <input> element, and do not
-- need to be handled.
then
get'value o $ \val ->
unsafeToString val $ \v ->
-- The get' family of methods retrieve properties from nodes (elements).
-- They are basically wrappers over unsafeGetProperty, but IDL definition
-- guarantee that properties not defined per DOM are not accessible through
-- these functions. But we still need to obtain string value of it.
if length v > 0
-- If it was not just pressing Enter on an empty input box.
then
getTimeStamp $ \t1 ->
-- Obtain the current time stamp
toCPE (romdec v) $ \(rom, dec) ->
-- toCPE wraps an expression in the CPS style expression. See above,
-- the romdec function returns a tuple of two conversion results.
rom `seq` dec `seq` getTimeStamp $ \t2 ->
-- Usage of seq's is necessary because seq on the tuple forced by toCPE
-- does not evaluate deep into the structure: only to WHNF.
-- We want to measure the Roman-Deciman conversion time. So we have to force
-- the members of the tuple to evaluate before we get the next time stamp.
putLine (v ++ " " ++ rom ++ " " ++ dec ++ " " ++ show (t2 - t1) ++ " ms")
(Just o) $ \_ ->
-- putLine places the formatted output string before the <input> element
-- (Just o). So, as the program works, lines of output start at the top
-- of the browser window, and the <input> element moves downwards as new
-- output apprears.
set'value "" o $ \_ ->
-- Reset the <input> element, erase what was typed in.
-- The final lambda returns True regardless, which means that
-- the browser should take the default action on the user's input
-- (keys pressed).
True
else
True
else True