Cabal-Version: >= 1.2 Name: jsmw Version: 0.2 Copyright: 2009, Dmitry Golubovsky Maintainer: golubovsky@gmail.com License: BSD3 License-File: LICENSE Build-Type: Simple Author: Dmitry Golubovsky Synopsis: Javascript Monadic Writer base package. Description: An EDSL inspired in part by HJ(ava)Script and HSP aimed at coding in typed Javascript. It uses WebBits as the underlying representation of Javascript. . This package provides the basic API sufficient to create simple dynamic web pages. . Below is a simple example of a program that increments or decrements a value in an input field depending on whether /Enter/ or /Shift-Enter/ was pressed. . Save this program in a file, and run @runghc@ on the file. Javascript will be output to be placed into HEAD element of a blank HTML page. Give the page body attribute: . > . to run the script when the page loads. . A live example of this program is available here: . . > module Main where > > import Prelude hiding (putStrLn) > import System.IO.UTF8 > import BrownPLT.JavaScript > import BrownPLT.JavaScript.PrettyPrint > import Control.Monad > import Language.JSMW > import Data.DOM > import Data.DOM.Dom > import Data.DOM.Html2 > import Data.DOM.Events > import Data.DOM.KeyEvent > import Data.DOM.HTMLHRElement > import Data.DOM.HTMLInputElement > > main = putStrLn $ show $ stmt $ > FunctionStmt undefined (Id undefined "main") [] (getBlock ( runJSMW 0 q)) > > > q = do > passive (mkText $ string > "Example 1: Press Enter to increase value, Shift-Enter to decrease value") > passive mkHr > mkInput `container` (do > setHandler "keypress" plusOne > ask >>= set'value (string "0") >>= focus) > > plusOne :: OnHandler TKeyEvent THTMLInputElement > > plusOne e = do > c <- getm'keyCode e > switch (c) $ do > cDOM_VK_ENTER --> do i <- ask > v <- getm'value i > vv <- switch v $ do > "" --> stringM "0" > none (return v) > n <- parseInt vv 0 > shft <- get'shiftKey e > n2 <- switch shft $ do > True --> return (n - number 1) > False --> return (n + number 1) > once =<< (toString n2 >>= flip set'value i) > return false > none (return true) > Category: Language Data-Dir: ./library Data-Files: *.hs Build-depends: base >= 4.0.0, mtl, WebBits == 1.0, haskell-src-exts >= 1.1.4, utf8-string, datetime, webidlsyn, MaybeT, tuple, parsec < 3.0, syb, filepath Extensions: CPP, FlexibleInstances, MultiParamTypeClasses Exposed-modules: Language.JSMW, Language.JSMW.Monad, Language.JSMW.Arith, Language.JSMW.Cond, Data.JSRef, Language.JSMW.Type, Language.JSMW.Iterator, Language.JSMW.IdlGen -- This program tells the path to non-cabalized JSMW library modules. Executable: jsmw-lib Main-is: jsmw-lib.hs Other-modules: Paths_jsmw Hs-source-dirs: . -- The JSMW compiler wrapper. Executable: jsmwc Main-is: jsmwc.hs Other-modules: Paths_jsmw Hs-source-dirs: . -- The JSMW preprocessor to be used with GHC as custom preprocessor. Executable: jsmwpp Main-is: jsmwpp.hs Hs-source-dirs: .