jsaddle-warp-0.9.8.3: tests/Spec.hs

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Concurrent
import Control.Exception (bracket)
import Control.Monad (forever, unless, void)
import Control.Monad.IO.Class (MonadIO(..))
import qualified Data.ByteString.Lazy.Char8 as BS

import Language.Javascript.JSaddle (askJSM)
import Language.Javascript.JSaddleSpec (spec)
import Language.Javascript.JSaddle.WebSockets (jsaddleJs', jsaddleAppWithJs, jsaddleOr)

import Network.Wai.Handler.Warp
       (defaultSettings, setTimeout, setPort, runSettings)
import Network.WebSockets (defaultConnectionOptions)

import System.Directory (doesDirectoryExist)
import System.Exit (exitWith, ExitCode(..))
import System.Process (withCreateProcess, proc, system)

import Test.Hspec (hspec, aroundAll)

main :: IO ()
main = do
  nodeClientPath <- setupNodeClient
  context <- newEmptyMVar
  let
    f = do
      _ <- liftIO $ tryTakeMVar context
      liftIO . putMVar context =<< askJSM
      liftIO . forever $ threadDelay maxBound

    port = 13709
    uri = BS.pack $ "http://0.0.0.0:" <> show port
    jsaddleApp = jsaddleAppWithJs (jsaddleJs' (Just uri) False)

  void $ forkIO $ runSettings (setPort port (setTimeout 3600 defaultSettings)) =<<
      jsaddleOr defaultConnectionOptions f jsaddleApp

  withCreateProcess (proc "node" [nodeClientPath, show port]) $ \_ _ _ _ -> do
    hspec $ aroundAll (bracket (takeMVar context) (putMVar context)) spec


setupNodeClient :: IO (FilePath)
setupNodeClient = do
  system "node --version" >>= \case
    ExitSuccess -> return ()
    e           -> do
      putStrLn "'node' not found"
      exitWith e

  -- The 'cabal test' could be running from root of jsaddle repo, so adjust the path
  ncExist <- doesDirectoryExist "node-client"
  jwExist <- doesDirectoryExist "jsaddle-warp/node-client"
  unless (ncExist || jwExist) $ do
    putStrLn "node-client directory not found"
    exitWith (ExitFailure 1)

  let nodeClientDir = if ncExist then "node-client" else "jsaddle-warp/node-client"

  nmExist <- doesDirectoryExist (nodeClientDir <> "/node_modules")
  unless nmExist $ do
    system "npm --version" >>= \case
      ExitSuccess -> return ()
      e           -> do
        putStrLn "'npm' not found"
        exitWith e

    system ("npm install --prefix " <> nodeClientDir) >>= \case
      ExitSuccess -> return ()
      e           -> do
        putStrLn "'npm install' did not succeed"
        exitWith e
  return nodeClientDir