Re-namespacing

Moving away from the DNS-driven namespacing toward more condensed names,
mostly because I don't like typing so much.

1 files changed, 0 insertions, 152 deletions

diff --git a/Com/InfluencedByBooks/Server.hs b/Com/InfluencedByBooks/Server.hs
deleted file mode 100644
index 244a7ca..0000000
--- a/Com/InfluencedByBooks/Server.hs
+++ /dev/null
@@ -1,152 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE MultiParamTypeClasses      #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeOperators #-}
-
--- | Server
---
--- : exe ibb
---
--- : dep clay
--- : dep miso
--- : dep protolude
--- : dep servant
--- : dep text
--- : dep MonadRandom
--- : dep acid-state
--- : dep bytestring
--- : dep ixset
--- : dep random
--- : dep safecopy
--- : dep scotty
--- : dep servant-server
--- : dep text
-module Com.InfluencedByBooks.Server where
-
-import           Alpha
-import qualified Clay
-import           Com.InfluencedByBooks.Core
-import qualified Com.InfluencedByBooks.Keep    as Keep
-import qualified Com.InfluencedByBooks.Look    as Look
-import           Com.Simatime.Network
-import           Data.Acid                      ( AcidState )
-import qualified Data.Acid.Abstract            as Acid
-import           Data.Maybe                     ( fromMaybe )
-import qualified Data.Text.Lazy                as Lazy
-import qualified Data.Text.Lazy.Encoding       as Lazy
-import qualified Lucid                         as L
-import           Lucid.Base
-import           Miso
-import           Network.HTTP.Media             ( (//)
-                                                , (/:)
-                                                )
-import           Network.HTTP.Types
-import           Network.Wai
-import           Network.Wai.Application.Static
-import           Network.Wai.Handler.Warp
-import           Network.Wai.Middleware.Gzip
-import           Network.Wai.Middleware.RequestLogger
-import           Servant
-import           System.Environment             ( lookupEnv )
-
-main :: IO ()
-main = do
-  say "rise: ibb"
-  staticDir <- fromMaybe "static" <$> lookupEnv "STATIC_DIR" :: IO [Char]
-  port      <- read <$> fromMaybe "3000" <$> lookupEnv "PORT" :: IO Int
-  keep      <- Keep.openLocal "_keep/"
-  say "port: 3000"
-  run port $ logStdout $ compress $ app staticDir $ keep
-  where compress = gzip def { gzipFiles = GzipCompress }
-
-newtype HtmlPage a = HtmlPage a
-  deriving (Show, Eq)
-
-instance L.ToHtml a => L.ToHtml (HtmlPage a) where
-  toHtmlRaw = L.toHtml
-  toHtml (HtmlPage x) = L.doctypehtml_ $ do
-    L.head_ $ do
-      L.meta_ [L.charset_ "utf-8"]
-      jsRef "/static/ibb.js"
-      cssRef "/css/main.css"
-    L.body_ $ do
-      page
-   where
-    page = L.toHtml x
-    jsRef href = L.with
-      (L.script_ mempty)
-      [ makeAttribute "src"   href
-      , makeAttribute "type"  "text/javascript"
-      , makeAttribute "async" mempty
-      , makeAttribute "defer" mempty
-      ]
-    cssRef href = L.with
-      (L.link_ mempty)
-      [L.rel_ "stylesheet", L.type_ "text/css", L.href_ href]
-
-type ServerRoutes = ToServerRoutes AppRoutes HtmlPage Action
-
-handle404 :: Application
-handle404 _ respond =
-  respond
-    $ responseLBS status404 [("Content-Type", "text/html")]
-    $ renderBS
-    $ toHtml
-    $ HtmlPage
-    $ notfound
-
-newtype CSS = CSS
-  { unCSS :: Text
-  }
-
-instance MimeRender CSS Text where
-  mimeRender _ = Lazy.encodeUtf8 . Lazy.fromStrict
-
-instance Accept CSS where
-  contentType _ = "text" // "css" /: ("charset", "utf-8")
-
-type CssRoute = "css" :> "main.css" :> Get '[CSS] Text
-
-type Routes
-  = "static"
-      :>
-      Raw
-      :<|>
-      CssRoute
-      :<|>
-      ServerRoutes
-      :<|>
-      "api"
-      :>
-      ApiRoutes
-      :<|>
-      Raw
-
-cssHandlers :: Server CssRoute
-cssHandlers = return . Lazy.toStrict . Clay.render $ Look.main
-
-app :: [Char] -> AcidState Keep.IbbKeep -> Application
-app staticDir keep =
-  serve (Proxy @Routes)
-    $    static
-    :<|> cssHandlers
-    :<|> serverHandlers
-    :<|> apiHandlers keep
-    :<|> Tagged handle404
-  where static = serveDirectoryWith (defaultWebAppSettings $ staticDir)
-
-type ApiRoutes = "people" :> Get '[JSON] [Person]
-
-serverHandlers :: Server ServerRoutes
-serverHandlers = homeHandler
- where
-  send f u = pure $ HtmlPage $ f Model { uri = u, people = NotAsked }
-  homeHandler = send home goHome
-
--- | for now we just have one api endpoint, which returns all the people
-apiHandlers :: AcidState Keep.IbbKeep -> Server ApiRoutes
-apiHandlers keep = Acid.query' keep $ Keep.GetPeople 20