You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 

128 lines
3.7 KiB

{-# LANGUAGE CPP #-}
module Main where
import Prelude hiding (div,id,span)
import Transient.Base
#ifdef ghcjs_HOST_OS
hiding ( option)
#endif
import GHCJS.HPlay.View
#ifdef ghcjs_HOST_OS
hiding (map)
#else
hiding (map, option)
#endif
import Transient.Move
import Transient.Indeterminism
import Control.Applicative
import Control.Monad
import Data.Typeable
import Data.IORef
import Control.Concurrent (threadDelay)
import Control.Monad.IO.Class
-- Show the composability of transient web aplications
-- with three examples composed together, each one is a widget that execute
-- code in the browser AND the server.
main = simpleWebApp 8080 $ demo <|> demo2 <|> counters
demo= do
name <- local . render $ do
rawHtml $ do
hr
p "this snippet captures the essence of this demonstration"
p $ do
span "it's a blend of server and browser code in a "
span $ b "composable"
span " piece"
div ! id (fs "fibs") $ i "Fibonacci numbers should appear here"
local . render $ wlink () (p " stream fibonacci numbers")
-- stream fibonacci
r <- atRemote $ do
let fibs= 0 : 1 : zipWith (+) fibs (tail fibs) :: [Int] -- fibonacci numb. definition
r <- local . threads 1 . choose $ take 10 fibs
lliftIO $ print r
lliftIO $ threadDelay 1000000
return r
local . render . at (fs "#fibs") Append $ rawHtml $ (h2 r)
demo2= do
name <- local . render $ do
rawHtml $ do
hr
br;br
p "In this example you enter your name and the server will salute you"
br
-- inputString (Just "Your name") `fire` OnKeyUp -- send once a char is entered
inputString Nothing ! atr "placeholder" (fs "enter your name") `fire` OnKeyUp
<++ br -- new line
r <- atRemote $ lliftIO $ print (name ++ " calling") >> return ("Hi " ++ name)
local . render . rawHtml $ do
p " returned"
h2 r
fs= toJSString
counters= do
local . render . rawHtml $ do
hr
p "To demonstrate the use of teleport, widgets, interactive streaming"
p "and composability in a web application."
br
p "This is one of the most complicated interactions: how to control a stream in the server"
p "by means of a web interface without loosing composability."
br
p "in this example, events flow from the server to the browser (a counter) and back from"
p "the browser to the server (initiating and cancelling the counters)"
-- server <- local $ getSData <|> error "no server???"
counter <|> counter
where
counter = do
op <- startOrCancel
teleport -- translates the computation to the server
r <- local $ case op of
"start" -> killChilds >> stream
"cancel" -> killChilds >> stop
teleport -- back to the browser again
local $ render $ rawHtml $ h1 r
-- generates a sequence of numbers
stream= do
counter <- liftIO $ newIORef (0 :: Int)
waitEvents $ do
n <- atomicModifyIORef counter $ \r -> (r +1,r)
threadDelay 1000000
putStr "generating: " >> print n
return n
startOrCancel :: Cloud String
startOrCancel= local $ render $ (inputSubmit "start" `fire` OnClick)
<|> (inputSubmit "cancel" `fire` OnClick)
<++ br