Difference between revisions of "Yhc/Javascript/Programmers guide/EchoCPS2 demo source"

From HaskellWiki
Jump to: navigation, search
(More comments)
(Deleting page that hasn't been edited for over 10 years)
Line 1: Line 1:
<haskell>
 
-- 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
 
</haskell>
 

Revision as of 11:35, 6 February 2021