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, 302 deletions

diff --git a/Com/MusicMeetsComics/Server.hs b/Com/MusicMeetsComics/Server.hs
deleted file mode 100644
index c173bd3..0000000
--- a/Com/MusicMeetsComics/Server.hs
+++ /dev/null
@@ -1,302 +0,0 @@
-{-# LANGUAGE OverloadedStrings          #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiParamTypeClasses      #-}
-{-# LANGUAGE DeriveGeneric              #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE PolyKinds                  #-}
-{-# LANGUAGE DataKinds                  #-}
-{-# LANGUAGE FlexibleInstances          #-}
-{-# LANGUAGE TypeOperators              #-}
-{-# LANGUAGE TypeApplications           #-}
-{-# LANGUAGE TypeSynonymInstances       #-}
-{-# LANGUAGE NoImplicitPrelude          #-}
--- | Hero web app
---
--- : exe mmc
---
--- : dep aeson
--- : dep clay
--- : dep containers
--- : dep dhall
--- : dep envy
--- : dep http-types
--- : dep lucid
--- : dep miso
--- : dep mtl
--- : dep network-uri
--- : dep protolude
--- : dep servant
--- : dep servant-lucid
--- : dep servant-server
--- : dep split
--- : dep split
--- : dep string-quote
--- : dep text
--- : dep wai
--- : dep wai-app-static
--- : dep wai-extra
--- : dep wai-middleware-metrics
--- : dep warp
-module Com.MusicMeetsComics.Server where
-
-import qualified Clay
-import           Com.MusicMeetsComics.App
-import qualified Com.MusicMeetsComics.Assets   as Assets
-import qualified Com.MusicMeetsComics.Database as Database
-import qualified Com.MusicMeetsComics.Look     as Look
-import qualified Com.MusicMeetsComics.Look.Typography
-                                               as Typography
-import           Data.Aeson
-import           Data.Proxy
-import           Data.Text                      ( Text )
-import qualified Data.Text.Lazy                as Lazy
-import qualified Data.Text.Lazy.Encoding       as Lazy
-import           GHC.Generics
-import qualified Lucid                         as L
-import           Lucid.Base
-import           Miso
-import           Miso.String
-import           Network.HTTP.Media             ( (//)
-                                                , (/:)
-                                                )
-import           Network.HTTP.Types      hiding ( Header )
-import           Network.Wai
-import           Network.Wai.Application.Static
-import qualified Network.Wai.Handler.Warp      as Warp
-import           Protolude
-import           Servant
-import qualified System.Envy                   as Envy
-import qualified System.Exit                   as Exit
-import qualified System.IO                     as IO
-
-
-main :: IO ()
-main = bracket startup shutdown $ uncurry Warp.run
- where
-  say     = IO.hPutStrLn IO.stderr
-  startup = Envy.decodeEnv >>= \case
-    Left  e -> Exit.die e
-    Right c -> do
-      db <- Database.dummy
-      say $ "hero"
-      say $ "port: " ++ (show $ heroPort c)
-      say $ "client: " ++ heroClient c
-      let waiapp = app db c
-      return (heroPort c, waiapp)
-  shutdown :: a -> IO a
-  shutdown = pure . identity
-
-data Config = Config
-  { heroPort :: Warp.Port -- ^ HERO_PORT
-  , heroClient :: FilePath -- ^ HERO_CLIENT
-  } deriving (Generic, Show)
-
-instance Envy.DefConfig Config where
-  defConfig = Config 3000 "_bild/Com.MusicMeetsComics.Client/static"
-
-instance Envy.FromEnv Config
-
-app :: Database.ComicDB -> Config -> Application
-app db cfg = serve
-  (Proxy @AllRoutes)
-  (    static
-  :<|> cssHandlers
-  :<|> jsonHandlers db
-  :<|> serverHandlers
-  :<|> pure heroManifest
-  :<|> Tagged handle404
-  )
-  where static = serveDirectoryWith $ defaultWebAppSettings $ heroClient cfg
-
-
--- | HtmlPage for setting HTML doctype and header
-newtype HtmlPage a = HtmlPage a
-  deriving (Show, Eq)
-
--- | Convert client side routes into server-side web handlers
-type ServerRoutes = ToServerRoutes ClientRoutes HtmlPage Action
-
-type JsonApi = "api" :> "comic" :> Get '[JSON] [Comic]
-
-type CssRoute = "css" :> "main.css" :> Get '[CSS] Text
-
-newtype CSS = CSS
-  { unCSS :: Text
-  }
-
-instance Accept CSS where
-  contentType _ = "text" // "css" /: ("charset", "utf-8")
-
-instance MimeRender CSS Text where
-  mimeRender _ = Lazy.encodeUtf8 . Lazy.fromStrict
-
-cssHandlers :: Server CssRoute
-cssHandlers =
-  return . Lazy.toStrict . Clay.render $ Typography.main <> Look.main
-
-type AllRoutes
-  = ("static" :> Raw)
-      :<|>
-      CssRoute
-      :<|>
-      JsonApi
-      :<|>
-      ServerRoutes
-      :<|>
-      ("manifest.json" :> Get '[JSON] Manifest)
-      :<|>
-      Raw
-
-data Manifest = Manifest
-  { name :: Text
-  , short_name :: Text
-  , start_url :: Text
-  , display :: Text
-  , theme_color :: Text
-  , description :: Text
-  } deriving (Show, Eq, Generic)
-
-instance ToJSON Manifest
-
-heroManifest :: Manifest
-heroManifest = Manifest { name        = "Hero"
-                        , short_name  = "Hero"
-                        , start_url   = "."
-                        , display     = "standalone"
-                        , theme_color = "#0a0a0a"
-                        , description = "Comics for all"
-                        }
-
-handle404 :: Application
-handle404 _ respond =
-  respond
-    $ responseLBS status404 [("Content-Type", "text/html")]
-    $ renderBS
-    $ toHtml
-    $ HtmlPage
-    $ the404
-    $ initModel homeLink
-
-instance L.ToHtml a => L.ToHtml (HtmlPage a) where
-  toHtmlRaw = L.toHtml
-  toHtml (HtmlPage x) = do
-    L.doctype_
-    L.html_ [L.lang_ "en"] $ do
-      L.head_ $ do
-        L.title_ "Hero [alpha]"
-        L.link_ [L.rel_ "manifest", L.href_ "/manifest.json"]
-        L.link_ [L.rel_ "icon", L.type_ ""]
-
-        -- icons
-        L.link_
-          [ L.rel_ "apple-touch-icon"
-          , L.sizes_ "180x180"
-          , L.href_
-          $  Assets.cdnEdge
-          <> "/old-assets/images/favicons/apple-touch-icon.png"
-          ]
-        L.link_
-          [ L.rel_ "icon"
-          , L.type_ "image/png"
-          , L.sizes_ "32x32"
-          , L.href_
-          $  Assets.cdnEdge
-          <> "/old-assets/images/favicons/favicon-32x32.png"
-          ]
-        L.link_
-          [ L.rel_ "icon"
-          , L.type_ "image/png"
-          , L.sizes_ "16x16"
-          , L.href_
-          $  Assets.cdnEdge
-          <> "/old-assets/images/favicons/favicon-16x16.png"
-          ]
-        L.link_
-          [ L.rel_ "manifest"
-          , L.href_
-          $  Assets.cdnEdge
-          <> "/old-assets/images/favicons/manifest.json"
-          ]
-        L.link_
-          [ L.rel_ "mask-icon"
-          , L.href_
-          $  Assets.cdnEdge
-          <> "/old-assets/images/favicons/safari-pinned-tab.svg"
-          ]
-
-        L.meta_ [L.charset_ "utf-8"]
-        L.meta_ [L.name_ "theme-color", L.content_ "#000"]
-        L.meta_ [L.httpEquiv_ "X-UA-Compatible", L.content_ "IE=edge"]
-        L.meta_
-          [L.name_ "viewport", L.content_ "width=device-width, initial-scale=1"]
-        cssRef animateRef
-        cssRef bulmaRef
-        cssRef fontAwesomeRef
-        cssRef "/css/main.css" -- TODO: make this a safeLink?
-        jsRef "/static/mmc.js"
-        jsRef "/static/usersnap.js"
-      L.body_ (L.toHtml x)
-   where
-    jsRef href = L.with
-      (L.script_ mempty)
-      [ makeAttribute "src"   href
-      , makeAttribute "async" mempty
-      , makeAttribute "defer" mempty
-      ]
-    cssRef href = L.with
-      (L.link_ mempty)
-      [L.rel_ "stylesheet", L.type_ "text/css", L.href_ href]
-
-fontAwesomeRef :: MisoString
-fontAwesomeRef = "https://use.fontawesome.com/releases/v5.7.2/css/all.css"
-
-animateRef :: MisoString
-animateRef =
-  "https://cdnjs.cloudflare.com/ajax/libs/animate.css/3.7.0/animate.min.css"
-
-bulmaRef :: MisoString
-bulmaRef =
-  "https://cdnjs.cloudflare.com/ajax/libs/bulma/0.7.2/css/bulma.min.css"
-
-serverHandlers :: Server ServerRoutes
-serverHandlers =
-  homeHandler
-    :<|> comicCoverHandler
-    :<|> comicPageHandler
-    :<|> comicPageFullHandler
-    :<|> comicVideoHandler
-    :<|> loginHandler
-    :<|> discoverHandler
-    :<|> chooseExperienceHandler
-
-jsonHandlers :: Database.ComicDB -> Server JsonApi
-jsonHandlers db = Database.getComics db
-
-homeHandler :: Handler (HtmlPage (View Action))
-homeHandler = pure . HtmlPage . home $ initModel homeLink
-
-comicCoverHandler :: ComicId -> Handler (HtmlPage (View Action))
-comicCoverHandler id =
-  pure . HtmlPage . comicCover id . initModel $ comicLink id
-
-comicPageHandler :: ComicId -> Page -> Handler (HtmlPage (View Action))
-comicPageHandler id n =
-  pure . HtmlPage . comicPlayer id n . initModel $ comicPlayerSpreadLink id n
-
-comicPageFullHandler :: ComicId -> Page -> Handler (HtmlPage (View Action))
-comicPageFullHandler id n =
-  pure . HtmlPage . comicPlayer id n . initModel $ comicPlayerFullLink id n
-
-comicVideoHandler :: ComicId -> Page -> Handler (HtmlPage (View Action))
-comicVideoHandler id n =
-  pure . HtmlPage . comicPlayer id n . initModel $ comicVideoLink id n
-
-loginHandler :: Handler (HtmlPage (View Action))
-loginHandler = pure . HtmlPage . login $ initModel loginLink
-
-discoverHandler :: Handler (HtmlPage (View Action))
-discoverHandler = pure . HtmlPage . discover $ initModel discoverLink
-
-chooseExperienceHandler :: ComicId -> Page -> Handler (HtmlPage (View Action))
-chooseExperienceHandler id n =
-  pure . HtmlPage . comicPlayer id n . initModel $ chooseExperienceLink id n