{-# LANGUAGE NoRebindableSyntax #-}

module Literate.Web.Live where

import Control.Applicative (Applicative (..))
import Control.Concurrent (threadDelay)
import Control.Concurrent.STM (STM)
import Control.Concurrent.STM qualified as STM
import Control.Monad (void)
import Control.Monad.Classes qualified as MC
import Data.ByteString.Lazy qualified as BSL
import Data.Function (const, ($), (&))
import Data.Map.Strict qualified as Map
import Data.Maybe (Maybe (..), maybe)
import Data.Monoid (Monoid (..))
import Data.Text.Lazy qualified as TextL
import Data.Text.Lazy.IO qualified as TextL
import Network.Wai qualified as Wai
import Network.Wai.Handler.Warp qualified as Warp
import Network.Wai.Handler.WebSockets qualified as WaiWs
import Network.WebSockets qualified as WS
import System.IO (IO)
import System.IO qualified as Sys
import Text.Show (Show (..))
import Prelude (Bounded (..))

import Literate.Web qualified as Web
import Literate.Web.Live.HTTP
import Literate.Web.Live.WebSocket

runLive ::
  m ~ IO =>
  MC.MonadExec IO m =>
  Maybe () ->
  Warp.HostPreference ->
  Maybe Warp.Port ->
  STM model ->
  (model -> m (Map.Map Web.OutputPath (IO BSL.ByteString))) ->
  m ()
runLive mWsOpts host portMaybe modelSTM siteMap = do
  iniModel <- MC.exec @IO $ STM.atomically modelSTM
  let
    settings =
      Warp.defaultSettings
        & Warp.setHost host
    app = case mWsOpts of
      Nothing -> httpApp modelSTM siteMap Nothing
      Just () -> do
        WaiWs.websocketsOr
          WS.defaultConnectionOptions
          (webSocketApp iniModel modelSTM siteMap)
          (httpApp modelSTM siteMap (Just webSocketClientJS))
    banner port = do
      TextL.hPutStrLn Sys.stderr $
        TextL.unlines
          [ "==============================================="
          , mconcat
              [ "Live server RUNNING: http://"
              , TextL.pack (show host)
              , ":"
              , TextL.pack (show port)
              , " ("
              , maybe "no ws" (const "ws") mWsOpts
              , ")"
              ]
          , "==============================================="
          ]
  MC.exec @IO $ warpRunSettings settings portMaybe banner app

-- Like Warp.runSettings but takes *optional* port. When no port is set,
-- a free (random) port is used.
warpRunSettings :: Warp.Settings -> Maybe Warp.Port -> (Warp.Port -> IO a) -> Wai.Application -> IO ()
warpRunSettings settings portMaybe banner app = do
  case portMaybe of
    Nothing ->
      Warp.withApplicationSettings settings (pure app) $ \port -> do
        void $ banner port
        threadDelay maxBound
    Just port -> do
      void $ banner port
      Warp.runSettings (Warp.setPort port settings) app