module IHP.IDE.LiveReloadNotificationServer (app, notifyHaskellChange, notifyAssetChange) where

import IHP.Prelude
import qualified Network.WebSockets as Websocket
import qualified Control.Concurrent as Concurrent
import IHP.IDE.Types
import qualified Control.Exception as Exception
import qualified Data.UUID.V4 as UUID
import qualified Data.Map as Map

notifyHaskellChange :: (?context :: Context) => IO ()
notifyHaskellChange :: (?context::Context) => IO ()
notifyHaskellChange = (?context::Context) => ByteString -> IO ()
ByteString -> IO ()
broadcast ByteString
"reload"

notifyAssetChange :: (?context :: Context) => IO ()
notifyAssetChange :: (?context::Context) => IO ()
notifyAssetChange = (?context::Context) => ByteString -> IO ()
ByteString -> IO ()
broadcast ByteString
"reload_assets"

broadcast :: (?context :: Context) => ByteString -> IO ()
broadcast :: (?context::Context) => ByteString -> IO ()
broadcast ByteString
message = do
    let clients :: IORef (Map UUID Connection)
clients = ?context::Context
Context
?context.liveReloadClients
    Map UUID Connection
clients' <- IORef (Map UUID Connection) -> IO (Map UUID Connection)
forall a. IORef a -> IO a
readIORef IORef (Map UUID Connection)
clients
    
    let removeClient :: UUID -> IO ()
removeClient UUID
connectionId = IORef (Map UUID Connection)
-> (Map UUID Connection -> Map UUID Connection) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (Map UUID Connection)
clients (UUID -> Map UUID Connection -> Map UUID Connection
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete UUID
connectionId)
    let sendMessage :: (UUID, Connection) -> IO ()
sendMessage (UUID
id, Connection
connection) = ((Connection -> ByteString -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
Websocket.sendTextData Connection
connection ByteString
message) IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(SomeException
e :: SomeException) -> UUID -> IO ()
removeClient UUID
id))
    let connections :: [(UUID, Connection)]
connections = Map UUID Connection
clients' Map UUID Connection
-> (Map UUID Connection -> [(UUID, Connection)])
-> [(UUID, Connection)]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Map UUID Connection -> [(UUID, Connection)]
forall k a. Map k a -> [(k, a)]
Map.toList

    [(UUID, Connection)] -> ((UUID, Connection) -> IO ()) -> IO [()]
forall (t :: * -> *) a b.
Traversable t =>
t a -> (a -> IO b) -> IO (t b)
forConcurrently [(UUID, Connection)]
connections (UUID, Connection) -> IO ()
sendMessage
    () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

app :: (?context :: Context) => Websocket.ServerApp
app :: (?context::Context) => ServerApp
app PendingConnection
pendingConnection = do
    let clients :: IORef (Map UUID Connection)
clients = ?context::Context
Context
?context.liveReloadClients
    
    Connection
connection <- PendingConnection -> IO Connection
Websocket.acceptRequest PendingConnection
pendingConnection
    UUID
connectionId <- IO UUID
UUID.nextRandom

    IORef (Map UUID Connection)
-> (Map UUID Connection -> Map UUID Connection) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (Map UUID Connection)
clients (UUID -> Connection -> Map UUID Connection -> Map UUID Connection
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert UUID
connectionId Connection
connection)

    let removeClient :: IO ()
removeClient = IORef (Map UUID Connection)
-> (Map UUID Connection -> Map UUID Connection) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (Map UUID Connection)
clients (UUID -> Map UUID Connection -> Map UUID Connection
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete UUID
connectionId)

    let withPingThread :: IO () -> IO ()
withPingThread = Connection -> Int -> IO () -> IO () -> IO ()
forall a. Connection -> Int -> IO () -> IO a -> IO a
Websocket.withPingThread Connection
connection Int
30 (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

    let keepalive :: IO b
keepalive = IO () -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Int -> IO ()
Concurrent.threadDelay Int
forall a. Bounded a => a
maxBound)
    IO () -> IO ()
withPingThread IO ()
forall {b}. IO b
keepalive IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`Exception.finally` IO ()
removeClient