{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE LambdaCase #-}

-- | spawns a few processes that serve the que.run website
module Run.Que.Website where

import qualified Control.Concurrent.Async      as Async
import qualified Data.ByteString.Char8         as BS
import qualified Data.Text                     as Text
import           Network.HTTP.Req
import           Protolude
import           System.Environment            as Environment
import           System.FilePath                ( (</>) )
import qualified System.Process                as Process
import qualified System.Exit                   as Exit

main :: IO ()
main = do
  (src, ns) <- Environment.getArgs >>= \case
    [src]     -> return (src, "_") -- default to _ ns which is special
    [src, ns] -> return (src, ns)
    _         -> Exit.die "usage: que-website <srcdir> [namespace]"

  putStrLn $ "serving " ++ src ++ " at " ++ ns
  loop (Text.pack ns) $ Sources { index      = src </> "index.md"
                                , client     = src </> "client.py"
                                , quescripts = src </> "quescripts.md"
                                , style      = src </> "style.css"
                                }

data Sources = Sources
  { index :: FilePath
  , quescripts :: FilePath
  , client :: FilePath
  , style :: FilePath
  }

loop :: Text -> Sources -> IO ()
loop ns pages@Sources {..} = do
  _ <-
    Async.runConcurrently
    $   (,,,)
    <$> Async.Concurrently
          (toHtml style index >>= serve (https "que.run" /: ns /: "index"))
    <*> Async.Concurrently
          (   BS.readFile client
          >>= serve (https "que.run" /: ns /: "client")
          )
    <*> Async.Concurrently
          (   toHtml style quescripts
          >>= serve (https "que.run" /: ns /: "quescripts")
          )
  loop ns pages


toHtml :: FilePath -> FilePath -> IO ByteString
toHtml style md =
  BS.pack
    <$> Process.readProcess
          "pandoc"
          [ "--self-contained"
          , "--css"
          , style
          , "-i"
          , md
          , "--from"
          , "markdown"
          , "--to"
          , "html"
          ]
          []

-- TODO: recover from 502 errors
serve :: Url scheme -> ByteString -> IO ()
serve path content = runReq defaultHttpConfig $ do
  _ <- req POST path (ReqBodyBs content) ignoreResponse mempty
  liftIO $ return ()