-- Copyright 2019 Google LLC
--
-- Use of this source code is governed by a BSD-style
-- license that can be found in the LICENSE file or at
-- https://developers.google.com/open-source/licenses/bsd

module Live.Web (runWeb, generateHTML) where

import Control.Concurrent (readChan)
import Control.Monad (forever)

import Network.Wai (Application, StreamingBody, pathInfo,
                    responseStream, responseLBS, responseFile)
import Network.Wai.Handler.Warp (run)
import Network.HTTP.Types (status200, status404)
import Data.Aeson (ToJSON, encode)
import Data.Binary.Builder (fromByteString)
import Data.ByteString.Lazy (toStrict)
import qualified Data.ByteString as BS
import System.Directory (withCurrentDirectory)

-- import Paths_dex (getDataFileName)
import RenderHtml
import Live.Eval
import TopLevel

runWeb :: FilePath -> EvalConfig -> TopStateEx -> IO ()
runWeb fname opts env = do
  resultsChan <- watchAndEvalFile fname opts env
  putStrLn "Streaming output to http://localhost:8000/"
  run 8000 $ serveResults resultsChan

pagesDir :: FilePath
pagesDir = "pages"

generateHTML :: FilePath -> FilePath -> EvalConfig -> TopStateEx -> IO ()
generateHTML sourcePath destPath cfg env = do
  finalState <- evalFileNonInteractive sourcePath cfg env
  results <- renderResults finalState
  withCurrentDirectory pagesDir do
    renderStandaloneHTML destPath results

serveResults :: EvalServer -> Application
serveResults resultsSubscribe request respond = do
  print (pathInfo request)
  case pathInfo request of
    []            -> respondWith "static/dynamic.html" "text/html"
    ["style.css"] -> respondWith "static/style.css"  "text/css"
    ["index.js"]  -> respondWith "static/index.js"   "text/javascript"
    ["getnext"]   -> respond $ responseStream status200
                       [ ("Content-Type", "text/event-stream")
                       , ("Cache-Control", "no-cache")]
                       $ resultStream resultsSubscribe
    _ -> respond $ responseLBS status404
           [("Content-Type", "text/plain")] "404 - Not Found"
  where
    respondWith dataFname ctype = do
      fname <- return dataFname -- lets us skip rebuilding during development
      -- fname <- getDataFileName dataFname
      respond $ responseFile status200 [("Content-Type", ctype)] fname Nothing

resultStream :: EvalServer -> StreamingBody
resultStream resultsServer write flush = do
  sendUpdate ("start"::String)
  (initResult, resultsChan) <- subscribeIO resultsServer
  (renderedInit, renderUpdateFun) <- renderResultsInc initResult
  sendUpdate renderedInit
  forever $ readChan resultsChan >>= renderUpdateFun >>= sendUpdate
  where
    sendUpdate :: ToJSON a => a -> IO ()
    sendUpdate x = write (fromByteString $ encodePacket x) >> flush

encodePacket :: ToJSON a => a -> BS.ByteString
encodePacket = toStrict . wrap . encode
  where wrap s = "data:" <> s <> "\n\n"