diff --git a/src/EuphApi.hs b/src/EuphApi.hs index 01c0ae3..bbb03b0 100644 --- a/src/EuphApi.hs +++ b/src/EuphApi.hs @@ -1,5 +1,7 @@ module EuphApi ( module EuphApi.Types + , module EuphApi.Threads ) where import EuphApi.Types +import EuphApi.Threads diff --git a/src/EuphApi/Controller.hs b/src/EuphApi/Controller.hs deleted file mode 100644 index 7aebb67..0000000 --- a/src/EuphApi/Controller.hs +++ /dev/null @@ -1 +0,0 @@ -module EuphApi.Controller where diff --git a/src/EuphApi/Threads.hs b/src/EuphApi/Threads.hs index 46ce9e5..4071290 100644 --- a/src/EuphApi/Threads.hs +++ b/src/EuphApi/Threads.hs @@ -9,7 +9,7 @@ module EuphApi.Threads ( -- * Connecting to euphoria Connection - , euphApp + , startEuphConnection , getEvent -- * API functions , disconnect @@ -38,6 +38,7 @@ import qualified Data.Text as T import Data.Time import Data.Time.Clock.POSIX import qualified Network.WebSockets as WS +import qualified Wuss as WSS import qualified EuphApi.Types as E @@ -63,15 +64,15 @@ data Connection = Connection LockedFlag SendQueue EventQueue getEvent :: Connection -> IO (Maybe Event) getEvent (Connection _ _ qEvent) = atomically $ readTBQueue qEvent --- | A 'WS.ClientApp' creating a 'Connection'. -euphApp :: WS.ClientApp Connection -euphApp con = do +startEuphConnection :: String -> String -> IO Connection +startEuphConnection host room = do sendQueue <- atomically $ newTBQueue 10 recvQueue <- atomically $ newTBQueue 10 eventQueue <- atomically $ newTBQueue 10 locked <- atomically $ newTVar False let euphCon = Connection locked sendQueue eventQueue - void $ forkIO $ recvThread euphCon recvQueue con + -- TODO: catch failed connection and send note to qEvent + void $ async $ WSS.runSecureClient host 443 ("/room/" ++ room ++ "/ws") (recvClient euphCon recvQueue) return euphCon {- @@ -228,8 +229,8 @@ cleanupRecv qRecv = do RReply _ (ReplyMVar var) -> putMVar var (Left EuphDisconnected) _ -> return () -recvThread :: Connection -> RecvQueue -> WS.Connection -> IO () -recvThread euphCon@(Connection locked qSend qEvent) qRecv con = do +recvClient :: Connection -> RecvQueue -> WS.ClientApp () +recvClient euphCon@(Connection locked qSend qEvent) qRecv con = do tFetch <- async $ fetchThread qRecv con tSend <- async $ evalStateT (sendThread euphCon qRecv con) 0 waitingReplies <- execStateT (processRecv qRecv qEvent) M.empty