summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Makefile41
-rw-r--r--main.css103
-rw-r--r--src/Main.purs287
-rw-r--r--src/Main/API.purs10
-rw-r--r--src/Main/Auth.purs46
-rw-r--r--src/Main/Button.purs29
-rw-r--r--src/Main/Extension.purs19
-rw-r--r--src/Main/Greencircle.purs11
-rw-r--r--src/Main/Menu.purs22
-rw-r--r--src/Main/OBS.purs11
-rw-r--r--src/Main/Pubnix.purs52
-rw-r--r--src/Main/Register.purs45
-rw-r--r--src/Utils.purs118
-rw-r--r--templates/greencircle/index.html83
14 files changed, 604 insertions, 273 deletions
diff --git a/Makefile b/Makefile
index fb6f9dd..325b796 100644
--- a/Makefile
+++ b/Makefile
@@ -3,8 +3,9 @@
TEMPLATES_API=$(shell ls templates/api)
TEMPLATES_PUBNIX=$(shell ls templates/pubnix)
TEMPLATES_AUTH=$(shell ls templates/auth)
+TEMPLATES_GREENCIRCLE=$(shell ls templates/greencircle)
-all: api pubnix extension
+all: api pubnix extension auth greencircle
dist:
mkdir -p dist/api/test
@@ -13,6 +14,8 @@ dist:
mkdir -p dist/pubnix/deploy
mkdir -p dist/auth/test
mkdir -p dist/auth/deploy
+ mkdir -p dist/greencircle/test
+ mkdir -p dist/greencircle/deploy
main.js: $(shell find src)
purs-nix bundle
@@ -84,21 +87,51 @@ dist/auth/%/$(template): config/%.m4 templates/auth/$(template)
endef
$(foreach template,$(TEMPLATES_AUTH), $(eval $(GEN_RULE_AUTH)))
+# greencircle
+deploy_greencircle: dist $(addprefix dist/greencircle/deploy/,$(TEMPLATES_GREENCIRCLE)) dist/greencircle/deploy/assets dist/greencircle/deploy/main.js dist/greencircle/deploy/main.css
+
+greencircle: dist $(addprefix dist/greencircle/test/,$(TEMPLATES_GREENCIRCLE)) dist/greencircle/test/assets dist/greencircle/test/main.js dist/greencircle/test/main.css
+
+dist/greencircle/%/main.js: main.js dist
+ cp $< $@
+
+dist/greencircle/%/main.css: main.css dist
+ cp $< $@
+
+dist/greencircle/%/assets: $(shell find assets) dist
+ rm -rf $@
+ mkdir -p $@
+ cp -r assets/* $@
+
+define GEN_RULE_GREENCIRCLE
+dist/greencircle/%/$(template): config/%.m4 templates/greencircle/$(template)
+ sh -c "m4 $$^ >$$@"
+endef
+$(foreach template,$(TEMPLATES_GREENCIRCLE), $(eval $(GEN_RULE_GREENCIRCLE)))
+
# extension
extension: dist dist/extension/assets dist/extension/manifest.json dist/extension/background.js dist/extension/main.js dist/extension/main.css dist/extension/config.js
dist/extension/main.css: extension/main.css dist
cp $< $@
-dist/extension/manifest.json: extension/manifest.dhall
+dist/extension/manifest.json: extension/manifest.dhall dist
dhall-to-json <$< >$@
-dist/extension/config.js: config/extension.js
+dist/extension/config.js: config/extension.js dist
+ cp $< $@
+
+dist/extension/main.js: main.js dist
cp $< $@
-dist/extension/%: extension/%
+dist/extension/%: extension/% dist
cp $< $@
+dist/extension/assets: $(shell find assets) dist
+ rm -rf $@
+ mkdir -p $@
+ cp -r assets/* $@
+
clean:
rm main.js
rm -r dist/
diff --git a/main.css b/main.css
index 9b4a85a..612f69c 100644
--- a/main.css
+++ b/main.css
@@ -376,3 +376,106 @@ a.lcolonq-button-link :active {
text-align: center;
color: red;
}
+
+/* greencircle */
+#lcolonq-gc-body {
+ overflow-y: scroll;
+ height: auto;
+}
+
+#lcolonq-gc-hero {
+ height: 100vh;
+ display: flex;
+ flex-direction: column;
+ align-items: center;
+}
+
+#lcolonq-gc-spin {
+ height: 60vh;
+ width: 60vh;
+ margin-top: 20vh;
+ margin-bottom: 20vh;
+ display: grid;
+ place-items: center;
+}
+
+#lcolonq-gc-logo {
+ grid-area: 1 / 1;
+ margin-top: 2vh;
+ margin-left: 8vh;
+ height: 100%;
+ image-rendering: pixelated;
+}
+
+#lcolonq-gc-spin-image {
+ grid-area: 1 / 1;
+ animation: spin 40s linear infinite;
+ margin-left: 2vh;
+ height: 250%;
+ width: 250%;
+ user-select: none;
+ pointer-events: none;
+}
+
+@keyframes spin {
+ 100% {
+ transform: rotate(360deg);
+ }
+}
+
+#lcolonq-gc-rest {
+ min-height: 100vh;
+ display: grid;
+ grid-template-columns: 1fr 1fr 1fr;
+ grid-template-rows: auto;
+ grid-auto-rows: min-content;
+}
+
+#lcolonq-gc-explainer {
+ grid-area: 1 / 1 / 1 / 4;
+ text-align: justify;
+ padding-left: 1rem;
+ padding-right: 1rem;
+}
+
+#lcolonq-gc-explainer h1 {
+ text-align: center;
+}
+
+#lcolonq-gc-explainer p {
+ mask-image: linear-gradient(180deg, white 50%, transparent 95%);
+}
+
+#lcolonq-gc-relentless {
+ grid-area: 2 / 1 / 2 / 4;
+ text-align: justify;
+ padding-left: 1rem;
+ padding-right: 1rem;
+ text-align: center;
+}
+
+#lcolonq-gc-panels {
+ grid-area: 3 / 1 / 3 / 4;
+ margin-left: 1rem;
+ margin-right: 1rem;
+ margin-bottom: 1rem;
+ display: grid;
+ grid-auto-flow: dense;
+ grid-template-columns: repeat(auto-fit, minmax(10rem, 1fr));
+ grid-auto-rows: minmax(10rem, auto);
+ gap: 1rem;
+}
+
+.lcolonq-gc-panel {
+ border: solid black;
+ padding: 1rem;
+}
+
+.lcolonq-gc-panel h2 {
+ text-align: center;
+}
+
+.lcolonq-gc-now {
+ font-weight: bold;
+ color: red;
+}
diff --git a/src/Main.purs b/src/Main.purs
index c4b4fa5..6fff10b 100644
--- a/src/Main.purs
+++ b/src/Main.purs
@@ -2,279 +2,28 @@ module Main where
import Prelude
-import Audio as Audio
-import Auth (AuthInfo, authHeader, getToken, startTwitchAuth, clearSessionCookie, getQueryRedirect, getResponseRedirect)
import Config as Config
-import Data.String as String
-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 Data.HTTP.Method (Method(..))
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.HTMLInputElement as HTML.Input
-import Web.HTML.Window as HTML.Win
-import Web.XHR.FormData as FD
-
-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
-
-getValue :: forall m. MonadEffect m => DOM.Element -> m String
-getValue e = case HTML.Input.fromElement e of
- Just inp -> liftEffect $ HTML.Input.value inp
- Nothing -> liftEffect $ throw "element is not an input"
-
-addClass :: forall m. MonadEffect m => String -> DOM.Element -> m Unit
-addClass c e = do
- cl <- liftEffect $ DOM.El.classList e
- _ <- liftEffect $ DOM.DTL.add cl c
- pure unit
-
-removeClass :: forall m. MonadEffect m => String -> DOM.Element -> m Unit
-removeClass c e = do
- cl <- liftEffect $ DOM.El.classList e
- _ <- liftEffect $ DOM.DTL.remove cl c
- pure unit
-
-toggleClass :: forall m. MonadEffect m => String -> DOM.Element -> m Unit
-toggleClass c e = do
- cl <- liftEffect $ DOM.El.classList e
- _ <- liftEffect $ DOM.DTL.toggle cl c
- pure unit
-
-updateSubtitle :: Aff Unit
-updateSubtitle = do
- subtitle <- byId "lcolonq-pubnix-index-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
-
-mainApi :: Effect Unit
-mainApi = launchAff_ do
- pure unit
-
-mainPubnix :: Effect Unit
-mainPubnix = launchAff_ do
- liftEffect $ log "hi"
- startModel
- marq <- byId "lcolonq-pubnix-index-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-pubnix-index-subtitle"
- listen subtitle "click" \_ev -> do
- -- startTwitchAuth
- launchAff_ updateSubtitle
-
- for_ (Array.range 0 6) \i -> do
- letter <- byId $ "lcolonq-pubnix-index-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
-
-buttonPress :: String -> Aff Unit
-buttonPress b = do
- void $ fetch (Config.apiServer <> "/sentiment/" <> b)
- { method: POST
- }
-mainButton :: Effect Unit
-mainButton = launchAff_ do
- liftEffect $ log "hello from button"
- green <- byId "lcolonq-button-link-green"
- listen green "click" \_ev -> do
- liftEffect $ log "+2"
- launchAff_ $ buttonPress "green"
- red <- byId "lcolonq-button-link-red"
- listen red "click" \_ev -> do
- liftEffect $ log "-2"
- launchAff_ $ buttonPress "red"
-
-mainRegister :: Effect Unit
-mainRegister = launchAff_ do
- liftEffect $ log "hello from registration page"
- link <- byId "lcolonq-register-link"
- getToken >>= case _ of
- Just a@(Tuple t n) -> do -- if there's an auth token in the fragment, ask the API to register us
- { text: resp } <- fetch (Config.apiServer <> "/register")
- { headers:
- { "Authorization": authHeader a
- }
- }
- r <- resp
- case String.split (String.Pattern " ") r of
- [user, pass] -> do
- container <- byId "lcolonq-registered-container"
- removeClass "lcolonq-invisible" container
- fieldUsername <- byId "lcolonq-registered-username"
- setText fieldUsername user
- fieldPassword <- byId "lcolonq-registered-password"
- setText fieldPassword pass
- _ -> do
- container <- byId "lcolonq-register-error-container"
- removeClass "lcolonq-invisible" container
- _ -> do -- otherwise, show the button to register
- container <- byId "lcolonq-register-container"
- removeClass "lcolonq-invisible" container
- listen link "click" \_ev -> do
- liftEffect $ log "register"
- startTwitchAuth
-
-mainMenu :: Effect Unit
-mainMenu = launchAff_ do
- liftEffect $ log "hello from menu"
- textareas <- queryAll "textarea"
- for_ textareas \ta -> listen ta "click" Ev.stopPropagation
- boxes <- queryAll ".lcolonq-menu-box"
- for_ boxes \box -> do
- listen box "click" \_ev -> do
- UI.submitRedeem box
-
-mainAuth :: Effect Unit
-mainAuth = launchAff_ do
- liftEffect $ log "hello from auth"
- container <- byId "lcolonq-auth-login"
- removeClass "lcolonq-invisible" container
- form <- byId "lcolonq-auth-form"
- listen form "submit" \ev -> launchAff_ do
- liftEffect $ Ev.preventDefault ev
- usernameInp <- byId "lcolonq-auth-username"
- passwordInp <- byId "lcolonq-auth-password"
- username <- getValue usernameInp
- password <- getValue passwordInp
- rd <- getQueryRedirect
- { json: resp } <- fetch "/api/firstfactor"
- { method: POST
- , headers: { "Content-Type": "application/json" }
- , body: UI.toJSON
- { username
- , password
- , targetURL: case rd of
- Just r -> r
- Nothing -> "https://secure.colonq.computer"
- }
- }
- res <- resp
- getResponseRedirect res >>= case _ of
- Nothing -> do
- err <- byId "lcolonq-auth-error"
- removeClass "lcolonq-invisible" err
- Just r -> UI.redirect r
+import Main.API as API
+import Main.Auth as Auth
+import Main.Button as Button
+import Main.Extension as Extension
+import Main.Greencircle as Greencircle
+import Main.Menu as Menu
+import Main.OBS as OBS
+import Main.Pubnix as Pubnix
+import Main.Register as Register
main :: Effect Unit
main = case Config.mode of
- "api" -> mainApi
- "pubnix" -> mainPubnix
- "extension" -> mainExtension
- "obs" -> mainObs
- "button" -> mainButton
- "register" -> mainRegister
- "menu" -> mainMenu
- "auth" -> mainAuth
+ "api" -> API.main
+ "pubnix" -> Pubnix.main
+ "extension" -> Extension.main
+ "obs" -> OBS.main
+ "button" -> Button.main
+ "register" -> Register.main
+ "menu" -> Menu.main
+ "auth" -> Auth.main
+ "greencircle" -> Greencircle.main
_ -> throw $ "unknown mode: " <> Config.mode
diff --git a/src/Main/API.purs b/src/Main/API.purs
new file mode 100644
index 0000000..f47c7d6
--- /dev/null
+++ b/src/Main/API.purs
@@ -0,0 +1,10 @@
+module Main.API where
+
+import Control.Monad (pure)
+import Data.Unit (Unit, unit)
+import Effect (Effect)
+import Effect.Aff (launchAff_)
+
+main :: Effect Unit
+main = launchAff_ do
+ pure unit
diff --git a/src/Main/Auth.purs b/src/Main/Auth.purs
new file mode 100644
index 0000000..04fe6e1
--- /dev/null
+++ b/src/Main/Auth.purs
@@ -0,0 +1,46 @@
+module Main.Auth where
+
+import Prelude
+
+import Auth (getQueryRedirect, getResponseRedirect)
+import Data.HTTP.Method (Method(..))
+import Data.Maybe (Maybe(..))
+import Effect (Effect)
+import Effect.Aff (launchAff_)
+import Effect.Class (liftEffect)
+import Effect.Console (log)
+import Fetch (fetch)
+import UI as UI
+import Utils (byId, getValue, listen, removeClass)
+import Web.Event.Event as Ev
+
+main :: Effect Unit
+main = launchAff_ do
+ liftEffect $ log "hello from auth"
+ container <- byId "lcolonq-auth-login"
+ removeClass "lcolonq-invisible" container
+ form <- byId "lcolonq-auth-form"
+ listen form "submit" \ev -> launchAff_ do
+ liftEffect $ Ev.preventDefault ev
+ usernameInp <- byId "lcolonq-auth-username"
+ passwordInp <- byId "lcolonq-auth-password"
+ username <- getValue usernameInp
+ password <- getValue passwordInp
+ rd <- getQueryRedirect
+ { json: resp } <- fetch "/api/firstfactor"
+ { method: POST
+ , headers: { "Content-Type": "application/json" }
+ , body: UI.toJSON
+ { username
+ , password
+ , targetURL: case rd of
+ Just r -> r
+ Nothing -> "https://secure.colonq.computer"
+ }
+ }
+ res <- resp
+ getResponseRedirect res >>= case _ of
+ Nothing -> do
+ err <- byId "lcolonq-auth-error"
+ removeClass "lcolonq-invisible" err
+ Just r -> UI.redirect r
diff --git a/src/Main/Button.purs b/src/Main/Button.purs
new file mode 100644
index 0000000..e05a0d8
--- /dev/null
+++ b/src/Main/Button.purs
@@ -0,0 +1,29 @@
+module Main.Button where
+
+import Prelude
+
+import Config as Config
+import Data.HTTP.Method (Method(..))
+import Effect (Effect)
+import Effect.Aff (Aff, launchAff_)
+import Effect.Class (liftEffect)
+import Effect.Console (log)
+import Fetch (fetch)
+import Utils (byId, listen)
+
+buttonPress :: String -> Aff Unit
+buttonPress b = do
+ void $ fetch (Config.apiServer <> "/sentiment/" <> b)
+ { method: POST
+ }
+main :: Effect Unit
+main = launchAff_ do
+ liftEffect $ log "hello from button"
+ green <- byId "lcolonq-button-link-green"
+ listen green "click" \_ev -> do
+ liftEffect $ log "+2"
+ launchAff_ $ buttonPress "green"
+ red <- byId "lcolonq-button-link-red"
+ listen red "click" \_ev -> do
+ liftEffect $ log "-2"
+ launchAff_ $ buttonPress "red"
diff --git a/src/Main/Extension.purs b/src/Main/Extension.purs
new file mode 100644
index 0000000..7a3bfd5
--- /dev/null
+++ b/src/Main/Extension.purs
@@ -0,0 +1,19 @@
+module Main.Extension where
+
+import Prelude
+
+import Effect (Effect)
+import Effect.Aff (launchAff_)
+import Effect.Class (liftEffect)
+import Effect.Console (log)
+import UI as UI
+import Utils (appendElement, appendText, create, query)
+
+main :: Effect Unit
+main = 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
diff --git a/src/Main/Greencircle.purs b/src/Main/Greencircle.purs
new file mode 100644
index 0000000..17f3e0c
--- /dev/null
+++ b/src/Main/Greencircle.purs
@@ -0,0 +1,11 @@
+module Main.Greencircle where
+
+import Prelude
+
+import Effect (Effect)
+import Effect.Class (liftEffect)
+import Effect.Console (log)
+
+main :: Effect Unit
+main = do
+ liftEffect $ log "hello it is greencircle"
diff --git a/src/Main/Menu.purs b/src/Main/Menu.purs
new file mode 100644
index 0000000..58364b6
--- /dev/null
+++ b/src/Main/Menu.purs
@@ -0,0 +1,22 @@
+module Main.Menu where
+
+import Prelude
+
+import Data.Foldable (for_)
+import Effect (Effect)
+import Effect.Aff (launchAff_)
+import Effect.Class (liftEffect)
+import Effect.Console (log)
+import UI as UI
+import Utils (listen, queryAll)
+import Web.Event.Event as Ev
+
+main :: Effect Unit
+main = launchAff_ do
+ liftEffect $ log "hello from menu"
+ textareas <- queryAll "textarea"
+ for_ textareas \ta -> listen ta "click" Ev.stopPropagation
+ boxes <- queryAll ".lcolonq-menu-box"
+ for_ boxes \box -> do
+ listen box "click" \_ev -> do
+ UI.submitRedeem box
diff --git a/src/Main/OBS.purs b/src/Main/OBS.purs
new file mode 100644
index 0000000..4cd679f
--- /dev/null
+++ b/src/Main/OBS.purs
@@ -0,0 +1,11 @@
+module Main.OBS where
+
+import Prelude
+
+import Effect (Effect)
+import Effect.Aff (launchAff_)
+import Model (startModel)
+
+main :: Effect Unit
+main = launchAff_ do
+ startModel
diff --git a/src/Main/Pubnix.purs b/src/Main/Pubnix.purs
new file mode 100644
index 0000000..6d0fb1a
--- /dev/null
+++ b/src/Main/Pubnix.purs
@@ -0,0 +1,52 @@
+module Main.Pubnix where
+
+import Prelude
+
+import Audio as Audio
+import Auth (getToken)
+import Config as Config
+import Data.Array as Array
+import Data.Foldable (for_)
+import Data.Maybe (Maybe(..))
+import Data.Tuple (Tuple(..))
+import Effect (Effect)
+import Effect.Aff (Aff, launchAff_)
+import Effect.Class (liftEffect)
+import Effect.Console (log)
+import Fetch (fetch)
+import Model (startModel)
+import Utils (byId, checkAuth, listen, setText)
+
+updateSubtitle :: Aff Unit
+updateSubtitle = do
+ subtitle <- byId "lcolonq-pubnix-index-subtitle"
+ { text: catchphrase } <- fetch (Config.apiServer <> "/catchphrase") {}
+ catchphrase >>= setText subtitle
+
+main :: Effect Unit
+main = launchAff_ do
+ liftEffect $ log "hi"
+ startModel
+ marq <- byId "lcolonq-pubnix-index-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-pubnix-index-subtitle"
+ listen subtitle "click" \_ev -> do
+ -- startTwitchAuth
+ launchAff_ updateSubtitle
+
+ for_ (Array.range 0 6) \i -> do
+ letter <- byId $ "lcolonq-pubnix-index-letter-" <> show i
+ listen letter "click" \_ev -> do
+ Audio.playVoice true i
+ listen letter "mouseover" \_ev -> do
+ Audio.playVoice false i
diff --git a/src/Main/Register.purs b/src/Main/Register.purs
new file mode 100644
index 0000000..3741107
--- /dev/null
+++ b/src/Main/Register.purs
@@ -0,0 +1,45 @@
+module Main.Register where
+
+import Prelude
+
+import Auth (authHeader, getToken, startTwitchAuth)
+import Config as Config
+import Data.Maybe (Maybe(..))
+import Data.String as String
+import Data.Tuple (Tuple(..))
+import Effect (Effect)
+import Effect.Aff (launchAff_)
+import Effect.Class (liftEffect)
+import Effect.Console (log)
+import Fetch (fetch)
+import Utils (byId, listen, removeClass, setText)
+
+main :: Effect Unit
+main = launchAff_ do
+ liftEffect $ log "hello from registration page"
+ link <- byId "lcolonq-register-link"
+ getToken >>= case _ of
+ Just a@(Tuple _t _n) -> do -- if there's an auth token in the fragment, ask the API to register us
+ { text: resp } <- fetch (Config.apiServer <> "/register")
+ { headers:
+ { "Authorization": authHeader a
+ }
+ }
+ r <- resp
+ case String.split (String.Pattern " ") r of
+ [user, pass] -> do
+ container <- byId "lcolonq-registered-container"
+ removeClass "lcolonq-invisible" container
+ fieldUsername <- byId "lcolonq-registered-username"
+ setText fieldUsername user
+ fieldPassword <- byId "lcolonq-registered-password"
+ setText fieldPassword pass
+ _ -> do
+ container <- byId "lcolonq-register-error-container"
+ removeClass "lcolonq-invisible" container
+ _ -> do -- otherwise, show the button to register
+ container <- byId "lcolonq-register-container"
+ removeClass "lcolonq-invisible" container
+ listen link "click" \_ev -> do
+ liftEffect $ log "register"
+ startTwitchAuth
diff --git a/src/Utils.purs b/src/Utils.purs
new file mode 100644
index 0000000..4755436
--- /dev/null
+++ b/src/Utils.purs
@@ -0,0 +1,118 @@
+module Utils where
+
+import Prelude
+
+import Auth (AuthInfo, authHeader)
+import Config as Config
+import Data.Array (head)
+import Data.Foldable (fold, for_)
+import Data.Maybe (Maybe(..))
+import Effect (Effect)
+import Effect.Aff (Aff)
+import Effect.Class (class MonadEffect, liftEffect)
+import Effect.Exception (throw)
+import Fetch (fetch)
+import Web.DOM as DOM
+import Web.DOM.DOMTokenList as DOM.DTL
+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.HTMLInputElement as HTML.Input
+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
+
+getValue :: forall m. MonadEffect m => DOM.Element -> m String
+getValue e = case HTML.Input.fromElement e of
+ Just inp -> liftEffect $ HTML.Input.value inp
+ Nothing -> liftEffect $ throw "element is not an input"
+
+addClass :: forall m. MonadEffect m => String -> DOM.Element -> m Unit
+addClass c e = do
+ cl <- liftEffect $ DOM.El.classList e
+ _ <- liftEffect $ DOM.DTL.add cl c
+ pure unit
+
+removeClass :: forall m. MonadEffect m => String -> DOM.Element -> m Unit
+removeClass c e = do
+ cl <- liftEffect $ DOM.El.classList e
+ _ <- liftEffect $ DOM.DTL.remove cl c
+ pure unit
+
+toggleClass :: forall m. MonadEffect m => String -> DOM.Element -> m Unit
+toggleClass c e = do
+ cl <- liftEffect $ DOM.El.classList e
+ _ <- liftEffect $ DOM.DTL.toggle cl c
+ pure unit
+
+checkAuth :: AuthInfo -> Aff String
+checkAuth auth = do
+ { text: resp } <-
+ fetch (Config.apiServer <> "/check")
+ { headers:
+ { "Authorization": authHeader auth
+ }
+ }
+ resp
diff --git a/templates/greencircle/index.html b/templates/greencircle/index.html
new file mode 100644
index 0000000..0e02871
--- /dev/null
+++ b/templates/greencircle/index.html
@@ -0,0 +1,83 @@
+<!DOCTYPE html>
+<html lang="en">
+ <head>
+ <meta http-equiv="Content-Type" content="text/html; charset=utf-8"/>
+ <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=no">
+ <title>"greencircle"</title>
+ <link rel="icon" href="./assets/mrgreen.png">
+ <link rel="stylesheet" type="text/css" href="./main.css">
+ <script type="module">
+CONFIG_SUBST
+ globalThis.mode = "greencircle";
+ </script>
+ <script type="module" src="./main.js"></script>
+ </head>
+ <body id="lcolonq-gc-body">
+ <div id="lcolonq-gc-hero">
+ <div id="lcolonq-gc-center">
+ <div id="lcolonq-gc-spin">
+ <img id="lcolonq-gc-logo" src="./assets/mrgreen.png">
+ <svg id="lcolonq-gc-spin-image" viewBox="0 0 400 400">
+ <defs>
+ <path id="rotate"
+ d="M 200, 200
+ m -100, 0
+ a 100,100 0 1,1 200,0
+ a 100,100 0 1,1 -200,0
+ " />
+ </defs>
+ <text>
+ <textPath xlink:href="#rotate">
+ "greencircle" unlimited energy industrial-strength zone
+ </textPath>
+ </text>
+ </svg>
+ </div>
+ </div>
+ </div>
+ <div id="lcolonq-gc-rest">
+ <div id="lcolonq-gc-explainer">
+ <h1>welcome "greencircle"</h1>
+ <p>
+ "greencircle" (henceforth G.C.) is an integrated platform for strategic research and development.
+ At "greencircle" we search for a disruptive business model that repeatedly and scalably achieves product-market fit.
+ We're tastemakers, embracing creative play-at-work in order to avoid stagnation.
+ "greencircle" enables lateral movement out of the traditional linear system and into nonlinear futures.
+ Our team is all pinch hitters, elite ninjas and commandos ready for action.
+ "greencircle" is always evolving towards the next iteration, ensuring we are ready (and willing) for the transition to the information age.
+ "greencircle" is antifragile.
+ "greencircle" is next up.
+ Members of "greencircle" utilize sophisticated feedback loops to growth hack your life.
+ "greencircle" isn't afraid to speak up, and always has your back.
+ We work hard, but we also like to play hard.
+ "greencircle" is an intergalactic space opera.
+ "greencircle" is Web 4.0 - the next one.
+ We never flinch, even if our opponents are serene grace jirachi kings rock iron head spammers.
+ Yeah I know the king's rock doesn't do anything you dork I love you.
+ </p>
+ </div>
+ <div id="lcolonq-gc-relentless">
+ <h1>"greencircle" is relentless</h1>
+ </div>
+ <div id="lcolonq-gc-panels">
+ <div class="lcolonq-gc-panel" id="lcolonq-gc-panel-lcolonq">
+ <h2>LCOLONQ</h2>
+ little ffreak. online <span class="lcolonq-gc-now">now</span>.
+ </div>
+ <div class="lcolonq-gc-panel" id="lcolonq-gc-panel-prodzpod">
+ <h2>prodzpod</h2>
+ cool guy (they). creatureform. gizmo development and game development also. inconceivably powerful.
+ also they're live <span class="lcolonq-gc-now">right now</span> btw you should go say hi.
+ </div>
+ <div class="lcolonq-gc-panel" id="lcolonq-gc-panel-tyumici">
+ <h2>Tyumici</h2>
+ programming, art, music, tinkering.
+ sometimes a little bit of gaming, too.
+ a fine fellow. we love tyumici.
+ if you were wondering, they're streaming <span class="lcolonq-gc-now">now</span>.
+ you are encouraged to investigate this.
+ </div>
+ </div>
+ </div>
+ </body>
+</html>
generated by cgit v1.2.3 (git 2.25.1) at 2026-05-09 09:45:12 +0000