From 1f2e453d0c9f8412b9032cb4e655713ecdcf1fa3 Mon Sep 17 00:00:00 2001 From: LLLL Colonq Date: Mon, 26 May 2025 04:43:38 -0400 Subject: web: Refactor major style --- fig-web/src/Fig/Web/Module/Gizmo.hs | 49 +++++++++++++++++++++++++++++++++++++ 1 file changed, 49 insertions(+) create mode 100644 fig-web/src/Fig/Web/Module/Gizmo.hs (limited to 'fig-web/src/Fig/Web/Module/Gizmo.hs') diff --git a/fig-web/src/Fig/Web/Module/Gizmo.hs b/fig-web/src/Fig/Web/Module/Gizmo.hs new file mode 100644 index 0000000..8112670 --- /dev/null +++ b/fig-web/src/Fig/Web/Module/Gizmo.hs @@ -0,0 +1,49 @@ +module Fig.Web.Module.Gizmo + ( public + , publicWebsockets + , publicBusEvents + ) where + +import Fig.Prelude + +import qualified Control.Concurrent.Chan as Chan + +import qualified Data.Text as Text + +import qualified Network.WebSockets as WS + +import Fig.Web.Utils +import Fig.Web.Types +import qualified Fig.Web.DB as DB + +public :: Module +public a = do + onGet "/api/gizmo" do + buf <- queryParam "buf" + DB.hget a.db "gizmos" buf >>= \case + Nothing -> do + status status404 + respondText "gizmo does not exist" + Just html -> respondHTML $ decodeUtf8 html + onGet "/api/gizmo/list" do + gizmos <- maybe [] (fmap decodeUtf8) <$> DB.hkeys a.db "gizmos" + respondText $ Text.unlines gizmos + +publicWebsockets :: Websockets +publicWebsockets a = + [ ( "/api/gizmo/events", \conn -> do + c <- Chan.dupChan a.channels.gizmo + forever do + ev <- liftIO $ Chan.readChan c + WS.sendTextData conn ev + ) + ] + +publicBusEvents :: BusEvents +publicBusEvents a = + [ ("gizmo buffer update", \d -> do + let dstr = decodeUtf8 d + let updates = Text.splitOn " " dstr + forM_ updates $ Chan.writeChan a.channels.gizmo + ) + ] -- cgit v1.2.3