blob: bb5fa571ef44b6a086d8881f445fe9f25cf4f594 (
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
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
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
|
module Main where
import Prelude
import Audio as Audio
import Auth (AuthInfo, authHeader, getToken, startTwitchAuth)
import Config as Config
import Data.Array (head)
import Data.Array as Array
import Data.Foldable (fold)
import Data.Maybe (Maybe(..))
import Data.Traversable (for, for_)
import Data.Tuple (Tuple(..))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (class MonadEffect, liftEffect)
import Effect.Console (log)
import Effect.Exception (throw)
import Fetch (fetch)
import Model (startModel)
import UI as UI
import Web.DOM as DOM
import Web.DOM.DOMTokenList as DOM.DTL
import Web.DOM.Document (doctype)
import Web.DOM.Document as DOM.Doc
import Web.DOM.Element as DOM.El
import Web.DOM.Node as DOM.Node
import Web.DOM.NodeList as DOM.NL
import Web.DOM.NonElementParentNode as DOM.NEP
import Web.DOM.ParentNode as DOM.P
import Web.DOM.Text as DOM.Text
import Web.Event.Event as Ev
import Web.Event.EventTarget as Ev.Tar
import Web.HTML as HTML
import Web.HTML.HTMLDocument as HTML.Doc
import Web.HTML.Window as HTML.Win
maybeToArray :: forall a. Maybe a -> Array a
maybeToArray (Just x) = [x]
maybeToArray Nothing = []
byId :: forall m. MonadEffect m => String -> m DOM.Element
byId i = do
w <- liftEffect HTML.window
d <- liftEffect $ HTML.Doc.toDocument <$> HTML.Win.document w
liftEffect (DOM.NEP.getElementById i (DOM.Doc.toNonElementParentNode d)) >>= case _ of
Nothing -> liftEffect $ throw $ "could not find element with id: " <> i
Just e -> pure e
queryAll :: forall m. MonadEffect m => String -> m (Array DOM.Element)
queryAll q = do
w <- liftEffect HTML.window
d <- liftEffect $ HTML.Doc.toDocument <$> HTML.Win.document w
nl <- liftEffect (DOM.P.querySelectorAll (DOM.P.QuerySelector q) (DOM.Doc.toParentNode d))
ns <- liftEffect $ DOM.NL.toArray nl
pure $ fold $ (maybeToArray <<< DOM.El.fromNode) <$> ns
query :: forall m . MonadEffect m => String -> m DOM.Element
query q = do
queryAll q >>= head >>> case _ of
Nothing -> liftEffect $ throw $ "could not find element matching query: " <> q
Just x -> pure x
listen :: forall m. MonadEffect m => DOM.Element -> String -> (Ev.Event -> Effect Unit) -> m Unit
listen e ev f = do
l <- liftEffect $ Ev.Tar.eventListener f
liftEffect $ Ev.Tar.addEventListener (Ev.EventType ev) l false $ DOM.El.toEventTarget e
create :: forall m. MonadEffect m => String -> Array String -> Array DOM.Element -> m DOM.Element
create tag classes children = do
w <- liftEffect HTML.window
d <- liftEffect $ HTML.Doc.toDocument <$> HTML.Win.document w
el <- liftEffect $ DOM.Doc.createElement tag d
cl <- liftEffect $ DOM.El.classList el
for_ classes \c ->
liftEffect $ DOM.DTL.add cl c
for_ children \c ->
appendElement el c
pure el
appendElement :: forall m. MonadEffect m => DOM.Element -> DOM.Element -> m Unit
appendElement parent child = liftEffect $ DOM.Node.appendChild (DOM.El.toNode child) (DOM.El.toNode parent)
appendText :: forall m. MonadEffect m => DOM.Element -> String -> m Unit
appendText parent s = do
w <- liftEffect HTML.window
d <- liftEffect $ HTML.Doc.toDocument <$> HTML.Win.document w
n <- liftEffect $ DOM.Doc.createTextNode s d
liftEffect $ DOM.Node.appendChild (DOM.Text.toNode n) (DOM.El.toNode parent)
setText :: forall m. MonadEffect m => DOM.Element -> String -> m Unit
setText e s = liftEffect $ DOM.Node.setTextContent s $ DOM.El.toNode e
updateSubtitle :: Aff Unit
updateSubtitle = do
subtitle <- byId "lcolonq-subtitle"
{ text: catchphrase } <- fetch (Config.apiServer <> "/catchphrase") {}
catchphrase >>= setText subtitle
checkAuth :: AuthInfo -> Aff String
checkAuth auth = do
{ text: resp } <-
fetch (Config.apiServer <> "/check")
{ headers:
{ "Authorization": authHeader auth
}
}
resp
mainHomepage :: Effect Unit
mainHomepage = launchAff_ do
liftEffect $ log "hi"
startModel
marq <- byId "lcolonq-marquee"
{ text: motd } <- fetch (Config.apiServer <> "/motd") {}
motd >>= setText marq
getToken >>= case _ of
Just a@(Tuple t n) -> do
liftEffect $ log t
liftEffect $ log n
checkAuth a >>= log >>> liftEffect
_ -> pure unit
updateSubtitle
subtitle <- byId "lcolonq-subtitle"
listen subtitle "click" \_ev -> do
startTwitchAuth
launchAff_ updateSubtitle
for_ (Array.range 0 6) \i -> do
letter <- byId $ "lcolonq-letter-" <> show i
listen letter "click" \_ev -> do
Audio.playVoice true i
listen letter "mouseover" \_ev -> do
Audio.playVoice false i
mainExtension :: Effect Unit
mainExtension = launchAff_ do
liftEffect $ log "hello from extension"
UI.setInterval 1000.0 do
e <- query ".chat-scrollable-area__message-container"
new <- create "div" [".chat-line__message"] []
appendText new "test"
appendElement e new
mainObs :: Effect Unit
mainObs = launchAff_ do
startModel
main :: Effect Unit
main = case Config.mode of
0 -> mainHomepage
1 -> mainExtension
2 -> mainObs
-- 3 -> mainButton
_ -> throw "unknown mode"
|
