From 330e4363d8abb509031d2c8c1a89dcc6f955e2c1 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Fri, 4 Dec 2020 11:16:25 -0500
Subject: Renamespace Devalloc and Que

Move them under the Biz root so that we know they are specific to Biz stuff. Biz
is for proprietary stuff that we own.

I also had to refactor the bild namespace parsing code because it couldn't
handle a namespace with 3 parts. I really need to get that namespace library
written and tested.
---
 Devalloc/Host.hs | 121 -------------------------------------------------------
 1 file changed, 121 deletions(-)
 delete mode 100644 Devalloc/Host.hs

(limited to 'Devalloc/Host.hs')

diff --git a/Devalloc/Host.hs b/Devalloc/Host.hs
deleted file mode 100644
index 6d66f32..0000000
--- a/Devalloc/Host.hs
+++ /dev/null
@@ -1,121 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
--- Developer allocation
---
--- : out devalloc-host
--- : dep clay
--- : dep cmark
--- : sys cmark
--- : dep envy
--- : dep lucid
--- : dep miso
--- : dep protolude
--- : dep servant
--- : dep servant-server
--- : dep warp
-module Devalloc.Host
-  ( main,
-  )
-where
-
-import Alpha
-import Biz.App (CSS (..), HtmlApp (..))
-import qualified Biz.Look
--- import qualified CMark as Cmark
-import qualified Clay
-import qualified Control.Exception as Exception
-import qualified Devalloc.Page.Home as Home
-import qualified Devalloc.Page.Signup as Signup
-import qualified Lucid
-import qualified Lucid.Base as Lucid
-import Miso hiding (node)
-import qualified Network.Wai as Wai
-import qualified Network.Wai.Handler.Warp as Warp
-import Network.Wai.Middleware.RequestLogger (logStdout)
-import Servant
-import qualified System.Envy as Envy
-
-main :: IO ()
-main = Exception.bracket startup shutdown run
-  where
-    startup =
-      Envy.decodeWithDefaults Envy.defConfig >>= \cfg -> do
-        -- pitchText <- readFile <| pitches cfg
-        -- let pitch = Cmark.commonmarkToHtml [] pitchText
-        putText "@"
-        putText "devalloc"
-        putText <| "port: " <> (show <| port cfg)
-        return (cfg, serve (Proxy @AllRoutes) <| serverHandlers)
-    shutdown :: (Config, Application) -> IO ()
-    shutdown _ = pure ()
-    run :: (Config, Wai.Application) -> IO ()
-    run (cfg, app) = Warp.run (port cfg) (logStdout app)
-
-type HomeServer = ToServerRoutes Home.Path HtmlApp Home.Move
-
-type SignupServer = ToServerRoutes Signup.Path HtmlApp Signup.Move
-
-type AllRoutes = HomeServer :<|> SignupServer :<|> CssRoute
-
-type CssRoute = "css" :> "main.css" :> Get '[CSS] Text
-
-cssHandlers :: Server CssRoute
-cssHandlers = return . toStrict <| Clay.render look
-
-instance Lucid.ToHtml a => Lucid.ToHtml (HtmlApp a) where
-  toHtmlRaw = Lucid.toHtml
-  toHtml (HtmlApp x) =
-    Lucid.doctypehtml_ <| do
-      Lucid.head_ <| do
-        Lucid.meta_ [Lucid.charset_ "utf-8"]
-        jsRef "/static/all.js"
-        jsRef "//unpkg.com/turbolinks@5.2.0/dist/turbolinks.js"
-        cssRef "/css/main.css"
-      Lucid.body_ (Lucid.toHtml x)
-    where
-      jsRef _href =
-        Lucid.with
-          (Lucid.script_ mempty)
-          [ Lucid.makeAttribute "src" _href,
-            Lucid.makeAttribute "async" mempty,
-            Lucid.makeAttribute "defer" mempty
-          ]
-      cssRef _href =
-        Lucid.with
-          (Lucid.link_ mempty)
-          [ Lucid.rel_ "stylesheet",
-            Lucid.type_ "text/css",
-            Lucid.href_ _href
-          ]
-
-data Config = Config
-  { port :: Warp.Port,
-    -- | A yaml file of pitches
-    pitches :: FilePath,
-    node :: FilePath
-  }
-  deriving (Generic, Show)
-
-instance Envy.DefConfig Config where
-  defConfig =
-    Config
-      { port = 3000,
-        pitches = "./Devalloc/pitch.md",
-        node = "_/bild/dev/Devalloc.Node/static"
-      }
-
-instance Envy.FromEnv Config
-
-serverHandlers :: Server AllRoutes
-serverHandlers = Home.host :<|> Signup.host :<|> cssHandlers
-
-look :: Clay.Css
-look = do
-  Biz.Look.fuckingStyle
-  "body" Clay.? Biz.Look.fontStack
-- 
cgit v1.2.3