-
Notifications
You must be signed in to change notification settings - Fork 461
/
Main.purs
72 lines (63 loc) · 2.47 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
module Main where
import Prelude
import AppM (runAppM)
import Control.Coroutine (Consumer, Process, connect, consumer, runProcess)
import Data.Maybe (Maybe(..))
import Effect (Effect)
import Effect.Aff (Aff, forkAff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Effect.Unsafe (unsafePerformEffect)
import Env (Env)
import Foreign.Generic (defaultOptions)
import Halogen (Component, hoist)
import Halogen.Aff (awaitBody, runHalogenAff)
import Halogen.HTML (HTML)
import Halogen.VDom.Driver (runUI)
import LocalStorage (RawStorageEvent)
import LocalStorage as LocalStorage
import MainFrame.State (mkMainFrame)
import MainFrame.Types (Action(..), Msg(..), Query(..))
import MainFrame.Types as MainFrame
import Plutus.PAB.Webserver (SPParams_(SPParams_))
import Plutus.PAB.Webserver.Types (StreamToClient, StreamToServer)
import Servant.PureScript.Settings (SPSettingsDecodeJson_(..), SPSettingsEncodeJson_(..), SPSettings_(..), defaultSettings)
import WebSocket.Support (WebSocketManager, mkWebSocketManager)
import WebSocket.Support as WS
environment :: Env
environment =
{ ajaxSettings: SPSettings_ (settings { decodeJson = decodeJson, encodeJson = encodeJson })
}
where
SPSettings_ settings = defaultSettings $ SPParams_ { baseURL: "/" }
jsonOptions = defaultOptions { unwrapSingleConstructors = true }
decodeJson = SPSettingsDecodeJson_ jsonOptions
encodeJson = SPSettingsEncodeJson_ jsonOptions
main :: Effect Unit
main = do
let
mainFrame :: Component HTML MainFrame.Query MainFrame.Action MainFrame.Msg Aff
mainFrame = hoist (runAppM environment) mkMainFrame
runHalogenAff do
body <- awaitBody
driver <- runUI mainFrame Init body
void $ forkAff $ runProcess watchLocalStorageProcess
wsManager :: WebSocketManager StreamToClient StreamToServer <- mkWebSocketManager
void
$ forkAff
$ WS.runWebSocketManager (WS.URI "/ws") (\msg -> void $ driver.query $ ReceiveWebSocketMessage msg unit) wsManager
driver.subscribe
$ consumer
$ case _ of
(SendWebSocketMessage msg) -> do
WS.managerWriteOutbound wsManager $ WS.SendMessage msg
pure Nothing
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