upgraded + very lighweight modification
This commit is contained in:
parent
c4101090a0
commit
77a96c4eeb
4 changed files with 29 additions and 14 deletions
10
app/Main.hs
10
app/Main.hs
|
@ -1,7 +1,7 @@
|
|||
module Main where
|
||||
|
||||
import PeekPoke (peekPoke)
|
||||
import Hello (hello)
|
||||
-- import PeekPoke (peekPoke)
|
||||
-- import Hello (hello)
|
||||
import RWebsite (rwebsite,initRWebsite)
|
||||
|
||||
import GHCJS.HPlay.View
|
||||
|
@ -10,5 +10,7 @@ import Transient.Base
|
|||
main :: IO ()
|
||||
main = keep $ do
|
||||
initialState <- initRWebsite
|
||||
initNode $ onBrowser peekPoke
|
||||
<|> rwebsite initialState
|
||||
initNode $ rwebsite initialState
|
||||
-- initNode $ onBrowser peekPoke
|
||||
-- <|> onBrowser hello
|
||||
-- <|> rwebsite initialState
|
||||
|
|
|
@ -2,7 +2,7 @@ module RWebsite where
|
|||
|
||||
-- The IORef play the role of a DB
|
||||
|
||||
import Prelude hiding(div,id)
|
||||
import Prelude hiding(div,id,span)
|
||||
import Transient.Base
|
||||
import Transient.Move
|
||||
import Transient.EVars
|
||||
|
@ -85,13 +85,26 @@ formWidget rdata dataAvailable = do
|
|||
<*> getString Nothing `fire` OnKeyUp
|
||||
atRemote $ localIO $ writeEVar dataAvailable (MyFormUpdated myForm)
|
||||
(State (AdminLogged _) MyFormNotSendYet) ->
|
||||
local.render.rawHtml $ h1 "Waiting Formulary"
|
||||
local.render.rawHtml $ h2 ! color "#662" $ "Waiting Formulary"
|
||||
(State (AdminLogged _) (MyFormSent myForm)) ->
|
||||
local.render.rawHtml $ do
|
||||
h1 "Waiting Formulary"
|
||||
div (show myForm)
|
||||
h2 ! color "#283" $ "Received Formulary"
|
||||
view myForm
|
||||
_ -> local . render .rawHtml $ h1 "FAILED"
|
||||
|
||||
-- WARNING unsafe here
|
||||
color :: String -> Attribute
|
||||
color c = atr "style" (fromString ("color: " <> c))
|
||||
|
||||
view :: MyForm -> Perch
|
||||
view myForm = div $ do
|
||||
label "i1: "
|
||||
span (i1 myForm)
|
||||
br
|
||||
label "i2: "
|
||||
span (i2 myForm)
|
||||
|
||||
|
||||
syncWidget :: EVar Msg -> Cloud ()
|
||||
syncWidget dataAvailable = onBrowser $ do
|
||||
-- display in the browser
|
||||
|
|
|
@ -7,9 +7,9 @@ packages:
|
|||
|
||||
extra-deps:
|
||||
- ghcjs-perch-0.3.3
|
||||
- transient-0.4.2.2
|
||||
- transient-universe-0.3.2.3
|
||||
- ghcjs-hplay-0.3.4
|
||||
- transient-0.4.4
|
||||
- transient-universe-0.3.5
|
||||
- ghcjs-hplay-0.3.4.2
|
||||
|
||||
extra-package-dbs: []
|
||||
|
||||
|
|
|
@ -4,9 +4,9 @@ packages:
|
|||
- '.'
|
||||
extra-deps:
|
||||
- ghcjs-perch-0.3.3
|
||||
- transient-0.4.2.2
|
||||
- transient-universe-0.3.2.3
|
||||
- ghcjs-hplay-0.3.4
|
||||
- transient-0.4.4
|
||||
- transient-universe-0.3.5
|
||||
- ghcjs-hplay-0.3.4.2
|
||||
|
||||
flags: {}
|
||||
|
||||
|
|
Loading…
Reference in a new issue