{-# 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"
                                , apidocs    = src </> "apidocs.md"
                                , tutorial   = src </> "tutorial.md"
                                }

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

loop :: Text -> Sources -> IO ()
loop ns pages@Sources {..} = Async.runConcurrently actions >> loop ns pages
 where
  actions = traverse
    Async.Concurrently
    [ toHtml index >>= srv "index"
    , toHtml quescripts >>= srv "quescripts"
    , BS.readFile client >>= srv "client"
    , toHtml tutorial >>= srv "tutorial"
    , toHtml apidocs >>= srv "apidocs"
    ]
  srv p = serve $ https "que.run" /: ns /: p
  toHtml :: FilePath -> IO ByteString
  toHtml 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 ()