summaryrefslogtreecommitdiff
path: root/Com/MusicMeetsComics/Apex.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Com/MusicMeetsComics/Apex.hs')
-rw-r--r--Com/MusicMeetsComics/Apex.hs235
1 files changed, 0 insertions, 235 deletions
diff --git a/Com/MusicMeetsComics/Apex.hs b/Com/MusicMeetsComics/Apex.hs
deleted file mode 100644
index f652f68..0000000
--- a/Com/MusicMeetsComics/Apex.hs
+++ /dev/null
@@ -1,235 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-module Com.MusicMeetsComics.Apex 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.Server.Config as Config
-import qualified Com.MusicMeetsComics.Server.Init as Init
-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 Protolude
-import Servant
-
-
-main :: IO ()
-main = do
- db <- Database.load
- Init.runApp (app db)
-
-app :: Database.ComicDB -> Config.Config -> Application
-app db _ = serve
- (Proxy @AllRoutes)
- ( static
- :<|> cssHandlers
- :<|> jsonHandlers db
- :<|> serverHandlers
- :<|> pure heroManifest
- :<|> Tagged handle404
- )
- where
- static = serveDirectoryWith (defaultWebAppSettings "static")
-
-
--- | 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/all.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
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-02 04:34:57 +0000