module IHP.IDE.LiveReloadNotificationServer (startLiveReloadNotificationServer, notifyHaskellChange, notifyAssetChange, stopLiveReloadNotification) where

import ClassyPrelude
import qualified Network.HTTP.Types as Http
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp
import qualified Network.WebSockets as Websocket
import qualified Network.Wai.Handler.WebSockets as Websocket
import qualified Control.Concurrent as Concurrent
import IHP.IDE.Types
import IHP.HaskellSupport
import IHP.IDE.PortConfig

startLiveReloadNotificationServer :: (?context :: Context) => IO ()
startLiveReloadNotificationServer :: IO ()
startLiveReloadNotificationServer = do
    IORef [Connection]
clients <- [Connection] -> IO (IORef [Connection])
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef []

    let port :: Port
port = ?context::Context
Context
?context
            Context -> (Context -> PortConfig) -> PortConfig
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Proxy "portConfig" -> Context -> PortConfig
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "portConfig" (Proxy "portConfig")
Proxy "portConfig"
#portConfig
            PortConfig -> (PortConfig -> PortNumber) -> PortNumber
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Proxy "liveReloadNotificationPort" -> PortConfig -> PortNumber
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel
  "liveReloadNotificationPort" (Proxy "liveReloadNotificationPort")
Proxy "liveReloadNotificationPort"
#liveReloadNotificationPort
            PortNumber -> (PortNumber -> Port) -> Port
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> PortNumber -> Port
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    
    Async ()
server <- IO () -> IO (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ Port -> Application -> IO ()
Warp.run Port
port (Application -> IO ()) -> Application -> IO ()
forall a b. (a -> b) -> a -> b
$ ConnectionOptions -> ServerApp -> Application -> Application
Websocket.websocketsOr
        ConnectionOptions
Websocket.defaultConnectionOptions
        (IORef [Connection] -> ServerApp
app IORef [Connection]
clients)
        Application
httpApp

    (?context::Context) => Action -> IO ()
Action -> IO ()
dispatch (LiveReloadNotificationServerState -> Action
UpdateLiveReloadNotificationServerState (LiveReloadNotificationServerStarted :: Async () -> IORef [Connection] -> LiveReloadNotificationServerState
LiveReloadNotificationServerStarted { Async ()
$sel:server:LiveReloadNotificationServerNotStarted :: Async ()
server :: Async ()
server, IORef [Connection]
$sel:clients:LiveReloadNotificationServerNotStarted :: IORef [Connection]
clients :: IORef [Connection]
clients }))

httpApp :: Wai.Application
httpApp :: Application
httpApp request :: Request
request respond :: Response -> IO ResponseReceived
respond = Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
Wai.responseLBS Status
Http.status400 [] "Not a websocket request"

notifyHaskellChange :: LiveReloadNotificationServerState -> IO ()
notifyHaskellChange :: LiveReloadNotificationServerState -> IO ()
notifyHaskellChange = ByteString -> LiveReloadNotificationServerState -> IO ()
broadcast "reload"
notifyAssetChange :: LiveReloadNotificationServerState -> IO ()
notifyAssetChange = ByteString -> LiveReloadNotificationServerState -> IO ()
broadcast "reload_assets"

broadcast :: ByteString -> LiveReloadNotificationServerState -> IO ()
broadcast :: ByteString -> LiveReloadNotificationServerState -> IO ()
broadcast message :: ByteString
message LiveReloadNotificationServerStarted { Async ()
server :: Async ()
$sel:server:LiveReloadNotificationServerNotStarted :: LiveReloadNotificationServerState -> Async ()
server, IORef [Connection]
clients :: IORef [Connection]
$sel:clients:LiveReloadNotificationServerNotStarted :: LiveReloadNotificationServerState -> IORef [Connection]
clients } = do
    IO () -> IO (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async do
        [Connection]
clients' <- IORef [Connection] -> IO [Connection]
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef [Connection]
clients
        let sendMessage :: Connection -> IO ()
sendMessage connection :: Connection
connection = ((Connection -> ByteString -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
Websocket.sendTextData Connection
connection ByteString
message) IO () -> (SomeException -> IO ()) -> IO ()
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (\(SomeException
e :: SomeException) -> Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn (SomeException -> Text
forall a. Show a => a -> Text
tshow SomeException
e)))
        (Element [Connection] -> IO ()) -> [Connection] -> IO ()
forall mono (m :: * -> *).
(MonoFoldable mono, Applicative m) =>
(Element mono -> m ()) -> mono -> m ()
mapM_ Element [Connection] -> IO ()
Connection -> IO ()
sendMessage [Connection]
clients'
    () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
broadcast message :: ByteString
message _ = Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn "LiveReloadNotificationServer: broadcast failed as not running"

stopLiveReloadNotification :: LiveReloadNotificationServerState -> IO ()
stopLiveReloadNotification :: LiveReloadNotificationServerState -> IO ()
stopLiveReloadNotification LiveReloadNotificationServerStarted { .. } = Async () -> IO ()
forall (m :: * -> *) a. MonadIO m => Async a -> m ()
uninterruptibleCancel Async ()
server
stopLiveReloadNotification _ = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

app :: IORef [Websocket.Connection] -> Websocket.ServerApp
app :: IORef [Connection] -> ServerApp
app stateRef :: IORef [Connection]
stateRef pendingConnection :: PendingConnection
pendingConnection = do
    Connection
connection <- PendingConnection -> IO Connection
Websocket.acceptRequest PendingConnection
pendingConnection
    IORef [Connection] -> ([Connection] -> [Connection]) -> IO ()
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef IORef [Connection]
stateRef (([Connection] -> [Connection]) -> IO ())
-> ([Connection] -> [Connection]) -> IO ()
forall a b. (a -> b) -> a -> b
$ \state :: [Connection]
state -> (Connection
connection Connection -> [Connection] -> [Connection]
forall a. a -> [a] -> [a]
: [Connection]
state)
    Connection -> Port -> IO ()
Websocket.forkPingThread Connection
connection 1
    IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever do
        Connection -> Text -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
Websocket.sendTextData Connection
connection ("pong" :: Text)
        Port -> IO ()
Concurrent.threadDelay (1000000)
        () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()