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
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
module Main (main, setup) where
import Control.Concurrent
import Control.Monad
import Control.Monad.Reader
import Data.Maybe
import Data.Proxy
import Data.Text qualified as T
import GHC.Wasm.Prim
import Erebos.Chatroom
import Erebos.DirectMessage
import Erebos.Discovery
import Erebos.Identity
import Erebos.Network
import Erebos.Service
import Erebos.State
import Erebos.Storable
import Erebos.Storage
import Erebos.Sync
import System.IO.Unsafe
import Text.Blaze.Html5 ((!))
import Text.Blaze.Html5 qualified as H
import Text.Blaze.Html5.Attributes qualified as A
import Text.Blaze.Html.Renderer.String
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 $ renderHtml $ do
H.div $ do
"Name: "
H.span ! A.id "name_text" $ return ()
H.hr
H.input ! A.id "some_input" ! A.type_ "text" ! A.value "xyz"
H.button ! A.id "some_button" $ "add"
H.div $ do
H.ul ! A.id "some_list" $ return ()
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 = []
}
server <- startServer defaultServerOptions globalHead JS.consoleLog
[ someService @ChatroomService Proxy
, someService @DiscoveryService Proxy
, someService @DirectMessage Proxy
, someService @SyncService Proxy
]
startClient "localhost" 9160 "" $ \conn -> do
void $ serverPeerCustom server conn
void $ forkIO $ forever $ do
msg <- receiveMessage conn
receivedFromCustomAddress server conn msg
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
|