blob: 83d2d8a5edeedf61cf5b05907f3e7a17ba24d8e5 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
module Main (main, setup) where
import Control.Monad.Reader
import Data.ByteString qualified as B
import Data.Maybe
import Data.Proxy
import Data.Text qualified as T
import GHC.Wasm.Prim
import Erebos.Identity
import Erebos.State
import Erebos.Storable
import Erebos.Storage
import System.IO.Unsafe
import JavaScript qualified as JS
import WebSocket
main :: IO ()
main = error "unused"
{-# NOINLINE globalStorage #-}
globalStorage :: Storage
globalStorage = unsafePerformIO $ memoryStorage
{-# NOINLINE globalHead #-}
globalHead :: Head LocalState
globalHead = unsafePerformIO $ do
identity <- createIdentity globalStorage (Just $ T.pack "<init>") Nothing
storeHead globalStorage $ LocalState { lsPrev = Nothing, lsIdentity = idExtData identity, lsShared = [], lsOther = [] }
foreign export javascript setup :: IO ()
setup :: IO ()
setup = do
body <- js_document_getElementById (toJSString "body")
js_set_innerHTML body (toJSString "<div>Name: <span id=\"name_text\"></span></div><hr><input id=\"some_input\" type=\"text\" value=\"xyz\" /><button id=\"some_button\">add</button></div><div><ul id=\"some_list\"></ul></div>")
nameElem <- js_document_getElementById (toJSString "name_text")
_ <- watchHead globalHead $ \ls -> do
js_set_textContent nameElem $ toJSString $ T.unpack $ displayIdentity $ headLocalIdentity ls
buttonElem <- js_document_getElementById (toJSString "some_button")
buttonCallback <- JS.asEventListener onButtonClick
JS.addEventListener buttonElem (toJSString "click") buttonCallback
let name = T.pack "My Name"
devName = T.pack "WebApp"
let st = globalStorage
owner <- if
| T.null name -> return Nothing
| otherwise -> Just <$> createIdentity st (Just name) Nothing
identity <- createIdentity st (if T.null devName then Nothing else Just devName) owner
shared <- wrappedStore st $ SharedState
{ ssPrev = []
, ssType = Just $ sharedTypeID @(Maybe ComposedIdentity) Proxy
, ssValue = [ storedRef $ idExtData $ fromMaybe identity owner ]
}
flip runReaderT globalHead $ do
updateLocalState_ $ \_ -> do
mstore $ LocalState
{ lsPrev = Nothing
, lsIdentity = idExtData identity
, lsShared = [ shared ]
, lsOther = []
}
startClient "localhost" 9160 "" $ \conn -> do
sendMessage conn $ B.pack [ 98 .. 107 ]
return ()
onButtonClick :: JSVal -> IO ()
onButtonClick _event = do
inputElem <- js_document_getElementById (toJSString "some_input")
listElem <- js_document_getElementById (toJSString "some_list")
li <- js_document_createElement (toJSString "li")
content <- js_document_createTextNode =<< js_get_value inputElem
js_appendChild li content
js_appendChild listElem li
foreign import javascript unsafe "document.getElementById($1)"
js_document_getElementById :: JSString -> IO JSVal
foreign import javascript unsafe "$1.innerHTML = $2"
js_set_innerHTML :: JSVal -> JSString -> IO ()
foreign import javascript unsafe "$1.textContent = $2"
js_set_textContent :: JSVal -> JSString -> IO ()
foreign import javascript unsafe "$1.appendChild($2)"
js_appendChild :: JSVal -> JSVal -> IO ()
foreign import javascript unsafe "document.createElement($1)"
js_document_createElement :: JSString -> IO JSVal
foreign import javascript unsafe "document.createTextNode($1)"
js_document_createTextNode :: JSString -> IO JSVal
foreign import javascript unsafe "$1.value"
js_get_value :: JSVal -> IO JSString
|