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

-- | spawns a few processes that serve the que.run website
--
-- : exe que-website
--
-- : dep async
-- : dep config-ini
-- : dep process
-- : dep protolude
-- : dep req
module Que.Website
  ( main,
  )
where

import Alpha
import qualified Control.Concurrent.Async as Async
import qualified Data.ByteString.Char8 as BS
import qualified Data.Ini.Config as Config
import qualified Data.Text as Text
import Data.Text.Encoding (encodeUtf8)
import qualified Data.Text.IO as Text
import Network.HTTP.Req
import qualified System.Directory as Directory
import System.Environment as Environment
import qualified System.Exit as Exit
import System.FilePath ((</>))
import qualified System.Process as Process

main :: IO ()
main = do
  (src, ns) <- Environment.getArgs >>= \case
    [src] -> return (src, "_") -- default to _ ns which is special
    [src, ns] -> return (src, Text.pack ns)
    _ -> Exit.die "usage: que-website <srcdir> [namespace]"
  mKey <- getKey ns
  putText <| "serving " <> Text.pack src <> " at " <> ns
  run mKey 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"
      }

getKey :: Namespace -> IO (Maybe Key)
getKey ns = do
  home <- Directory.getHomeDirectory
  let file = home </> ".config" </> "que.conf"
  exists <- Directory.doesFileExist file
  unless exists <| panic <| "not found: " <> Text.pack file
  conf <- Text.readFile file
  print (home </> ".config" </> "que.conf")
  auth ns
    |> Config.parseIniFile conf
    |> either errorParsingConf identity
    |> return

errorParsingConf :: error
errorParsingConf = panic "could not parse ~/.config/que.conf"

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

type Namespace = Text

type Key = Text

auth :: Namespace -> Config.IniParser (Maybe Key)
auth "pub" = pure Nothing
auth ns = Config.sectionMb ns <| Config.field "key"

run :: Maybe Key -> Text -> Sources -> IO ()
run key ns Sources {..} = Async.runConcurrently actions |> void
  where
    actions =
      traverse
        Async.Concurrently
        [ forever <| toHtml index >>= serve key ns "index",
          forever <| toHtml quescripts >>= serve key ns "quescripts",
          forever <| BS.readFile client >>= serve key ns "client",
          forever <| toHtml tutorial >>= serve key ns "tutorial",
          forever <| toHtml apidocs >>= serve key ns "apidocs"
        ]
    toHtml :: FilePath -> IO ByteString
    toHtml md =
      BS.pack
        </ Process.readProcess
          "pandoc"
          [ "--include-in-header",
            style,
            "-i",
            md,
            "--from",
            "markdown",
            "--to",
            "html"
          ]
          []

serve :: Maybe Key -> Namespace -> Text -> ByteString -> IO ()
serve Nothing "pub" path content = runReq defaultHttpConfig <| do
  _ <-
    req
      POST
      (http "que.run" /: "pub" /: path)
      (ReqBodyBs content)
      ignoreResponse
      mempty
  liftIO <| return ()
serve Nothing p _ _ = panic <| "no auth key provided for ns: " <> p
serve (Just key) ns path content = runReq defaultHttpConfig <| do
  let options =
        header "Authorization" (encodeUtf8 key) <> responseTimeout maxBound
  _ <-
    req
      POST
      (http "que.run" /: ns /: path)
      (ReqBodyBs content)
      ignoreResponse
      options
  liftIO <| return ()