-
Notifications
You must be signed in to change notification settings - Fork 461
/
Main.purs
75 lines (64 loc) · 2.36 KB
/
Main.purs
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
module Main where
import Prelude
import Control.Coroutine (Consumer, Process, connect, consumer, runProcess, ($$))
import Control.Monad.Reader.Trans (runReaderT)
import Data.Maybe (Maybe(..))
import Effect (Effect)
import Effect.Aff (forkAff, Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Effect.Unsafe (unsafePerformEffect)
import Foreign.Generic (defaultOptions)
import Halogen (hoist)
import Halogen.Aff (awaitBody, runHalogenAff)
import Halogen.VDom.Driver (runUI)
import LocalStorage (RawStorageEvent)
import LocalStorage as LocalStorage
import MainFrame (mkMainFrame)
import Marlowe (SPParams_(SPParams_))
import Servant.PureScript.Settings (SPSettingsDecodeJson_(..), SPSettingsEncodeJson_(..), SPSettings_(..), defaultSettings)
import Web.HTML as W
import Web.HTML.Location as WL
import Web.HTML.Window as WW
import Web.Socket.WebSocket as WS
import Websockets (wsConsumer, wsProducer, wsSender)
ajaxSettings :: SPSettings_ SPParams_
ajaxSettings = SPSettings_ $ (settings { decodeJson = decodeJson, encodeJson = encodeJson })
where
SPSettings_ settings = defaultSettings $ SPParams_ { baseURL: "/api/" }
jsonOptions = defaultOptions { unwrapSingleConstructors = true }
decodeJson = SPSettingsDecodeJson_ jsonOptions
encodeJson = SPSettingsEncodeJson_ jsonOptions
main ::
Effect Unit
main = do
-- TODO: need to get the proper url, same as the client
window <- W.window
location <- WW.location window
protocol <- WL.protocol location
hostname <- WL.hostname location
port <- WL.port location
let
wsProtocol = case protocol of
"https:" -> "wss"
_ -> "ws"
wsPath = wsProtocol <> "://" <> hostname <> ":" <> port <> "/api/ws"
socket <- WS.create wsPath []
mainFrame <- mkMainFrame
runHalogenAff do
body <- awaitBody
driver <- runUI (hoist (flip runReaderT ajaxSettings) mainFrame) unit body
driver.subscribe $ wsSender socket
void $ forkAff $ runProcess (wsProducer socket $$ wsConsumer driver.query)
forkAff $ runProcess watchLocalStorageProcess
watchLocalStorageProcess :: Process Aff Unit
watchLocalStorageProcess = connect LocalStorage.listen watchLocalStorage
watchLocalStorage ::
forall r.
Consumer RawStorageEvent Aff r
watchLocalStorage =
consumer \event -> do
liftEffect $ log $ "Got Local Storage Event: " <> show event
pure Nothing
onLoad :: Unit
onLoad = unsafePerformEffect main