src/Literate/Web/Live.hs

   1 module Literate.Web.Live where
   2
   3 import Control.Applicative (Applicative (..))
   4 import Control.Concurrent (threadDelay)
   5 import Control.Concurrent.STM (STM)
   6 import Control.Concurrent.STM qualified as STM
   7 import Control.Monad (void)
   8 import Data.ByteString.Builder qualified as BSB
   9 import Data.Function (const, ($), (&))
  10 import Data.Functor ((<&>))
  11 import Data.Map.Strict qualified as Map
  12 import Data.Maybe (Maybe (..), maybe)
  13 import Data.Text (Text)
  14 import Network.Wai qualified as Wai
  15 import Network.Wai.Handler.Warp qualified as Warp
  16 import Network.Wai.Handler.WebSockets qualified as WaiWs
  17 import Network.WebSockets qualified as WS
  18 import System.IO (IO)
  19 import System.IO qualified as Sys
  20 import Prelude (Bounded (..))
  21
  22 import Literate.Web qualified as Web
  23 import Literate.Web.Live.HTTP
  24 import Literate.Web.Live.WebSocket
  25 import Literate.Web.Types.MIME (MediaType)
  26
  27 runLive ::
  28   Maybe () ->
  29   Warp.HostPreference ->
  30   Maybe Warp.Port ->
  31   STM model ->
  32   (model -> IO (Map.Map Web.OutputPath (MediaType, IO BSB.Builder))) ->
  33   IO ()
  34 runLive mWsOpts host portMaybe modelSTM siteMapBSB = do
  35   iniModel <- STM.atomically modelSTM
  36   let
  37     siteMap model = siteMapBSB model <&> (<&> (<&> (<&> BSB.toLazyByteString)))
  38     settings = Warp.defaultSettings & Warp.setHost host
  39     app = case mWsOpts of
  40       Nothing -> httpApp modelSTM siteMap Nothing
  41       Just () -> do
  42         WaiWs.websocketsOr
  43           WS.defaultConnectionOptions
  44           (webSocketApp iniModel modelSTM siteMap)
  45           (httpApp modelSTM siteMap (Just webSocketClientJS))
  46     banner port = do
  47       Sys.hPrint
  48         Sys.stderr
  49         (host, "port" :: Text, port, maybe "no ws" (const "ws") mWsOpts :: Text)
  50   warpRunSettings settings portMaybe banner app
  51
  52 -- Like Warp.runSettings but takes *optional* port. When no port is set,
  53 -- a free (random) port is used.
  54 warpRunSettings ::
  55   Warp.Settings ->
  56   Maybe Warp.Port ->
  57   (Warp.Port -> IO a) ->
  58   Wai.Application ->
  59   IO ()
  60 warpRunSettings settings portMaybe banner app = do
  61   case portMaybe of
  62     Nothing ->
  63       Warp.withApplicationSettings settings (pure app) $ \port -> do
  64         void $ banner port
  65         threadDelay maxBound
  66     Just port -> do
  67       void $ banner port
  68       Warp.runSettings (Warp.setPort port settings) app