{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
--
-- Module      :  Language.Javascript.JSaddle.WebSockets
-- Copyright   :  (c) Hamish Mackenzie
-- License     :  MIT
--
-- Maintainer  :  Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>
--
-- |
--
-----------------------------------------------------------------------------

module Language.Javascript.JSaddle.Warp (
  -- * Running JSM over WebSockets
    run
#ifndef ghcjs_HOST_OS
  , module Language.Javascript.JSaddle.WebSockets
#endif
) where

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

import Language.Javascript.JSaddle.Types (JSM)
import Language.Javascript.JSaddle.Run (syncPoint)
import Language.Javascript.JSaddle.WebSockets
#endif

-- | Run the given 'JSM' action as the main entry point.  Either directly
--   in GHCJS or as a Warp server on the given port on GHC.
#ifdef ghcjs_HOST_OS
run :: Int -> IO () -> IO ()
run _port = id
#else
run :: Int -> JSM () -> IO ()
run :: Int -> JSM () -> IO ()
run Int
port JSM ()
f =
    Settings -> Application -> IO ()
runSettings (Int -> Settings -> Settings
setPort Int
port (Int -> Settings -> Settings
setTimeout Int
3600 Settings
defaultSettings)) (Application -> IO ()) -> IO Application -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
        ConnectionOptions -> JSM () -> Application -> IO Application
jsaddleOr ConnectionOptions
defaultConnectionOptions (JSM ()
f JSM () -> JSM () -> JSM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JSM ()
syncPoint) Application
jsaddleApp
#endif