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
  26 runLive ::
  27   Maybe () ->
  28   Warp.HostPreference ->
  29   Maybe Warp.Port ->
  30   STM model ->
  31   (model -> IO (Map.Map Web.OutputPath (IO BSB.Builder))) ->
  32   IO ()
  33 runLive mWsOpts host portMaybe modelSTM siteMapBSB = do
  34   iniModel <- STM.atomically modelSTM
  35   let
  36     siteMap model = siteMapBSB model <&> (<&> (<&> BSB.toLazyByteString))
  37     settings = Warp.defaultSettings & Warp.setHost host
  38     app = case mWsOpts of
  39       Nothing -> httpApp modelSTM siteMap Nothing
  40       Just () -> do
  41         WaiWs.websocketsOr
  42           WS.defaultConnectionOptions
  43           (webSocketApp iniModel modelSTM siteMap)
  44           (httpApp modelSTM siteMap (Just webSocketClientJS))
  45     banner port = do
  46       Sys.hPrint
  47         Sys.stderr
  48         (host, "port" :: Text, port, maybe "no ws" (const "ws") mWsOpts :: Text)
  49   warpRunSettings settings portMaybe banner app
  50
  51 -- Like Warp.runSettings but takes *optional* port. When no port is set,
  52 -- a free (random) port is used.
  53 warpRunSettings ::
  54   Warp.Settings ->
  55   Maybe Warp.Port ->
  56   (Warp.Port -> IO a) ->
  57   Wai.Application ->
  58   IO ()
  59 warpRunSettings settings portMaybe banner app = do
  60   case portMaybe of
  61     Nothing ->
  62       Warp.withApplicationSettings settings (pure app) $ \port -> do
  63         void $ banner port
  64         threadDelay maxBound
  65     Just port -> do
  66       void $ banner port
  67       Warp.runSettings (Warp.setPort port settings) app