Elm Reactor Websockets

core.js

        function initSocket() {
            createdSocket = true;
            // "/todo.html" => "todo.elm"
            moduleFile = moduleFile || window.location.pathname.substr(1).split(".")[0] + ".elm";
            var socketLocation = "ws://" + window.location.host + "/socket?file=" + moduleFile;
            var serverConnection = new WebSocket(socketLocation);
            serverConnection.onmessage = function(event) {
                console.log("WEBSOCKET:::::");
                console.log(event.data);
                if (elmPermitHotswaps && debuggerHandle.ports) {
                    console.log("PERMIT HOTSWAPS?!");
                    hotSwap(event.data);
                }
            };
            window.addEventListener("unload", function() {
                console.log("CLOSING WEBSOCKET!!!!!!!");
                serverConnection.close();
            });
        }

Socket.hs

{-# LANGUAGE OverloadedStrings #-}
module Socket where

import Control.Monad.Trans (MonadIO(liftIO))
import Control.Monad (forever)
import Control.Concurrent (threadDelay, forkIO)
import Control.Exception (catch, SomeException)
import qualified Data.ByteString.Char8 as BSC
import qualified Filesystem.Path.CurrentOS as FP
import qualified Network.WebSockets as WS
import qualified Network.WebSockets.Snap as WSS
import qualified System.FSNotify.Devel as NDevel
import qualified System.FSNotify as Notify
import System.FilePath
import System.Process

import qualified Generate

fileChangeApp :: FilePath -> WS.ServerApp
fileChangeApp watchedFile pendingConnection =
  do connection <- WS.acceptRequest pendingConnection
     _ <- forkIO $ keepAlive connection
     notifyManager <- liftIO $ Notify.startManager
     updateOnChange watchedFile connection notifyManager
     Notify.stopManager notifyManager

keepAlive :: WS.Connection -> IO ()
keepAlive connection =
  catch alive handler
  where
    alive =
      do Prelude.putStrLn "sending a ping..."
         WS.sendPing connection $ BSC.pack "ping"
         WS.receive connection >>= print
         Prelude.putStrLn "sent a ping..."
         threadDelay $ 10 * (1000000) -- 10 seconds

         keepAlive connection
    handler :: SomeException -> IO ()
    handler e = Prelude.putStrLn "SHIT" >> return ()

updateOnChange ::  FilePath -> WS.Connection -> Notify.WatchManager -> IO ()
updateOnChange watchedFile connection manager =
  do Prelude.putStrLn "updatingOnChange..."
     _ <- NDevel.treeExtExists manager "." "elm" (sendHotSwap watchedFile connection)
     Prelude.putStrLn "...updated!"
     forever $ threadDelay 10000000 -- related to https://ghc.haskell.org/trac/ghc/ticket/5544

sendHotSwap :: FilePath -> WS.Connection -> FP.FilePath -> IO ()
sendHotSwap watchedFile connection _ =
    do Prelude.putStrLn "sending hot swap..."
       result <- liftIO $ Generate.js watchedFile
       Prelude.putStrLn "sending text data..."
       WS.sendTextData connection $ BSC.pack result
       Prelude.putStrLn "...sent text data!"

WebSocketTest.elm

import WebSocket as WS

inputs = constant ""

socket = WS.connect "ws://127.0.0.1" inputs

tests = count socket

main = (\a b-> asText a `above` asText b) <~ socket ~ tests

WebSocketTest.hs

import qualified Network.WebSockets as WS
import Control.Monad (forever)
import Control.Concurrent (threadDelay, forkIO)
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as BSC

application :: WS.ServerApp
application pendingConnection = do
	connection <- WS.acceptRequest pendingConnection
	forever $ do
		WS.sendPing connection $ BSC.pack "ping"
		WS.receive connection >>= print
		WS.sendTextData connection (T.pack "testing...")
		threadDelay $ 10 * 1000000

main = WS.runServer "127.0.0.1" 80 application