Yhc/Javascript/Programmers guide/EchoCPS demo source
From HaskellWiki
< Yhc | Javascript | Programmers guide
-- 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
