From 9f3804d5e4f28ea61a8abc856210422ad794b55e Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Tue, 31 Mar 2020 11:39:49 -0700
Subject: Add Run.Que.Website server

This is a simple website server that uses que.run itself to host the que
webpages.

I had to rename Run.Que to Run.Que.Server because nix was
complaining about Run.Que being both a derivation and an attrset with
Run.Que.Website in it.
---
 Run/Que/Website.hs | 45 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 45 insertions(+)
 create mode 100644 Run/Que/Website.hs

(limited to 'Run/Que/Website.hs')

diff --git a/Run/Que/Website.hs b/Run/Que/Website.hs
new file mode 100644
index 0000000..1de6bca
--- /dev/null
+++ b/Run/Que/Website.hs
@@ -0,0 +1,45 @@
+-- | spawns a few processes that serve the que.run website
+module Run.Que.Website where
+
+import           Prelude
+import           System.Environment            as Environment
+import           System.FilePath                ( (</>) )
+import qualified System.Process                as Process
+
+main :: IO ()
+main = do
+  args <- Environment.getArgs
+  let [src, ns] = if length args == 2
+        then take 2 args
+        else if length args == 1
+          then args ++ ["/"]
+          else error "usage: que-website <srcdir> [namespace]"
+  homepage <- getHomepageHtml (src </> "style.css") (src </> "index.md")
+  client   <- readFile $ src </> "client.py"
+  putStrLn $ "serving " ++ src ++ " at " ++ ns
+  loop ns homepage client
+
+loop :: String -> FilePath -> FilePath -> IO ()
+loop ns homepage client =
+  serve (ns </> "index.html") homepage
+    >> serve (ns </> "_client/python") client
+    >> loop ns homepage client
+
+getHomepageHtml :: String -> String -> IO String
+getHomepageHtml style index = Process.readProcess
+  "pandoc"
+  [ "--self-contained"
+  , "--css"
+  , style
+  , "-i"
+  , index
+  , "--from"
+  , "markdown"
+  , "--to"
+  , "html"
+  ]
+  []
+
+serve :: FilePath -> FilePath -> IO ()
+serve path file =
+  Process.callProcess "curl" ["https://que.run" ++ path, "-d", file]
-- 
cgit v1.2.3