summaryrefslogtreecommitdiff
path: root/fig-bus/src/Fig/Bus.hs
diff options
context:
space:
mode:
Diffstat (limited to 'fig-bus/src/Fig/Bus.hs')
-rw-r--r--fig-bus/src/Fig/Bus.hs62
1 files changed, 0 insertions, 62 deletions
diff --git a/fig-bus/src/Fig/Bus.hs b/fig-bus/src/Fig/Bus.hs
deleted file mode 100644
index 2102864..0000000
--- a/fig-bus/src/Fig/Bus.hs
+++ /dev/null
@@ -1,62 +0,0 @@
-module Fig.Bus (main) where
-
-import Fig.Prelude
-
-import Control.Concurrent.MVar as MVar
-
-import qualified Data.List as List
-import Data.ByteString (hPut, hGetLine)
-import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as Map
-import qualified Data.IORef as IORef
-
-import Fig.Utils.SExpr
-import Fig.Utils.Net
-
-newtype BusState = BusState
- { subscriptions :: Map SExpr [Handle]
- }
-
-subscribe :: SExpr -> Handle -> BusState -> BusState
-subscribe ev h bs = bs
- { subscriptions = Map.insertWith (<>) ev [h] bs.subscriptions
- }
-
-unsubscribe :: SExpr -> Handle -> BusState -> BusState
-unsubscribe ev h bs = bs
- { subscriptions = Map.update (Just . List.delete h) ev bs.subscriptions
- }
-
-publish :: SExpr -> [SExpr] -> BusState -> IO ()
-publish ev d bs =
- case Map.lookup ev bs.subscriptions of
- Nothing -> pure ()
- Just hs -> forM_ hs \h -> do
- hPut h . encodeUtf8 $ pretty (SExprList $ ev:d) <> "\n"
-
-main :: (Maybe Text, Text) -> IO ()
-main bind = do
- st <- MVar.newMVar $ BusState { subscriptions = Map.empty }
- server bind do
- subs <- IORef.newIORef ([] :: [SExpr])
- pure \h peer ->
- ( do
- forever do
- line <- throwLeft id . decodeUtf8' =<< hGetLine h
- case parseSExpr line of
- Just (SExprList (SExprSymbol "ping":_)) -> do
- log $ tshow peer <> " pinged"
- hPut h . encodeUtf8 $ "(pong)\n"
- Just (SExprList [SExprSymbol "sub", ev]) -> do
- log $ tshow peer <> " subscribing to: " <> pretty ev
- IORef.modifyIORef' subs (ev:)
- MVar.modifyMVar_ st (pure . subscribe ev h)
- Just (SExprList (SExprSymbol "pub":ev:d)) -> do
- log $ tshow peer <> " publishing " <> pretty (SExprList d) <> " to: " <> pretty ev
- publish ev d =<< MVar.readMVar st
- Just x -> log $ tshow peer <> " sent invalid command: " <> pretty x
- Nothing -> log $ tshow peer <> " sent malformed s-expression: " <> line
- , do
- ss <- IORef.readIORef subs
- MVar.modifyMVar_ st \bs -> pure $ foldr (`unsubscribe` h) bs ss
- )