Sockets.hs

-- {-# LANGUAGE LambdaCase #-}
-- {-# LANGUAGE QuasiQuotes #-}

module Effectful.Sockets where


-- import Control.Monad (forever)
-- import Data.Aeson (ToJSON)
-- import Data.Aeson qualified as A
-- import Data.ByteString.Lazy qualified as BL
-- import Data.String.Interpolate (i)
-- import Data.Text (Text)
-- import Effectful
-- import Effectful.Dispatch.Dynamic
-- import Effectful.State.Static.Local
-- import Network.WebSockets (Connection, ConnectionOptions, ServerApp, WebSocketsData)
-- import Network.WebSockets qualified as WS
--
-- data Command
--   = Render [Content]
--   | Test Text
--
-- data Socket :: Effect where
--   SendMessage :: BL.ByteString -> Socket m ()
--   ReceiveData :: (WebSocketsData a) => Socket m a
--
-- type instance DispatchOf Socket = 'Dynamic
--
-- -- we should assume a connection here?
-- -- Accept :: PendingConnection -> Sockets m Connection
--
-- data Client = Client
--   { counter :: Int
--   , contents :: [Content]
--   }
--
-- type instance DispatchOf Socket = 'Dynamic
--
-- connectionOptions :: ConnectionOptions
-- connectionOptions = WS.defaultConnectionOptions
--
-- socketApplication :: Eff [Socket, IOE] () -> ServerApp
-- socketApplication talk pending = do
--   conn <- WS.acceptRequest pending
--   -- WS.sendTextData conn ("HELLO CLIENT" :: Text)
--   let client = Client 0 []
--   runEff . runSocket conn client $ forever talk
--
-- runSocket
--   :: (IOE :> es)
--   => Connection
--   -> Client
--   -> Eff (Socket : es) a
--   -> Eff es a
-- runSocket conn client = reinterpret (evalState client) $ \_ -> \case
--   SendMessage t -> do
--     -- cl :: Client <- get
--     liftIO $ WS.sendTextData conn t
--   ReceiveData -> do
--     a <- liftIO $ WS.receiveData conn
--     modify $ \c -> c{counter = c.counter + 1}
--     pure a
--
-- sendCommand :: (Socket :> es) => Command -> Eff es ()
-- sendCommand (Render cnt) = send $ SendMessage (formatMessage "Render" cnt)
-- sendCommand (Test cnt) = send $ SendMessage (formatMessage "Test" cnt)
--
-- receiveData :: (Socket :> es, WebSocketsData a) => Eff es a
-- receiveData = send ReceiveData
--
-- formatMessage :: (ToJSON a) => BL.ByteString -> a -> BL.ByteString
-- formatMessage flag cnt =
--   let content = A.encode cnt
--    in [i|#{flag} #{content}|]