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

-- | spawns a few processes that serve the que.run website
--
-- : exe que-website
-- : dep async
-- : dep process
-- : dep protolude
-- : dep req
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 ()