summaryrefslogtreecommitdiff
path: root/src/Main.purs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Main.purs')
-rw-r--r--src/Main.purs157
1 files changed, 157 insertions, 0 deletions
diff --git a/src/Main.purs b/src/Main.purs
new file mode 100644
index 0000000..bb5fa57
--- /dev/null
+++ b/src/Main.purs
@@ -0,0 +1,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"