From f4b8c0df041b063c0b47d2ec6c818a9c202fd833 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Wed, 15 Apr 2020 09:54:10 -0700
Subject: Re-namespacing

Moving away from the DNS-driven namespacing toward more condensed names,
mostly because I don't like typing so much.
---
 Run/Que/Website.hs | 126 -----------------------------------------------------
 1 file changed, 126 deletions(-)
 delete mode 100644 Run/Que/Website.hs

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

diff --git a/Run/Que/Website.hs b/Run/Que/Website.hs
deleted file mode 100644
index 52e46f9..0000000
--- a/Run/Que/Website.hs
+++ /dev/null
@@ -1,126 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE LambdaCase #-}
-
--- | 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 Run.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 >> return ()
- 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 ()
-- 
cgit v1.2.3